-- |
-- Module      : Slab.Run
-- Description : Implementation of Slab's CLI
--
-- @Slab.Run@ accepts commands defined in the "Slab.Command" module and
-- runs them.
module Slab.Run
  ( run
  , parse
  , eval
  , render
  , calc
  ) where

import Control.Monad.Trans.Except (ExceptT, except, runExceptT, withExceptT)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Text.Lazy.IO qualified as TL
import Slab.Build qualified as Build
import Slab.Command qualified as Command
import Slab.Error qualified as Error
import Slab.Evaluate qualified as Evaluate
import Slab.Execute qualified as Execute
import Slab.Generate.Haskell qualified as Generate
import Slab.Parse qualified as Parse
import Slab.PreProcess qualified as PreProcess
import Slab.Render qualified as Render
import Slab.Report qualified as Report
import Slab.Serve qualified as Serve
import Slab.Syntax qualified as Syntax
import Slab.Watch qualified as Watch
import Text.Pretty.Simple (pPrintNoColor, pShowNoColor)

--------------------------------------------------------------------------------
run :: Command.Command -> IO ()
run :: Command -> IO ()
run (Command.Build FilePath
srcDir RenderMode
renderMode FilePath
distDir) = FilePath -> RenderMode -> FilePath -> IO ()
Build.buildDir FilePath
srcDir RenderMode
renderMode FilePath
distDir
run (Command.Watch FilePath
srcDir RenderMode
renderMode FilePath
distDir) =
  FilePath -> (FilePath -> IO ()) -> IO ()
Watch.run FilePath
srcDir (FilePath -> RenderMode -> FilePath -> FilePath -> IO ()
Build.buildFile FilePath
srcDir RenderMode
renderMode FilePath
distDir)
run (Command.Serve FilePath
srcDir FilePath
distDir) = FilePath -> FilePath -> IO ()
Serve.run FilePath
srcDir FilePath
distDir
run (Command.Report FilePath
srcDir) = FilePath -> IO ()
Report.run FilePath
srcDir
run (Command.Generate FilePath
path) = FilePath -> IO ()
Generate.renderHs FilePath
path
run (Command.CommandWithPath FilePath
path ParseMode
pmode (Command.Render RenderMode
Command.RenderNormal)) = do
  [Block]
nodes <- FilePath -> ParseMode -> IO (Either Error [Block])
executeWithMode FilePath
path ParseMode
pmode IO (Either Error [Block])
-> (Either Error [Block] -> IO [Block]) -> IO [Block]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Error [Block] -> IO [Block]
forall a. Either Error a -> IO a
Error.unwrap
  Text -> IO ()
TL.putStrLn (Text -> IO ()) -> ([Html] -> Text) -> [Html] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Text
Render.renderHtmls ([Html] -> IO ()) -> [Html] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Block] -> [Html]
Render.renderBlocks [Block]
nodes
run (Command.CommandWithPath FilePath
path ParseMode
pmode (Command.Render RenderMode
Command.RenderPretty)) = do
  [Block]
nodes <- FilePath -> ParseMode -> IO (Either Error [Block])
executeWithMode FilePath
path ParseMode
pmode IO (Either Error [Block])
-> (Either Error [Block] -> IO [Block]) -> IO [Block]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Error [Block] -> IO [Block]
forall a. Either Error a -> IO a
Error.unwrap
  Text -> IO ()
T.putStr (Text -> IO ()) -> ([Html] -> Text) -> [Html] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Text
Render.prettyHtmls ([Html] -> IO ()) -> [Html] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Block] -> [Html]
Render.renderBlocks [Block]
nodes
run (Command.CommandWithPath FilePath
path ParseMode
pmode CommandWithPath
Command.Execute) = do
  [Block]
nodes <- FilePath -> ParseMode -> IO (Either Error [Block])
executeWithMode FilePath
path ParseMode
pmode IO (Either Error [Block])
-> (Either Error [Block] -> IO [Block]) -> IO [Block]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Error [Block] -> IO [Block]
forall a. Either Error a -> IO a
Error.unwrap
  Text -> IO ()
TL.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Block] -> Text
forall a. Show a => a -> Text
pShowNoColor [Block]
nodes
run (Command.CommandWithPath FilePath
path ParseMode
pmode (Command.Evaluate Bool
simpl)) = do
  [Block]
nodes <- FilePath -> ParseMode -> IO (Either Error [Block])
evaluateWithMode FilePath
path ParseMode
pmode IO (Either Error [Block])
-> (Either Error [Block] -> IO [Block]) -> IO [Block]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Error [Block] -> IO [Block]
forall a. Either Error a -> IO a
Error.unwrap
  if Bool
simpl
    then Text -> IO ()
TL.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Block] -> Text
forall a. Show a => a -> Text
pShowNoColor ([Block] -> Text) -> [Block] -> Text
forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
Evaluate.simplify [Block]
nodes
    else Text -> IO ()
TL.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Block] -> Text
forall a. Show a => a -> Text
pShowNoColor [Block]
nodes
run (Command.CommandWithPath FilePath
path ParseMode
pmode CommandWithPath
Command.Parse) = do
  [Block]
nodes <- FilePath -> ParseMode -> IO (Either Error [Block])
parseWithMode FilePath
path ParseMode
pmode IO (Either Error [Block])
-> (Either Error [Block] -> IO [Block]) -> IO [Block]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Error [Block] -> IO [Block]
forall a. Either Error a -> IO a
Error.unwrap
  Text -> IO ()
TL.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Block] -> Text
forall a. Show a => a -> Text
pShowNoColor [Block]
nodes
run (Command.CommandWithPath FilePath
path ParseMode
pmode CommandWithPath
Command.Classes) = do
  [Block]
nodes <- FilePath -> ParseMode -> IO (Either Error [Block])
parseWithMode FilePath
path ParseMode
pmode IO (Either Error [Block])
-> (Either Error [Block] -> IO [Block]) -> IO [Block]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Error [Block] -> IO [Block]
forall a. Either Error a -> IO a
Error.unwrap
  (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> IO ()
T.putStrLn ([Text] -> IO ()) -> [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Block] -> [Text]
Syntax.extractClasses [Block]
nodes
run (Command.CommandWithPath FilePath
path ParseMode
pmode (Command.Fragments Maybe Text
mname)) = do
  [Block]
nodes <- FilePath -> ParseMode -> IO (Either Error [Block])
parseWithMode FilePath
path ParseMode
pmode IO (Either Error [Block])
-> (Either Error [Block] -> IO [Block]) -> IO [Block]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Error [Block] -> IO [Block]
forall a. Either Error a -> IO a
Error.unwrap
  let ms :: [BlockFragment]
ms = [Block] -> [BlockFragment]
Syntax.extractFragments [Block]
nodes
  case Maybe Text
mname of
    Just Text
name -> case Text -> [BlockFragment] -> Maybe [Block]
Syntax.findFragment Text
name [BlockFragment]
ms of
      Just [Block]
m -> Text -> IO ()
TL.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Block] -> Text
forall a. Show a => a -> Text
pShowNoColor [Block]
m
      Maybe [Block]
Nothing -> FilePath -> IO ()
putStrLn FilePath
"No such fragment."
    Maybe Text
Nothing -> Text -> IO ()
TL.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [BlockFragment] -> Text
forall a. Show a => a -> Text
pShowNoColor [BlockFragment]
ms

--------------------------------------------------------------------------------
parseWithMode
  :: FilePath
  -> Command.ParseMode
  -> IO (Either Error.Error [Syntax.Block])
parseWithMode :: FilePath -> ParseMode -> IO (Either Error [Block])
parseWithMode FilePath
path ParseMode
pmode = 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 -> ParseMode -> ExceptT Error IO [Block]
parseWithModeE FilePath
path ParseMode
pmode

evaluateWithMode
  :: FilePath
  -> Command.ParseMode
  -> IO (Either Error.Error [Syntax.Block])
evaluateWithMode :: FilePath -> ParseMode -> IO (Either Error [Block])
evaluateWithMode FilePath
path ParseMode
pmode = 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 -> ParseMode -> ExceptT Error IO [Block]
evaluateWithModeE FilePath
path ParseMode
pmode

executeWithMode
  :: FilePath
  -> Command.ParseMode
  -> IO (Either Error.Error [Syntax.Block])
executeWithMode :: FilePath -> ParseMode -> IO (Either Error [Block])
executeWithMode FilePath
path ParseMode
pmode = 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 -> ParseMode -> ExceptT Error IO [Block]
executeWithModeE FilePath
path ParseMode
pmode

--------------------------------------------------------------------------------
parseWithModeE
  :: FilePath
  -> Command.ParseMode
  -> ExceptT Error.Error IO [Syntax.Block]
parseWithModeE :: FilePath -> ParseMode -> ExceptT Error IO [Block]
parseWithModeE FilePath
path ParseMode
pmode =
  case ParseMode
pmode of
    ParseMode
Command.ParseShallow -> FilePath -> ExceptT Error IO [Block]
Parse.parseFileE FilePath
path
    ParseMode
Command.ParseDeep -> FilePath -> ExceptT Error IO [Block]
PreProcess.preprocessFileE FilePath
path

evaluateWithModeE
  :: FilePath
  -> Command.ParseMode
  -> ExceptT Error.Error IO [Syntax.Block]
evaluateWithModeE :: FilePath -> ParseMode -> ExceptT Error IO [Block]
evaluateWithModeE FilePath
path ParseMode
pmode = do
  [Block]
parsed <- FilePath -> ParseMode -> ExceptT Error IO [Block]
parseWithModeE FilePath
path ParseMode
pmode
  Env -> [Text] -> [Block] -> ExceptT Error IO [Block]
forall (m :: * -> *).
Monad m =>
Env -> [Text] -> [Block] -> ExceptT Error m [Block]
Evaluate.evaluate Env
Evaluate.defaultEnv [FilePath -> Text
T.pack FilePath
path] [Block]
parsed

executeWithModeE
  :: FilePath
  -> Command.ParseMode
  -> ExceptT Error.Error IO [Syntax.Block]
executeWithModeE :: FilePath -> ParseMode -> ExceptT Error IO [Block]
executeWithModeE FilePath
path ParseMode
pmode =
  FilePath -> ParseMode -> ExceptT Error IO [Block]
evaluateWithModeE FilePath
path ParseMode
pmode 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.execute FilePath
path

--------------------------------------------------------------------------------
-- Play with the whole language.

parse :: Text -> IO ()
parse :: Text -> IO ()
parse Text
s = do
  Either Error [Block]
blocks <- 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
$ (ParseErrorBundle Text Void -> Error)
-> ExceptT (ParseErrorBundle Text Void) IO [Block]
-> ExceptT Error IO [Block]
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ParseErrorBundle Text Void -> Error
Error.ParseError (ExceptT (ParseErrorBundle Text Void) IO [Block]
 -> ExceptT Error IO [Block])
-> (Either (ParseErrorBundle Text Void) [Block]
    -> ExceptT (ParseErrorBundle Text Void) IO [Block])
-> Either (ParseErrorBundle Text Void) [Block]
-> ExceptT Error IO [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseErrorBundle Text Void) [Block]
-> ExceptT (ParseErrorBundle Text Void) IO [Block]
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either (ParseErrorBundle Text Void) [Block]
 -> ExceptT Error IO [Block])
-> Either (ParseErrorBundle Text Void) [Block]
-> ExceptT Error IO [Block]
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> Either (ParseErrorBundle Text Void) [Block]
Parse.parse FilePath
"-" Text
s
  Either Error [Block] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pPrintNoColor Either Error [Block]
blocks

-- | "eval" parses a string as a "Syntax.Syntax", and evaluates it. This doesn't
-- run the proprocessing stage.
--
-- @
--     Run.eval "p= 1 + 2 * 3"
-- @
eval :: Text -> IO ()
eval :: Text -> IO ()
eval Text
s = do
  Either Error [Block]
x <- 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
$ Text -> ExceptT Error IO [Block]
parseAndEvaluateBlocks Text
s
  Either Error [Block] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pPrintNoColor Either Error [Block]
x

-- | Run "eval" and render the result.
render :: Text -> IO ()
render :: Text -> IO ()
render Text
s = do
  [Block]
x <- ExceptT Error IO [Block] -> IO (Either Error [Block])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Text -> ExceptT Error IO [Block]
parseAndEvaluateBlocks Text
s) IO (Either Error [Block])
-> (Either Error [Block] -> IO [Block]) -> IO [Block]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Error [Block] -> IO [Block]
forall a. Either Error a -> IO a
Error.unwrap
  Text -> IO ()
T.putStr (Text -> IO ()) -> ([Html] -> Text) -> [Html] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Text
Render.prettyHtmls ([Html] -> IO ()) -> [Html] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Block] -> [Html]
Render.renderBlocks [Block]
x

parseAndEvaluateBlocks :: Text -> ExceptT Error.Error IO [Syntax.Block]
parseAndEvaluateBlocks :: Text -> ExceptT Error IO [Block]
parseAndEvaluateBlocks Text
s = do
  [Block]
blocks <- (ParseErrorBundle Text Void -> Error)
-> ExceptT (ParseErrorBundle Text Void) IO [Block]
-> ExceptT Error IO [Block]
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ParseErrorBundle Text Void -> Error
Error.ParseError (ExceptT (ParseErrorBundle Text Void) IO [Block]
 -> ExceptT Error IO [Block])
-> (Either (ParseErrorBundle Text Void) [Block]
    -> ExceptT (ParseErrorBundle Text Void) IO [Block])
-> Either (ParseErrorBundle Text Void) [Block]
-> ExceptT Error IO [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseErrorBundle Text Void) [Block]
-> ExceptT (ParseErrorBundle Text Void) IO [Block]
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either (ParseErrorBundle Text Void) [Block]
 -> ExceptT Error IO [Block])
-> Either (ParseErrorBundle Text Void) [Block]
-> ExceptT Error IO [Block]
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> Either (ParseErrorBundle Text Void) [Block]
Parse.parse FilePath
"-" Text
s
  Env -> [Text] -> [Block] -> ExceptT Error IO [Block]
forall (m :: * -> *).
Monad m =>
Env -> [Text] -> [Block] -> ExceptT Error m [Block]
Evaluate.evaluate Env
Evaluate.defaultEnv [] [Block]
blocks

--------------------------------------------------------------------------------
-- Play with the expression language.

-- | "calc" parses a string as a "Syntax.Expr", and evaluates it. I.e. it
-- doens't use the fragment syntax, or imports and includes.
--
-- @
--     Run.calc "1 + 2 * 3"
-- @
calc :: Text -> IO ()
calc :: Text -> IO ()
calc Text
s = do
  Either Error Expr
x <- ExceptT Error IO Expr -> IO (Either Error Expr)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error IO Expr -> IO (Either Error Expr))
-> ExceptT Error IO Expr -> IO (Either Error Expr)
forall a b. (a -> b) -> a -> b
$ Text -> ExceptT Error IO Expr
parseAndEvaluateExpr Text
s
  Either Error Expr -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pPrintNoColor Either Error Expr
x

parseAndEvaluateExpr :: Text -> ExceptT Error.Error IO Syntax.Expr
parseAndEvaluateExpr :: Text -> ExceptT Error IO Expr
parseAndEvaluateExpr Text
s = do
  Expr
expr <- (ParseErrorBundle Text Void -> Error)
-> ExceptT (ParseErrorBundle Text Void) IO Expr
-> ExceptT Error IO Expr
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ParseErrorBundle Text Void -> Error
Error.ParseError (ExceptT (ParseErrorBundle Text Void) IO Expr
 -> ExceptT Error IO Expr)
-> (Either (ParseErrorBundle Text Void) Expr
    -> ExceptT (ParseErrorBundle Text Void) IO Expr)
-> Either (ParseErrorBundle Text Void) Expr
-> ExceptT Error IO Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (ParseErrorBundle Text Void) Expr
-> ExceptT (ParseErrorBundle Text Void) IO Expr
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either (ParseErrorBundle Text Void) Expr -> ExceptT Error IO Expr)
-> Either (ParseErrorBundle Text Void) Expr
-> ExceptT Error IO Expr
forall a b. (a -> b) -> a -> b
$ Text -> Either (ParseErrorBundle Text Void) Expr
Parse.parseExpr Text
s
  Env -> Expr -> ExceptT Error IO Expr
forall (m :: * -> *).
Monad m =>
Env -> Expr -> ExceptT Error m Expr
Evaluate.evalExpr Env
Evaluate.defaultEnv Expr
expr