lens-th-rewrite 0.1.0.0 → 0.3.0.0
raw patch · 4 files changed
+89/−17 lines, 4 filesdep +ghc-exactprintdep +lens-th-rewritenew-component:exe:lens-th-rewrite-ppnew-component:exe:test
Dependencies added: ghc-exactprint, lens-th-rewrite
Files
- exe/Main.hs +14/−0
- lens-th-rewrite.cabal +23/−1
- pp/Main.hs +35/−0
- src/GHC/Plugin/LensThRewrite.hs +17/−16
+ exe/Main.hs view
@@ -0,0 +1,14 @@+{-# language TemplateHaskell #-}+module Main where++import Control.Lens++data Person+ = Person+ { _name :: String+ } deriving (Show, Eq)++main :: IO ()+main = pure ()++$(makeLenses ''Person)
lens-th-rewrite.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: lens-th-rewrite-version: 0.1.0.0+version: 0.3.0.0 synopsis: Rewrites Template Haskell splices using the API description: A GHC plugin to perform source-to-source transformation on parsed Haskell, used to manually inline Template Haskell calls for lens. bug-reports: https://github.com/dmjio/lens-th-rewrite/issues@@ -12,6 +12,28 @@ category: Data build-type: Simple extra-source-files: CHANGELOG.md++executable test+ main-is:+ Main.hs+ hs-source-dirs:+ exe+ ghc-options:+ -fplugin=GHC.Plugin.LensThRewrite+ build-depends:+ base < 5, lens-th-rewrite, lens+ default-language:+ Haskell2010++executable lens-th-rewrite-pp+ main-is:+ Main.hs+ hs-source-dirs:+ pp+ build-depends:+ base < 5, lens-th-rewrite, ghc, ghc-exactprint+ default-language:+ Haskell2010 library exposed-modules:
+ pp/Main.hs view
@@ -0,0 +1,35 @@+module Main where++import System.Environment+import System.Exit+import GHC.Plugin.LensThRewrite++import Language.Haskell.GHC.ExactPrint.Parsers++import CoreSyn+import GhcPlugins+import HsDecls+import HsDumpAst+import HsExtension+import HsSyn+import OccName+import RdrName+import TcEvidence+import Var++main :: IO ()+main = do+ args <- getArgs+ case args of+ original:input:output:_ ->+ go input output++go :: String -> String -> IO ()+go input output = do+ result <- parseModule input+ case result of+ Right (_, L _ s) -> do+ let n = rewriteModule s+ writeFile output $ showSDocUnsafe (ppr n)+ Left s -> print s >> exitFailure+
src/GHC/Plugin/LensThRewrite.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE BangPatterns #-} --------------------------------------------------------------------------------@@ -13,7 +14,7 @@ -- GHC Plugin to rewrite makeLenses call into pure functions. -- ---------------------------------------------------------------------------------module GHC.Plugin.LensThRewrite ( plugin ) where+module GHC.Plugin.LensThRewrite ( plugin, rewriteModule ) where import Control.Arrow import Control.Lens@@ -31,8 +32,6 @@ import TcEvidence import Var -import System.IO.Unsafe- -- | Lens rewrite plugin. plugin :: Plugin plugin@@ -41,14 +40,20 @@ , pluginRecompile = purePlugin } +rewriteModule+ :: HsModule GhcPs+ -> HsModule GhcPs+rewriteModule module'+ = module' & decls %~ concatMap (modifyDecls module')+ rewriteMakeLenses :: HsParsedModule -> Hsc HsParsedModule-rewriteMakeLenses parsed = do--- liftIO $ print "Rewriting makeLenses to use lens"- pure $ parsed- & moduleDecls- %~ concatMap (modifyDecls (parsed ^. (hsMod . located)))+rewriteMakeLenses parsed+ = pure+ $ parsed+ & moduleDecls+ %~ concatMap (modifyDecls (parsed ^. (hsMod . located))) parsedModule :: Lens' HsParsedModule (Located (HsModule GhcPs)) parsedModule = lens hpm_module $ \r f -> r { hpm_module = f }@@ -113,14 +118,6 @@ mkVar :: String -> HsExpr GhcPs mkVar x = HsVar NoExt (mkName x) --- | test--- main :: IO ()--- main = do--- Right (_, L _ s) <- parseModule "Main.hs"--- putStrLn $ showSDocUnsafe (showAstData BlankSrcSpan s)--- let n = s & decls %~ concatMap (modifyDecls s)--- putStrLn $ showSDocUnsafe (ppr n)- type FieldName = String type TypeName = String @@ -209,7 +206,11 @@ (hsPar $ hsLam $ matchGroup+#if MIN_VERSION_base (4,13,0) [ lambdaMatch [ varPat "r", varPat "f" ] $+#else+ [ lambdaMatch [ emptyL (varPat "r"), emptyL (varPat "f") ] $+#endif grhss [ grhs $ recordUpd (hsVar "r") [ hsRecUpdField fieldName (hsVar "f")