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)
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 :: 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
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
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