Explicit lifting.

Author: robrix

semantic-ast/src/AST/Grammar/TH.hs

@@ -9,16 +9,16 @@ import qualified Data.Set as Set
 import           Foreign.Ptr
 import           Language.Haskell.TH
 import           Language.Haskell.TH.Syntax
-import           TreeSitter.Symbol
 import           TreeSitter.Language (Language, languageSymbols)
+import           TreeSitter.Symbol
 
 -- | TemplateHaskell construction of a datatype for the referenced Language.
 -- | Statically-known rules corresponding to symbols in the grammar.
 mkStaticallyKnownRuleGrammarData :: Name -> Ptr Language -> Q [Dec]
 mkStaticallyKnownRuleGrammarData name language = do
   symbols <- renameDups . map ((,) . fst <*> uncurry symbolToName) . (++ [(Regular, "ParseError")]) <$> runIO (languageSymbols language)
   Module _ modName <- thisModule
-  let mkMatch symbolType str = match (conP (Name (OccName str) (NameQ modName)) []) (normalB [e|symbolType|]) []
+  let mkMatch symbolType str = match (conP (Name (OccName str) (NameQ modName)) []) (normalB [e|$(lift symbolType)|]) []
   datatype <- dataD (pure []) name [] Nothing (flip normalC [] . mkName . snd <$> symbols)
     [ derivClause Nothing (map conT [ ''Bounded, ''Enum, ''Eq, ''Ix, ''Ord, ''Show ]) ]
   symbolInstance <- [d|
@@ -30,4 +30,4 @@ renameDups :: [(a, String)] -> [(a, String)]
 renameDups = snd . mapAccumL go mempty
   where go done (ty, name) = let name' = rename name in (Set.insert name' done, (ty, name'))
           where rename name | name `Set.member` done = rename (name ++ "'")
-                            | otherwise              = name
+                            | otherwise              = name