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

import Control.Monad.Trans.Except (ExceptT, runExceptT)
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 (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
distDir) = FilePath -> IO ()
Serve.run 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 [Text
"toplevel"] [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