module Swarm.Language.Parse.QQ (tyQ) where
import Data.Generics
import Language.Haskell.TH qualified as TH
import Language.Haskell.TH.Quote
import Swarm.Language.Parse
import Swarm.Util (liftText)
tyQ :: QuasiQuoter
tyQ :: QuasiQuoter
tyQ =
QuasiQuoter
{ quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
quoteTypeExp
, quotePat :: String -> Q Pat
quotePat = forall a. HasCallStack => String -> a
error String
"quotePat not implemented for polytypes"
, quoteType :: String -> Q Type
quoteType = forall a. HasCallStack => String -> a
error String
"quoteType not implemented for polytypes"
, quoteDec :: String -> Q [Dec]
quoteDec = forall a. HasCallStack => String -> a
error String
"quoteDec not implemented for polytypes"
}
quoteTypeExp :: String -> TH.ExpQ
quoteTypeExp :: String -> Q Exp
quoteTypeExp String
s = do
Loc
loc <- Q Loc
TH.location
let pos :: (String, Int, Int)
pos =
( Loc -> String
TH.loc_filename Loc
loc
, forall a b. (a, b) -> a
fst (Loc -> CharPos
TH.loc_start Loc
loc)
, forall a b. (a, b) -> b
snd (Loc -> CharPos
TH.loc_start Loc
loc)
)
Polytype
parsed <- forall (m :: * -> *) a.
(Monad m, MonadFail m) =>
(String, Int, Int) -> Parser a -> String -> m a
runParserTH (String, Int, Int)
pos Parser Polytype
parsePolytype String
s
forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
dataToExpQ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Q Exp
liftText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast) Polytype
parsed