-- |
-- 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 (when)
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 System.FilePath (takeExtension)
import Text.Pretty.Simple (pPrintNoColor, pShowNoColor)

--------------------------------------------------------------------------------
run :: Command.Command -> IO ()
run :: Command -> IO ()
run (Command.Build String
srcDir RenderMode
renderMode RunMode
passthrough String
distDir) =
  String -> RenderMode -> RunMode -> String -> IO ()
Build.buildDir String
srcDir RenderMode
renderMode RunMode
passthrough String
distDir
run (Command.Watch String
srcDir RenderMode
renderMode RunMode
passthrough String
distDir) =
  String -> (String -> IO ()) -> IO ()
Watch.run String
srcDir ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
path -> do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> String
takeExtension String
path String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".slab") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> RenderMode -> RunMode -> String -> String -> IO ()
Build.buildFile String
srcDir RenderMode
renderMode RunMode
passthrough String
distDir String
path
run (Command.Serve String
srcDir String
distDir) = String -> String -> IO ()
Serve.run String
srcDir String
distDir
run (Command.ReportPages String
srcDir) = String -> IO ()
Report.reportPages String
srcDir
run (Command.ReportHeadings String
path) = String -> IO ()
Report.reportHeadings String
path
run (Command.Generate String
path) = String -> IO ()
Generate.renderHs String
path
run (Command.CommandWithPath String
path ParseMode
pmode (Command.Render RenderMode
Command.RenderNormal RunMode
passthrough)) = do
  [Block]
nodes <- String -> ParseMode -> RunMode -> IO (Either Error [Block])
executeWithMode String
path ParseMode
pmode RunMode
passthrough 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 String
path ParseMode
pmode (Command.Render RenderMode
Command.RenderPretty RunMode
passthrough)) = do
  [Block]
nodes <- String -> ParseMode -> RunMode -> IO (Either Error [Block])
executeWithMode String
path ParseMode
pmode RunMode
passthrough 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 String
path ParseMode
pmode (Command.Execute Bool
simpl RunMode
passthrough)) = do
  [Block]
nodes <- String -> ParseMode -> RunMode -> IO (Either Error [Block])
executeWithMode String
path ParseMode
pmode RunMode
passthrough 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 String
path ParseMode
pmode (Command.Evaluate Bool
simpl)) = do
  [Block]
nodes <- String -> ParseMode -> IO (Either Error [Block])
evaluateWithMode String
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 String
path ParseMode
pmode CommandWithPath
Command.Parse) = do
  [Block]
nodes <- String -> ParseMode -> IO (Either Error [Block])
parseWithMode String
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 String
path ParseMode
pmode CommandWithPath
Command.Classes) = do
  [Block]
nodes <- String -> ParseMode -> IO (Either Error [Block])
parseWithMode String
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 String
path ParseMode
pmode (Command.Fragments Maybe Text
mname)) = do
  [Block]
nodes <- String -> ParseMode -> IO (Either Error [Block])
parseWithMode String
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 -> String -> IO ()
putStrLn String
"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 :: String -> ParseMode -> IO (Either Error [Block])
parseWithMode String
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
$ String -> ParseMode -> ExceptT Error IO [Block]
parseWithModeE String
path ParseMode
pmode

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

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

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

evaluateWithModeE
  :: FilePath
  -> Command.ParseMode
  -> ExceptT Error.Error IO [Syntax.Block]
evaluateWithModeE :: String -> ParseMode -> ExceptT Error IO [Block]
evaluateWithModeE String
path ParseMode
pmode = do
  [Block]
parsed <- String -> ParseMode -> ExceptT Error IO [Block]
parseWithModeE String
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 [String -> Text
T.pack String
path] [Block]
parsed

executeWithModeE
  :: FilePath
  -> Command.ParseMode
  -> Command.RunMode
  -> ExceptT Error.Error IO [Syntax.Block]
executeWithModeE :: String -> ParseMode -> RunMode -> ExceptT Error IO [Block]
executeWithModeE String
path ParseMode
pmode RunMode
passthrough =
  String -> ParseMode -> ExceptT Error IO [Block]
evaluateWithModeE String
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
>>= Context -> [Block] -> ExceptT Error IO [Block]
Execute.execute (String -> RunMode -> Context
Execute.Context String
path RunMode
passthrough)

--------------------------------------------------------------------------------
-- 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
$ String -> Text -> Either (ParseErrorBundle Text Void) [Block]
Parse.parse String
"-" 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
$ String -> Text -> Either (ParseErrorBundle Text Void) [Block]
Parse.parse String
"-" 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