{-# LANGUAGE TemplateHaskell #-}

-- | @since 0.1.2.0
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e x. Exception e => Either e x -> x
eitherThrow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. AllM x -> IO (Either (DickinsonError AlexPosn) x)
evalIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *).
(MonadError (DickinsonError a) m, MonadState (EvalSt a) m) =>
[Declaration a] -> m Text
evalDickinsonAsMain

dickinson :: [FilePath] -> FilePath -> Q Exp
dickinson :: [String] -> String -> Q Exp
dickinson [String]
is String
fp = do
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ String -> Q ()
TH.addDependentFile [String
fp] -- TODO: resolve dependencies
    [Declaration AlexPosn]
ds <- forall a. IO a -> Q a
TH.runIO ([String] -> String -> IO [Declaration AlexPosn]
validateAmalgamate [String]
is String
fp)
    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) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift (Text -> String
T.unpack Text
txt)

-- see this mess: https://stackoverflow.com/a/38182444
liftDataWithText :: Data a => a -> Q Exp
liftDataWithText :: forall a. Data a => a -> Q Exp
liftDataWithText = forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
TH.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)