module LambdaCube.SystemFw_.TH where import Control.Monad ((<=<)) import qualified Data.Text as Text import LambdaCube.SystemFw_.Ast import LambdaCube.SystemFw_.Elaborator import LambdaCube.SystemFw_.Parser import Language.Haskell.TH.Quote (QuasiQuoter (..)) import Language.Haskell.TH.Syntax (Loc (loc_start), Q, lift, location) import qualified Text.Megaparsec as P import qualified Text.Megaparsec.Error as PE systemFw_ :: QuasiQuoter systemFw_ = QuasiQuoter { quoteExp = lift <=< systemFw_QuoteExp , quotePat = undefined , quoteType = undefined , quoteDec = undefined } systemFw_QuoteExp :: String -> Q ExtLCTerm systemFw_QuoteExp str = do l <- location case P.parse pTopLC (" show (loc_start l) <> ">") (Text.pack str) of Right e -> pure e Left err -> fail $ PE.errorBundlePretty err elaboratedSystemFw_ :: QuasiQuoter elaboratedSystemFw_ = QuasiQuoter { quoteExp = lift <=< elaboratedSystemFw_QuoteExp , quotePat = undefined , quoteType = undefined , quoteDec = undefined } elaboratedSystemFw_QuoteExp :: String -> Q LCTerm elaboratedSystemFw_QuoteExp str = do e <- systemFw_QuoteExp str case elaborate e of Right e' -> pure e' Left err -> fail err