{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecordWildCards #-}

module Slab.Execute
  ( executeFile
  , execute
  ) where

import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Except (ExceptT, runExceptT)
import Data.Text qualified as T
import Slab.Error qualified as Error
import Slab.Evaluate qualified as Evaluate
import Slab.PreProcess qualified as PreProcess
import Slab.Syntax qualified as Syntax
import System.Process (cwd, readCreateProcess, shell)

--------------------------------------------------------------------------------

-- | Similar to `evaluateFile` but run external commands.
executeFile :: FilePath -> IO (Either Error.Error [Syntax.Block])
executeFile :: FilePath -> IO (Either Error [Block])
executeFile FilePath
path =
  ExceptT Error IO [Block] -> IO (Either Error [Block])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error IO [Block] -> IO (Either Error [Block]))
-> ExceptT Error IO [Block] -> IO (Either Error [Block])
forall a b. (a -> b) -> a -> b
$
    FilePath -> ExceptT Error IO [Block]
PreProcess.preprocessFileE FilePath
path
      ExceptT Error IO [Block]
-> ([Block] -> ExceptT Error IO [Block])
-> ExceptT Error IO [Block]
forall a b.
ExceptT Error IO a
-> (a -> ExceptT Error IO b) -> ExceptT Error IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Env -> [Text] -> [Block] -> ExceptT Error IO [Block]
forall (m :: * -> *).
Monad m =>
Env -> [Text] -> [Block] -> ExceptT Error m [Block]
Evaluate.evaluate Env
Evaluate.defaultEnv [Text
"toplevel"]
      ExceptT Error IO [Block]
-> ([Block] -> ExceptT Error IO [Block])
-> ExceptT Error IO [Block]
forall a b.
ExceptT Error IO a
-> (a -> ExceptT Error IO b) -> ExceptT Error IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> [Block] -> ExceptT Error IO [Block]
execute FilePath
path

--------------------------------------------------------------------------------
execute
  :: FilePath
  -> [Syntax.Block]
  -> ExceptT Error.Error IO [Syntax.Block]
execute :: FilePath -> [Block] -> ExceptT Error IO [Block]
execute FilePath
ctx = (Block -> ExceptT Error IO Block)
-> [Block] -> ExceptT Error IO [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (FilePath -> Block -> ExceptT Error IO Block
exec FilePath
ctx)

exec :: FilePath -> Syntax.Block -> ExceptT Error.Error IO Syntax.Block
exec :: FilePath -> Block -> ExceptT Error IO Block
exec FilePath
ctx = \case
  node :: Block
node@Block
Syntax.BlockDoctype -> Block -> ExceptT Error IO Block
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
node
  Syntax.BlockElem Elem
name TrailingSym
mdot [Attr]
attrs [Block]
nodes -> do
    [Block]
nodes' <- FilePath -> [Block] -> ExceptT Error IO [Block]
execute FilePath
ctx [Block]
nodes
    Block -> ExceptT Error IO Block
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ExceptT Error IO Block)
-> Block -> ExceptT Error IO Block
forall a b. (a -> b) -> a -> b
$ Elem -> TrailingSym -> [Attr] -> [Block] -> Block
Syntax.BlockElem Elem
name TrailingSym
mdot [Attr]
attrs [Block]
nodes'
  node :: Block
node@(Syntax.BlockText TextSyntax
_ [Inline]
_) -> Block -> ExceptT Error IO Block
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
node
  Syntax.BlockInclude Maybe Text
mname FilePath
path Maybe [Block]
mbody -> do
    Maybe [Block]
mbody' <- ([Block] -> ExceptT Error IO [Block])
-> Maybe [Block] -> ExceptT Error IO (Maybe [Block])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (FilePath -> [Block] -> ExceptT Error IO [Block]
execute FilePath
ctx) Maybe [Block]
mbody
    Block -> ExceptT Error IO Block
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ExceptT Error IO Block)
-> Block -> ExceptT Error IO Block
forall a b. (a -> b) -> a -> b
$ Maybe Text -> FilePath -> Maybe [Block] -> Block
Syntax.BlockInclude Maybe Text
mname FilePath
path Maybe [Block]
mbody'
  Syntax.BlockFragmentDef Text
name [Text]
params [Block]
nodes -> do
    [Block]
nodes' <- FilePath -> [Block] -> ExceptT Error IO [Block]
execute FilePath
ctx [Block]
nodes
    Block -> ExceptT Error IO Block
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ExceptT Error IO Block)
-> Block -> ExceptT Error IO Block
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Block] -> Block
Syntax.BlockFragmentDef Text
name [Text]
params [Block]
nodes'
  Syntax.BlockFragmentCall Text
name [Expr]
values [Block]
nodes -> do
    [Block]
nodes' <- FilePath -> [Block] -> ExceptT Error IO [Block]
execute FilePath
ctx [Block]
nodes
    Block -> ExceptT Error IO Block
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ExceptT Error IO Block)
-> Block -> ExceptT Error IO Block
forall a b. (a -> b) -> a -> b
$ Text -> [Expr] -> [Block] -> Block
Syntax.BlockFragmentCall Text
name [Expr]
values [Block]
nodes'
  node :: Block
node@(Syntax.BlockFor Text
_ Maybe Text
_ Expr
_ [Block]
_) -> Block -> ExceptT Error IO Block
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
node
  node :: Block
node@(Syntax.BlockComment CommentType
_ Text
_) -> Block -> ExceptT Error IO Block
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
node
  node :: Block
node@(Syntax.BlockFilter Text
_ Text
_) -> Block -> ExceptT Error IO Block
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
node
  node :: Block
node@(Syntax.BlockRawElem Text
_ [Block]
_) -> Block -> ExceptT Error IO Block
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
node
  Syntax.BlockDefault Text
name [Block]
nodes -> do
    [Block]
nodes' <- FilePath -> [Block] -> ExceptT Error IO [Block]
execute FilePath
ctx [Block]
nodes
    Block -> ExceptT Error IO Block
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ExceptT Error IO Block)
-> Block -> ExceptT Error IO Block
forall a b. (a -> b) -> a -> b
$ Text -> [Block] -> Block
Syntax.BlockDefault Text
name [Block]
nodes'
  Syntax.BlockImport FilePath
path Maybe [Block]
mbody [Block]
args -> do
    Maybe [Block]
mbody' <- ([Block] -> ExceptT Error IO [Block])
-> Maybe [Block] -> ExceptT Error IO (Maybe [Block])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (FilePath -> [Block] -> ExceptT Error IO [Block]
execute FilePath
ctx) Maybe [Block]
mbody
    Block -> ExceptT Error IO Block
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ExceptT Error IO Block)
-> Block -> ExceptT Error IO Block
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe [Block] -> [Block] -> Block
Syntax.BlockImport FilePath
path Maybe [Block]
mbody' [Block]
args
  node :: Block
node@(Syntax.BlockRun Text
_ (Just [Block]
_)) -> Block -> ExceptT Error IO Block
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
node
  Syntax.BlockRun Text
cmd Maybe [Block]
Nothing -> do
    FilePath
out <-
      IO FilePath -> ExceptT Error IO FilePath
forall a. IO a -> ExceptT Error IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> ExceptT Error IO FilePath)
-> IO FilePath -> ExceptT Error IO FilePath
forall a b. (a -> b) -> a -> b
$
        CreateProcess -> FilePath -> IO FilePath
readCreateProcess ((FilePath -> CreateProcess
shell (FilePath -> CreateProcess) -> FilePath -> CreateProcess
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
cmd) {cwd = Just "/tmp/"}) FilePath
""
    Block -> ExceptT Error IO Block
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ExceptT Error IO Block)
-> Block -> ExceptT Error IO Block
forall a b. (a -> b) -> a -> b
$
      Text -> Maybe [Block] -> Block
Syntax.BlockRun Text
cmd (Maybe [Block] -> Block) -> Maybe [Block] -> Block
forall a b. (a -> b) -> a -> b
$
        [Block] -> Maybe [Block]
forall a. a -> Maybe a
Just [TextSyntax -> [Inline] -> Block
Syntax.BlockText TextSyntax
Syntax.RunOutput [Text -> Inline
Syntax.Lit (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
out]]
  node :: Block
node@(Syntax.BlockReadJson Text
_ FilePath
_ Maybe Value
_) -> Block -> ExceptT Error IO Block
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
node
  node :: Block
node@(Syntax.BlockAssignVar Text
_ Expr
_) -> Block -> ExceptT Error IO Block
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
node
  Syntax.BlockIf Expr
cond [Block]
as [Block]
bs -> do
    [Block]
as' <- FilePath -> [Block] -> ExceptT Error IO [Block]
execute FilePath
ctx [Block]
as
    [Block]
bs' <- FilePath -> [Block] -> ExceptT Error IO [Block]
execute FilePath
ctx [Block]
bs
    Block -> ExceptT Error IO Block
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ExceptT Error IO Block)
-> Block -> ExceptT Error IO Block
forall a b. (a -> b) -> a -> b
$ Expr -> [Block] -> [Block] -> Block
Syntax.BlockIf Expr
cond [Block]
as' [Block]
bs'
  Syntax.BlockList [Block]
nodes -> do
    [Block]
nodes' <- FilePath -> [Block] -> ExceptT Error IO [Block]
execute FilePath
ctx [Block]
nodes
    Block -> ExceptT Error IO Block
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Block -> ExceptT Error IO Block)
-> Block -> ExceptT Error IO Block
forall a b. (a -> b) -> a -> b
$ [Block] -> Block
Syntax.BlockList [Block]
nodes'
  node :: Block
node@(Syntax.BlockCode Expr
_) -> Block -> ExceptT Error IO Block
forall a. a -> ExceptT Error IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
node