{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module PlutusTx.TH (
compile,
compileUntyped,
loadFromFile) where
import Data.Proxy
import Language.Haskell.TH qualified as TH
import Language.Haskell.TH.Syntax qualified as TH
import Language.Haskell.TH.Syntax.Compat qualified as TH
import PlutusTx.Code
import PlutusTx.Plugin.Utils
import Control.Monad.IO.Class
import Data.ByteString qualified as BS
import Prelude
compile :: TH.SpliceQ a -> TH.SpliceQ (CompiledCode a)
compile :: forall a. SpliceQ a -> SpliceQ (CompiledCode a)
compile SpliceQ a
e = Q Exp -> Splice Q (CompiledCode a)
forall a (m :: * -> *). Quote m => m Exp -> Splice m a
TH.unsafeSpliceCoerce (Q Exp -> Splice Q (CompiledCode a))
-> Q Exp -> Splice Q (CompiledCode a)
forall a b. (a -> b) -> a -> b
$ Q Exp -> Q Exp
compileUntyped (Q Exp -> Q Exp) -> Q Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ TExp a -> Exp
forall a. TExp a -> Exp
TH.unType (TExp a -> Exp) -> Q (TExp a) -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpliceQ a -> Q (TExp a)
forall (m :: * -> *) a. Splice m a -> m (TExp a)
TH.examineSplice SpliceQ a
e
loadFromFile :: FilePath -> TH.SpliceQ (CompiledCode a)
loadFromFile :: forall a. FilePath -> SpliceQ (CompiledCode a)
loadFromFile FilePath
fp = Q (TExp (CompiledCode a)) -> Splice Q (CompiledCode a)
forall a (m :: * -> *). m (TExp a) -> Splice m a
TH.liftSplice (Q (TExp (CompiledCode a)) -> Splice Q (CompiledCode a))
-> Q (TExp (CompiledCode a)) -> Splice Q (CompiledCode a)
forall a b. (a -> b) -> a -> b
$ do
ByteString
bs <- IO ByteString -> Q ByteString
forall a. IO a -> Q a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Q ByteString) -> IO ByteString -> Q ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
BS.readFile FilePath
fp
Splice Q (CompiledCode a) -> Q (TExp (CompiledCode a))
forall (m :: * -> *) a. Splice m a -> m (TExp a)
TH.examineSplice [|| ByteString
-> Maybe ByteString -> CoverageIndex -> CompiledCodeIn uni fun a
forall (uni :: * -> *) fun a.
ByteString
-> Maybe ByteString -> CoverageIndex -> CompiledCodeIn uni fun a
SerializedCode a
bs Maybe a
forall a. Maybe a
Nothing a
forall a. Monoid a => a
mempty ||]
compileUntyped :: TH.Q TH.Exp -> TH.Q TH.Exp
compileUntyped :: Q Exp -> Q Exp
compileUntyped Q Exp
e = do
FilePath -> Q ()
TH.addCorePlugin FilePath
"PlutusTx.Plugin"
Loc
loc <- Q Loc
TH.location
let locStr :: FilePath
locStr = Loc -> FilePath
forall a. Ppr a => a -> FilePath
TH.pprint Loc
loc
[| plc (Proxy :: Proxy $(Q TyLit -> Q Type
forall (m :: * -> *). Quote m => m TyLit -> m Type
TH.litT (Q TyLit -> Q Type) -> Q TyLit -> Q Type
forall a b. (a -> b) -> a -> b
$ FilePath -> Q TyLit
forall (m :: * -> *). Quote m => FilePath -> m TyLit
TH.strTyLit FilePath
locStr)) $(Q Exp
e) |]