Depend on parsley-core instead

ChangeLog.md

@@ -6,4 +6,9 @@
 
 ## 0.1.0.1 -- 2021-06-11
 
-* Support for GHC 9.0 in place.
+* Support for GHC 9.0 in place.
+
+## 0.1.1.0 -- 2021-06-12
+
+* Switched to support `parsley-core` as the base
+* Introduced the `Parsley.Internal.Bridge` module to provide functions for the plugin to latch onto

parsley-garnish.cabal

@@ -1,5 +1,5 @@
 name:               parsley-garnish
-version:            0.1.0.1
+version:            0.1.1.0
 synopsis:           A collection of GHC plugins to work with parsley
 description:        This package contains a collection (for now one) to help
                     remove boilerplate when writing parsers using @parsley@.
@@ -27,6 +27,7 @@ library
 --                    Parsley.LiftPlugin
 --                    Parsley.OverloadedSyntaxPlugin
                     Parsley.OverloadedQuotesPlugin
+                    Parsley.Internal.Bridge
   other-modules:    Parsley.PluginUtils
 --                    -- Lift Plugin
 --                    Parsley.LiftPlugin.Plugin
@@ -40,7 +41,7 @@ library
                     Parsley.OverloadedQuotesPlugin.Plugin
 
   build-depends:    base                >= 4.10    && < 5,
-                    parsley             >= 0.1     && < 0.2,
+                    parsley-core        >= 1.0     && < 1.1,
                     template-haskell    >= 2.14    && < 3,
                     ghc-tcplugins-extra >= 0.3     && < 0.5,
                     ghc                 >= 8.6     && < 9.2,

src/Parsley/Garnish.hs

@@ -12,16 +12,11 @@ import Parsley.LiftPlugin (LiftTo(..))
 import Parsley.OverloadedSyntaxPlugin (Syntax(..), overload)
 import Parsley (Quapplicative(makeQ, _val, _code, (>*<)), WQ, Code)
 import Parsley.Defunctionalized (Defunc)
+import Parsley.Internal.Bridge (mkCode, mkVal)
 
 instance LiftTo WQ where code x = makeQ x [||x||]
 instance LiftTo Defunc where code x = makeQ x [||x||]
 
-mkVal :: Quapplicative q => a -> q a
-mkVal x = makeQ x undefined
-
-mkCode :: Quapplicative q => Code a -> q a
-mkCode qx = makeQ undefined qx
-
 instance (LiftTo q, Quapplicative q) => Syntax q where
   _if cond _then _else = makeQ
       (if    _val  cond  then    _val  _then  else    _val  _else)

src/Parsley/Internal/Bridge.hs

@@ -0,0 +1,18 @@
+module Parsley.Internal.Bridge (_code, _val, makeQ, mkVal, mkCode) where
+
+import qualified Parsley.Internal.Common.Utils as Parsley (Quapplicative(..), Code)
+
+_code :: Parsley.Quapplicative q => q a -> Parsley.Code a
+_code = Parsley._code
+
+_val :: Parsley.Quapplicative q => q a -> a
+_val  = Parsley._val
+
+makeQ :: Parsley.Quapplicative q => a -> Parsley.Code a -> q a
+makeQ = Parsley.makeQ
+
+mkVal :: Parsley.Quapplicative q => a -> q a
+mkVal x = Parsley.makeQ x undefined
+
+mkCode :: Parsley.Quapplicative q => Parsley.Code a -> q a
+mkCode qx = Parsley.makeQ undefined qx

src/Parsley/OverloadedQuotesPlugin/Plugin.hs

@@ -12,7 +12,7 @@ module Parsley.OverloadedQuotesPlugin.Plugin (plugin) where
 import Data.Generics (GenericT, GenericQ, mkT, mkQ, everywhere, gmapT)
 import GHC.Generics  (Generic)
 
-import Parsley.PluginUtils (lookupModuleInPackage, lookupName, lookupNames)
+import Parsley.PluginUtils (lookupModule, lookupNames)
 
 #if __GLASGOW_HASKELL__ >= 900
 import GHC.Driver.Plugins       (Plugin (..), defaultPlugin, purePlugin)
@@ -58,27 +58,29 @@ plugin = defaultPlugin { renamedResultAction = overloadedQuotes, pluginRecompile
 data QOps a = QOps {
     _code :: a,
     _val :: a,
-    makeQ :: a
+    makeQ :: a,
+    mkCode :: a,
+    mkVal :: a
   } deriving (Functor, Foldable, Traversable, Generic)
 
 quapplicativeStrings :: QOps String
 quapplicativeStrings = QOps {
     _code = "_code",
     _val  = "_val",
-    makeQ = "makeQ"
+    makeQ = "makeQ",
+    mkCode = "mkCode",
+    mkVal = "mkVal"
   }
 
 overloadedQuotes :: [GHC.CommandLineOption] -> TcGblEnv -> GHC.HsGroup GHC.GhcRn -> TcM (TcGblEnv, GHC.HsGroup GHC.GhcRn)
 overloadedQuotes _ gEnv rn = do
   hscEnv <- GHC.getTopEnv
-  parsley <- lookupModuleInPackage hscEnv "parsley" "Parsley.Internal.Common.Utils"
+  parsley <- lookupModule hscEnv "Parsley.Internal.Bridge"
   qops <- lookupNames parsley quapplicativeStrings
-  prelude <- lookupModuleInPackage hscEnv "base" "GHC.Err"
-  undef <- lookupName prelude "undefined"
   -- This is a little inefficient, since the top-down transformation means no quotes can be
   -- found under a top-level one: we use a top-down version of everywhereBut to stop traversal
   -- of this whenever it fires
-  return (gEnv, onlyTopmost (mkQ False isQuote) (mkT (transformUTHQuote qops undef)) rn)
+  return (gEnv, onlyTopmost (mkQ False isQuote) (mkT (transformUTHQuote qops)) rn)
 
 mkApp :: GHC.SrcSpan -> Expr -> Expr -> Expr
 mkApp s f = GHC.L s . Expr.HsApp noExt f . mkPar s
@@ -103,17 +105,19 @@ isQuote _                   = False
 -- the original quote. Perhaps in that case we could just inline the definition into both holes...
 -- As `transform` works bottom up, we can always assume nested quotes are already handled: this might
 -- get tricky, however.
-transformUTHQuote :: QOps GHC.Name -> GHC.Name -> Expr -> Expr
-transformUTHQuote ops undef (LUTHQuote s ex ex' x) = --pprTouch "new quote" $
+transformUTHQuote :: QOps GHC.Name -> Expr -> Expr
+transformUTHQuote ops (LUTHQuote s ex ex' x) = --pprTouch "new quote" $
   mkPar s (makeQS `mkAppS` everywhere (mkT (transformUTHQuoteVar (_val ops) makeVal)) x
                   `mkAppS` mkQuote (everywhere (mkT (transformUTHQuoteCode (_code ops) makeCode)) x))
   where
     mkQuote y = GHC.L s (Expr.HsBracket ex (Expr.TExpBr ex' y))
     mkAppS = mkApp s
     makeQS = mkVar s (makeQ ops)
-    makeVal y = mkPar s (makeQS `mkAppS` y `mkAppS` mkVar s undef)
-    makeCode y = mkPar s (makeQS `mkAppS` mkVar s undef `mkAppS` y)
-transformUTHQuote _ _ x = x
+    mkValS = mkVar s (mkVal ops)
+    mkCodeS = mkVar s (mkCode ops)
+    makeVal y = mkPar s (mkValS `mkAppS` y)
+    makeCode y = mkPar s (mkCodeS `mkAppS` y)
+transformUTHQuote _ x = x
 
 transformUTHQuoteVar :: GHC.Name -> (Expr -> Expr) -> Expr -> Expr
 transformUTHQuoteVar _    makeVal (LUTHQuote _ _ _ x)      = makeVal x

test/src/A.hs

@@ -1,14 +1,15 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -fplugin=Parsley.LiftPlugin #-}
-{-# OPTIONS_GHC -fplugin=Parsley.OverloadedSyntaxPlugin #-}
+--{-# OPTIONS_GHC -fplugin=Parsley.LiftPlugin #-}
+--{-# OPTIONS_GHC -fplugin=Parsley.OverloadedSyntaxPlugin #-}
 {-# OPTIONS_GHC -fplugin=Parsley.OverloadedQuotesPlugin #-}
 module A where
 
 import Data.Functor.Identity
 
-import Parsley.Garnish
+import Parsley.Internal
+--import Parsley.Garnish
 
 liftTest :: Int -> WQ Int
 liftTest x = [|x|]
@@ -19,6 +20,7 @@ id' = id
 test :: WQ Int
 test = [|$(id' [|7|]) + 1 |]
 
+{-
 instance LiftTo Identity where
   code = Identity
 
@@ -133,4 +135,4 @@ staticPowerId = overload (\n -> \k ->
 staticPower_s :: (Quapplicative r, Syntax r) => Int -> r Int -> r Int
 staticPower_s n k = if n == 0
                       then code 1
-                      else (overload ((code (*)) k)) >*< staticPower_s (n - 1) k
+                      else (overload ((code (*)) k)) >*< staticPower_s (n - 1) k-}

test/src/Main.hs

@@ -3,16 +3,17 @@ module Main(main) where
 
 import A
 import Data.Functor.Identity
-import Parsley (_code, WQ)
+import Parsley.Internal (_code, WQ)
 
 main = do
-  print ($$(_code @WQ test3) 'a')
-  print ((runIdentity test4) 'a')
-  print (just 'a')
-  print (qux 'a')
+  putStrLn "Testing"
+  --print ($$(_code @WQ test3) 'a')
+  --print ((runIdentity test4) 'a')
+  --print (just 'a')
+  --print (qux 'a')
 
-just :: a -> Maybe a
-just = $$(_code @WQ test7)
+--just :: a -> Maybe a
+--just = $$(_code @WQ test7)
 
-qux :: a -> a
-qux = $$(_code @WQ test5)
+--qux :: a -> a
+--qux = $$(_code @WQ test5)

test/test.cabal

@@ -18,7 +18,7 @@ cabal-version:       >=1.10
 executable test
   main-is:  Main.hs
   other-modules: A
-  build-depends:       base >=4.11 && <5, parsley-garnish, parsley, template-haskell
+  build-depends:       base >=4.11 && <5, parsley-garnish, parsley-core, template-haskell
   hs-source-dirs:      src
   --ghc-options: -ddump-ds-preopt
   default-language:    Haskell2010