ttg boilerplate

rlp.cabal

@@ -71,6 +71,7 @@ library
                     , extra >= 1.7.0 && < 2
                     , semigroupoids
                     , comonad
+                    , lens
 
     hs-source-dirs:   src
     default-language: GHC2021

src/Rlp/Parse/Types.hs

@@ -54,6 +54,22 @@ data RlpcPs
 type instance XRec RlpcPs f = Located (f RlpcPs)
 type instance IdP RlpcPs = PsName
 
+type instance XFunD RlpcPs = ()
+type instance XDataD RlpcPs = ()
+type instance XInfixD RlpcPs = ()
+type instance XTySigD RlpcPs = ()
+type instance XXDeclD RlpcPs = ()
+
+type instance XLetE RlpcPs = ()
+type instance XVarE RlpcPs = ()
+type instance XLamE RlpcPs = ()
+type instance XCaseE RlpcPs = ()
+type instance XIfE RlpcPs = ()
+type instance XAppE RlpcPs = ()
+type instance XLitE RlpcPs = ()
+type instance XParE RlpcPs = ()
+type instance XOAppE RlpcPs = ()
+
 type PsName = Text
 
 --------------------------------------------------------------------------------

src/Rlp/Syntax.hs

@@ -16,8 +16,20 @@ module Rlp.Syntax
     , ConAlt(..)
     , Binding(..), Binding'
 
-    -- * Trees That Grow extensions
+    -- * Trees That Grow boilerplate
-    , UnXRec(..), MapXRec(..), XRec, IdP
+    -- ** Extension points
+    , IdP, XRec, UnXRec(..), MapXRec(..)
+    -- *** Decl
+    , XFunD, XTySigD, XInfixD, XDataD, XXDeclD
+    -- *** RlpExpr
+    , XLetE, XVarE, XLamE, XCaseE, XIfE, XAppE, XLitE
+    , XParE, XOAppE
+    -- ** Pattern synonyms
+    -- *** Decl
+    , pattern FunD, pattern TySigD, pattern InfixD, pattern DataD
+    -- *** RlpExpr
+    , pattern LetE, pattern VarE, pattern LamE, pattern CaseE, pattern IfE
+    , pattern AppE, pattern LitE, pattern ParE, pattern OAppE
     )
     where
 ----------------------------------------------------------------------------------
@@ -61,12 +73,39 @@ type RlpType' p = XRec p RlpType
 deriving instance (PhaseShow p)
                   => Show (RlpType p)
 
-data Decl p = FunD   (IdP p) [Pat' p] (RlpExpr' p) (Maybe (Where p))
+data Decl p = FunD'   (XFunD p)    (IdP p) [Pat' p] (RlpExpr' p) (Maybe (Where p))
-            | TySigD [IdP p] (RlpType' p)
+            | TySigD' (XTySigD p)  [IdP p] (RlpType' p)
-            | DataD  (IdP p) [IdP p] [ConAlt p]
+            | DataD'  (XDataD p)   (IdP p) [IdP p] [ConAlt p]
-            | InfixD Assoc Int (IdP p)
+            | InfixD' (XInfixD p)  Assoc Int (IdP p)
+            | XDeclD' !(XXDeclD p)
 
-deriving instance (Show (IdP p), PhaseShow p) => Show (Decl p)
+deriving instance
+    ( Show (XFunD p), Show (XTySigD p)
+    , Show (XDataD p), Show (XInfixD p)
+    , Show (XXDeclD p)
+    , PhaseShow p
+    ) 
+    => Show (Decl p)
+
+type family XFunD p
+type family XTySigD p
+type family XDataD p
+type family XInfixD p
+type family XXDeclD p
+
+pattern FunD   :: (XFunD p ~ ())
+               => (IdP p) -> [Pat' p] -> (RlpExpr' p) -> (Maybe (Where p))
+               -> Decl p
+pattern TySigD :: (XTySigD p ~ ()) => [IdP p] -> (RlpType' p) -> Decl p
+pattern DataD  :: (XDataD p ~ ()) => (IdP p) -> [IdP p] -> [ConAlt p] -> Decl p
+pattern InfixD :: (XInfixD p ~ ()) => Assoc -> Int -> (IdP p) -> Decl p
+pattern XDeclD :: (XXDeclD p ~ ()) => Decl p
+
+pattern FunD n as e wh = FunD' () n as e wh
+pattern TySigD ns t = TySigD' () ns t
+pattern DataD n as cs = DataD' () n as cs
+pattern InfixD a p n = InfixD' () a p n
+pattern XDeclD = XDeclD' ()
 
 type Decl' p = XRec p Decl
 
@@ -79,17 +118,57 @@ data ConAlt p = ConAlt (IdP p) [RlpType' p]
 
 deriving instance (Show (IdP p), Show (XRec p RlpType)) => Show (ConAlt p)
 
-data RlpExpr p = LetE  [Binding' p] (RlpExpr' p)
+data RlpExpr p = LetE'  (XLetE p) [Binding' p] (RlpExpr' p)
-               | VarE  (IdP p)
+               | VarE'  (XVarE p) (IdP p)
-               | LamE  [Pat p] (RlpExpr' p)
+               | LamE'  (XLamE p) [Pat p] (RlpExpr' p)
-               | CaseE (RlpExpr' p) [(Alt p, Where p)]
+               | CaseE' (XCaseE p) (RlpExpr' p) [(Alt p, Where p)]
-               | IfE   (RlpExpr' p) (RlpExpr' p) (RlpExpr' p)
+               | IfE'   (XIfE p) (RlpExpr' p) (RlpExpr' p) (RlpExpr' p)
-               | AppE  (RlpExpr' p) (RlpExpr' p)
+               | AppE'  (XAppE p) (RlpExpr' p) (RlpExpr' p)
-               | LitE  (Lit p)
+               | LitE'  (XLitE p) (Lit p)
-               | ParE  (RlpExpr' p)
+               | ParE'  (XParE p) (RlpExpr' p)
-               | OAppE (IdP p) (RlpExpr' p) (RlpExpr' p)
+               | OAppE' (XOAppE p) (IdP p) (RlpExpr' p) (RlpExpr' p)
+               | XRlpExprE' (XXRlpExprE p)
 
-deriving instance (PhaseShow p) => Show (RlpExpr p)
+type family XLetE p
+type family XVarE p
+type family XLamE p
+type family XCaseE p
+type family XIfE p
+type family XAppE p
+type family XLitE p
+type family XParE p
+type family XOAppE p
+type family XXRlpExprE p
+
+pattern LetE :: (XLetE p ~ ()) => [Binding' p] -> RlpExpr' p -> RlpExpr p
+pattern VarE :: (XVarE p ~ ()) => IdP p -> RlpExpr p
+pattern LamE :: (XLamE p ~ ()) => [Pat p] -> RlpExpr' p -> RlpExpr p
+pattern CaseE :: (XCaseE p ~ ()) => RlpExpr' p -> [(Alt p, Where p)] -> RlpExpr p
+pattern IfE :: (XIfE p ~ ()) => RlpExpr' p -> RlpExpr' p -> RlpExpr' p -> RlpExpr p
+pattern AppE :: (XAppE p ~ ()) => RlpExpr' p -> RlpExpr' p -> RlpExpr p
+pattern LitE :: (XLitE p ~ ()) => Lit p -> RlpExpr p
+pattern ParE :: (XParE p ~ ()) => RlpExpr' p -> RlpExpr p
+pattern OAppE :: (XOAppE p ~ ()) => IdP p -> RlpExpr' p -> RlpExpr' p -> RlpExpr p
+pattern XRlpExprE :: (XXRlpExprE p ~ ()) => RlpExpr p
+
+pattern LetE bs e = LetE' () bs e
+pattern VarE n = VarE' () n
+pattern LamE as e = LamE' () as e
+pattern CaseE e as = CaseE' () e as
+pattern IfE c a b = IfE' () c a b
+pattern AppE f x = AppE' () f x
+pattern LitE l = LitE' () l
+pattern ParE e = ParE' () e
+pattern OAppE n a b = OAppE' () n a b
+pattern XRlpExprE = XRlpExprE' ()
+
+deriving instance
+    ( Show (XLetE p), Show (XVarE p), Show (XLamE p)
+    , Show (XCaseE p), Show (XIfE p), Show (XAppE p)
+    , Show (XLitE p), Show (XParE p), Show (XOAppE p)
+    , Show (XXRlpExprE p)
+    , PhaseShow p
+    ) => Show (RlpExpr p)
 
 type RlpExpr' p = XRec p RlpExpr