{-# LANGUAGE TemplateHaskell #-}
module Language.Dickinson.TH ( dickinson
, run
) where
import Control.Exception.Value (eitherThrow)
import Data.Data (Data)
import Data.Foldable (traverse_)
import qualified Data.Text as T
import Data.Typeable (cast)
import Language.Dickinson.Eval
import Language.Dickinson.File
import Language.Dickinson.Lexer
import Language.Dickinson.Type
import Language.Haskell.TH (Exp, Q)
import Language.Haskell.TH.Syntax (Exp (AppE, VarE))
import qualified Language.Haskell.TH.Syntax as TH
run :: [Declaration AlexPosn] -> IO T.Text
run :: [Declaration AlexPosn] -> IO Text
run = (Either (DickinsonError AlexPosn) Text -> Text)
-> IO (Either (DickinsonError AlexPosn) Text) -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either (DickinsonError AlexPosn) Text -> Text
forall e x. Exception e => Either e x -> x
eitherThrow (IO (Either (DickinsonError AlexPosn) Text) -> IO Text)
-> ([Declaration AlexPosn]
-> IO (Either (DickinsonError AlexPosn) Text))
-> [Declaration AlexPosn]
-> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllM Text -> IO (Either (DickinsonError AlexPosn) Text)
forall x. AllM x -> IO (Either (DickinsonError AlexPosn) x)
evalIO (AllM Text -> IO (Either (DickinsonError AlexPosn) Text))
-> ([Declaration AlexPosn] -> AllM Text)
-> [Declaration AlexPosn]
-> IO (Either (DickinsonError AlexPosn) Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Declaration AlexPosn] -> AllM Text
forall a (m :: * -> *).
(MonadError (DickinsonError a) m, MonadState (EvalSt a) m) =>
[Declaration a] -> m Text
evalDickinsonAsMain
dickinson :: [FilePath] -> FilePath -> Q Exp
dickinson :: [FilePath] -> FilePath -> Q Exp
dickinson [FilePath]
is FilePath
fp = do
(FilePath -> Q ()) -> [FilePath] -> Q ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ FilePath -> Q ()
TH.addDependentFile [FilePath
fp]
[Declaration AlexPosn]
ds <- IO [Declaration AlexPosn] -> Q [Declaration AlexPosn]
forall a. IO a -> Q a
TH.runIO ([FilePath] -> FilePath -> IO [Declaration AlexPosn]
validateAmalgamate [FilePath]
is FilePath
fp)
[Declaration AlexPosn] -> Q Exp
forall a. Data a => a -> Q Exp
liftDataWithText [Declaration AlexPosn]
ds
liftText :: T.Text -> Q Exp
liftText :: Text -> Q Exp
liftText Text
txt = Exp -> Exp -> Exp
AppE (Name -> Exp
VarE 'T.pack) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift (Text -> FilePath
T.unpack Text
txt)
liftDataWithText :: Data a => a -> Q Exp
liftDataWithText :: a -> Q Exp
liftDataWithText = (forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp
forall a.
Data a =>
(forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp
TH.dataToExpQ ((Text -> Q Exp) -> Maybe Text -> Maybe (Q Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Q Exp
liftText (Maybe Text -> Maybe (Q Exp))
-> (b -> Maybe Text) -> b -> Maybe (Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe Text
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast)