PyF as a source plugin

PyF.cabal

@@ -29,13 +29,16 @@ library
     PyF.Internal.ParserEx
     PyF.Internal.PythonSyntax
     PyF.Internal.QQ
+    PyF.Plugin
 
   build-depends:
     , base              >=4.12   && <4.22
     , bytestring        >=0.10.8 && <0.13
-    , ghc               >=8.6.1
+    , ghc               >=8.6.1  && <9.14
+    , ghc-boot          >=8.6.1  && <9.14
     , mtl               >=2.2.2  && <2.4
     , parsec            >=3.1.13 && <3.2
+    , syb
     , template-haskell  >=2.14.0 && <2.24
     , text              >=1.2.3  && <2.2
     , time              >=1.8.0  && <1.15
@@ -67,6 +70,24 @@ test-suite pyf-test
 
   default-language: Haskell2010
 
+test-suite pyf-test-plugin
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   test
+  main-is:          SpecPlugin.hs
+  build-depends:
+    , base
+    , bytestring
+    , hspec
+    , PyF
+    , template-haskell
+    , text
+    , time
+
+  ghc-options:
+    -Wall -threaded -rtsopts -with-rtsopts=-N -Wunused-packages
+
+  default-language: Haskell2010
+
 test-suite pyf-overloaded
   type:             exitcode-stdio-1.0
   hs-source-dirs:   test

flake.nix

@@ -92,6 +92,12 @@
               pkgs.nodejs
             ];
           };
+
+          work_with_pyf = pkgs.mkShell {
+            buildInputs = [
+              (pkgs.haskellPackages.ghcWithPackages (_: [ (pkgs.haskell.lib.dontCheck packages.default) ]))
+            ];
+          };
           default = packages.default.shell_hls;
         };
       }

src/PyF.hs

@@ -38,18 +38,19 @@ fmt = mkFormatter "fmt" fmtConfig
 
 -- | Format with whitespace trimming.
 fmtTrim :: QuasiQuoter
-fmtTrim = let
-  qq = mkFormatter "fmtTrim" fmtConfig
-  in qq { quoteExp = \s -> quoteExp qq (trimIndent  s) }
+fmtTrim =
+  let qq = mkFormatter "fmtTrim" fmtConfig
+   in qq {quoteExp = \s -> quoteExp qq (trimIndent s)}
 
 -- | Multiline string, no interpolation.
 str :: QuasiQuoter
 str = mkFormatter "str" strConfig
 
 -- | Multiline string, no interpolation, but does indentation trimming.
 strTrim :: QuasiQuoter
-strTrim = let qq = mkFormatter "strTrim" strConfig
-  in qq { quoteExp = \s -> quoteExp qq (trimIndent  s) }
+strTrim =
+  let qq = mkFormatter "strTrim" strConfig
+   in qq {quoteExp = \s -> quoteExp qq (trimIndent s)}
 
 -- | Raw string, neither interpolation nor escaping is performed.
 raw :: QuasiQuoter

src/PyF/Formatters.hs

@@ -131,6 +131,8 @@ data Format (k :: AltStatus) (k' :: UpperStatus) (k'' :: FormatType) where
   -- Upper should come AFTER Alt, so this disallow any future alt
   Upper :: Format alt 'CanUpper f -> Format 'NoAlt 'NoUpper f
 
+deriving instance Show (Format k k' k'')
+
 newtype ShowIntegral i = ShowIntegral i
   deriving (Real, Enum, Ord, Eq, Num, Integral)
 

src/PyF/Internal/Parser.hs

@@ -50,15 +50,13 @@ import HsExtension as Ext
 import Outputable (showSDoc)
 #endif
 
+import GHC.Parser.Annotation (LocatedA)
 import qualified PyF.Internal.ParserEx as ParseExp
 
-parseExpression :: RealSrcLoc -> String -> DynFlags -> Either (Int, Int, String) (HsExpr GhcPs)
+parseExpression :: RealSrcLoc -> String -> DynFlags -> Either (RealSrcLoc, String) (LocatedA (HsExpr GhcPs))
 parseExpression initLoc s dynFlags =
   case ParseExp.parseExpression initLoc s dynFlags of
-    POk _ locatedExpr ->
-      let expr = SrcLoc.unLoc locatedExpr
-       in Right
-            expr
+    POk _ locatedExpr -> Right locatedExpr
 
 {- ORMOLU_DISABLE #-}
 #if MIN_VERSION_ghc(9,2,0)
@@ -81,9 +79,7 @@ parseExpression initLoc s dynFlags =
                     $ map errMsgDiagnostic
                     $ sortMsgBag Nothing
                     $ getMessages $ errorMessages
-                line' = SrcLoc.srcLocLine srcLoc
-                col = SrcLoc.srcLocCol srcLoc
-            in Left (line', col, err)
+            in Left (srcLoc, err)
 #elif MIN_VERSION_ghc(9,6,0)
             let
                 err = renderWithContext defaultSDocContext
@@ -93,9 +89,7 @@ parseExpression initLoc s dynFlags =
                     $ map errMsgDiagnostic
                     $ sortMsgBag Nothing
                     $ getMessages $ errorMessages
-                line' = SrcLoc.srcLocLine srcLoc
-                col = SrcLoc.srcLocCol srcLoc
-            in Left (line', col, err)
+            in Left (srcLoc, err)
 #elif MIN_VERSION_ghc(9,3,0)
             let
                 err = renderWithContext defaultSDocContext
@@ -105,29 +99,21 @@ parseExpression initLoc s dynFlags =
                     $ map errMsgDiagnostic
                     $ sortMsgBag Nothing
                     $ getMessages $ errorMessages
-                line = SrcLoc.srcLocLine srcLoc
-                col = SrcLoc.srcLocCol srcLoc
-            in Left (line, col, err)
+            in Left (srcLoc, err)
 #elif MIN_VERSION_ghc(9,2,0)
             let
                 psErrToString e = show $ ParserErrorPpr.pprError e
                 err = concatMap psErrToString errorMessages
-                line = SrcLoc.srcLocLine srcLoc
-                col = SrcLoc.srcLocCol srcLoc
-            in Left (line, col, err)
+            in Left (srcLoc, err)
 #elif MIN_VERSION_ghc(8,10,0)
             let -- TODO: do not ignore "warnMessages"
                 -- I have no idea what they can be
                 (_warnMessages, errorMessages) = msgs dynFlags
                 err = concatMap show errorMessages
-                line = SrcLoc.srcLocLine srcLoc
-                col = SrcLoc.srcLocCol srcLoc
-            in Left (line, col, err)
+            in Left (srcLoc, err)
 #else
             let err = showSDoc dynFlags doc
-                line = SrcLoc.srcLocLine srcLoc
-                col = SrcLoc.srcLocCol srcLoc
-            in Left (line, col, err)
+            in Left (srcLoc, err)
 #endif
 
 #if MIN_VERSION_ghc(8,10,0)