diff --git a/src/Slab/Build.hs b/src/Slab/Build.hs index b6fdad3..febb615 100644 --- a/src/Slab/Build.hs +++ b/src/Slab/Build.hs @@ -43,7 +43,7 @@ buildFile :: FilePath -> Command.RenderMode -> Command.RunMode -> FilePath -> Fi buildFile srcDir mode passthrough distDir path = do let path' = distDir replaceExtension (makeRelative srcDir path) ".html" dir' = takeDirectory path' - ctx = Execute.Context path passthrough + ctx = Execute.Context (Just path) passthrough putStrLn $ "Building " <> path' <> "..." createDirectoryIfMissing True dir' @@ -72,7 +72,7 @@ buildDirInMemory srcDir mode passthrough store = do buildFileInMemory :: FilePath -> Command.RenderMode -> Command.RunMode -> StmStore -> FilePath -> IO () buildFileInMemory srcDir mode passthrough store path = do let path' = replaceExtension (makeRelative srcDir path) ".html" - ctx = Execute.Context path passthrough + ctx = Execute.Context (Just path) passthrough putStrLn $ "Building " <> path' <> "..." mnodes <- Execute.executeFile ctx diff --git a/src/Slab/Command.hs b/src/Slab/Command.hs index 9739b8b..bf93844 100644 --- a/src/Slab/Command.hs +++ b/src/Slab/Command.hs @@ -31,12 +31,13 @@ data Command | Watch FilePath RenderMode RunMode FilePath | Serve FilePath FilePath | ReportPages FilePath - | ReportHeadings FilePath + | ReportHeadings (Maybe FilePath) | -- | Return the content of element matching the provided ID. - ReportElement Text FilePath + ReportElement Text (Maybe FilePath) | -- | Generate code. Only Haskell for now. - Generate FilePath - | CommandWithPath FilePath ParseMode CommandWithPath + Generate (Maybe FilePath) + | -- | When the filepath is Nothing, use stdin. + CommandWithPath (Maybe FilePath) ParseMode CommandWithPath -- | Commands operating on a path. data CommandWithPath @@ -223,8 +224,8 @@ parserReportPages = do parserReportHeadings :: A.Parser Command parserReportHeadings = do - path <- parserTemplatePath - pure $ ReportHeadings path + mpath <- parserTemplatePath + pure $ ReportHeadings mpath parserReportElement :: A.Parser Command parserReportElement = do @@ -232,8 +233,8 @@ parserReportElement = do A.argument A.str (A.metavar "ID" <> A.help "Element ID to match.") - path <- parserTemplatePath - pure $ ReportElement id_ path + mpath <- parserTemplatePath + pure $ ReportElement id_ mpath parserWatch :: A.Parser Command parserWatch = do @@ -296,8 +297,8 @@ parserParse = do parserGenerate :: A.Parser Command parserGenerate = do - path <- parserTemplatePath - pure $ Generate path + mpath <- parserTemplatePath + pure $ Generate mpath parserClasses :: A.Parser Command parserClasses = do @@ -315,14 +316,19 @@ parserFragments = do pure $ uncurry CommandWithPath pathAndmode $ Fragments mname -------------------------------------------------------------------------------- -parserWithPath :: A.Parser (FilePath, ParseMode) +parserWithPath :: A.Parser (Maybe FilePath, ParseMode) parserWithPath = (,) <$> parserTemplatePath <*> parserShallowFlag -parserTemplatePath :: A.Parser FilePath -parserTemplatePath = - A.argument +parserTemplatePath :: A.Parser (Maybe FilePath) +parserTemplatePath = do + path <- A.argument A.str (A.metavar "FILE" <> A.action "file" <> A.help "Slab template to parse.") + pure ( + if path == "-" + then Nothing + else Just path + ) parserShallowFlag :: A.Parser ParseMode parserShallowFlag = diff --git a/src/Slab/Evaluate.hs b/src/Slab/Evaluate.hs index 05afec9..91e5cdd 100644 --- a/src/Slab/Evaluate.hs +++ b/src/Slab/Evaluate.hs @@ -35,12 +35,12 @@ import Slab.Syntax -------------------------------------------------------------------------------- -- | Similar to `preprocessFile` but evaluate the template. -evaluateFile :: FilePath -> IO (Either Error.Error [Block]) +evaluateFile :: Maybe FilePath -> IO (Either Error.Error [Block]) evaluateFile = runExceptT . evaluateFileE -evaluateFileE :: FilePath -> ExceptT Error.Error IO [Block] -evaluateFileE path = - PreProcess.preprocessFileE path >>= evaluate defaultEnv [T.pack path] +evaluateFileE :: Maybe FilePath -> ExceptT Error.Error IO [Block] +evaluateFileE mpath = + PreProcess.preprocessFileE mpath >>= evaluate defaultEnv [maybe "-" T.pack mpath] -------------------------------------------------------------------------------- defaultEnv :: Env diff --git a/src/Slab/Execute.hs b/src/Slab/Execute.hs index 92ce653..a99409b 100644 --- a/src/Slab/Execute.hs +++ b/src/Slab/Execute.hs @@ -30,7 +30,7 @@ import System.Process (readCreateProcessWithExitCode, shell) -------------------------------------------------------------------------------- data Context = Context - { ctxPath :: FilePath + { ctxPath :: Maybe FilePath , ctxRunMode :: Command.RunMode } diff --git a/src/Slab/Generate/Haskell.hs b/src/Slab/Generate/Haskell.hs index 6d3b738..4f1edd7 100644 --- a/src/Slab/Generate/Haskell.hs +++ b/src/Slab/Generate/Haskell.hs @@ -20,9 +20,9 @@ import Slab.PreProcess qualified as PreProcess import Slab.Syntax qualified as Syntax -------------------------------------------------------------------------------- -renderHs :: FilePath -> IO () -renderHs path = do - blocks <- PreProcess.preprocessFile path >>= Error.unwrap +renderHs :: Maybe FilePath -> IO () +renderHs mpath = do + blocks <- PreProcess.preprocessFile mpath >>= Error.unwrap T.putStrLn $ renderModule blocks renderModule :: [Syntax.Block] -> Text diff --git a/src/Slab/Parse.hs b/src/Slab/Parse.hs index fd83026..5feb4f4 100644 --- a/src/Slab/Parse.hs +++ b/src/Slab/Parse.hs @@ -44,13 +44,15 @@ import Text.Megaparsec.Char import Text.Megaparsec.Char.Lexer qualified as L -------------------------------------------------------------------------------- -parseFile :: FilePath -> IO (Either Error.Error [Block]) +parseFile :: Maybe FilePath -> IO (Either Error.Error [Block]) parseFile = runExceptT . parseFileE -parseFileE :: FilePath -> ExceptT Error.Error IO [Block] -parseFileE path = do - content <- liftIO $ T.readFile path - withExceptT Error.ParseError . except $ parse path content +parseFileE :: Maybe FilePath -> ExceptT Error.Error IO [Block] +parseFileE mpath = do + content <- liftIO $ case mpath of + Just path -> T.readFile path + Nothing -> T.getContents + withExceptT Error.ParseError . except $ parse (maybe "-" id mpath) content -------------------------------------------------------------------------------- diff --git a/src/Slab/PreProcess.hs b/src/Slab/PreProcess.hs index 69b6d25..d732652 100644 --- a/src/Slab/PreProcess.hs +++ b/src/Slab/PreProcess.hs @@ -37,15 +37,15 @@ data Context = Context -------------------------------------------------------------------------------- -- | Similar to `parseFile` but pre-process the include statements. -preprocessFile :: FilePath -> IO (Either Error.Error [Block]) +preprocessFile :: Maybe FilePath -> IO (Either Error.Error [Block]) preprocessFile = runExceptT . preprocessFileE -preprocessFileE :: FilePath -> ExceptT Error.Error IO [Block] -preprocessFileE path = do - nodes <- Parse.parseFileE path +preprocessFileE :: Maybe FilePath -> ExceptT Error.Error IO [Block] +preprocessFileE mpath = do + nodes <- Parse.parseFileE mpath let ctx = Context - { ctxStartPath = path + { ctxStartPath = maybe "." id mpath } preprocess ctx nodes @@ -75,7 +75,7 @@ preproc ctx@Context {..} = \case pure $ BlockInclude mname path (Just [node]) | exists -> do -- Parse and process the .slab file. - nodes' <- preprocessFileE includedPath + nodes' <- preprocessFileE (Just includedPath) pure $ BlockInclude mname path (Just nodes') | otherwise -> throwE $ Error.PreProcessError $ "File " <> T.pack includedPath <> " doesn't exist" @@ -103,7 +103,7 @@ preproc ctx@Context {..} = \case throwE $ Error.PreProcessError $ "Extends requires a .slab file" | exists -> do -- Parse and process the .slab file. - body <- preprocessFileE includedPath + body <- preprocessFileE (Just includedPath) args' <- mapM (preproc ctx) args pure $ BlockImport path (Just body) args' | otherwise -> diff --git a/src/Slab/Report.hs b/src/Slab/Report.hs index 1652ed6..8d07fc6 100644 --- a/src/Slab/Report.hs +++ b/src/Slab/Report.hs @@ -42,17 +42,17 @@ isPage Module {moduleNodes = (x : _)} = Syntax.isDoctype x isPage _ = False -------------------------------------------------------------------------------- -reportHeadings :: FilePath -> IO () -reportHeadings path = do - modl <- buildFile False path +reportHeadings :: Maybe FilePath -> IO () +reportHeadings mpath = do + modl <- buildFile False mpath let headings = extractHeadings . Evaluate.simplify $ moduleNodes modl f (Heading level _ t) = show level <> " " <> T.unpack t putStrLn . drawForest . map (fmap f) $ buildTrees headings -------------------------------------------------------------------------------- -reportElement :: Text -> FilePath -> IO () -reportElement i path = do - modl <- buildFile True path +reportElement :: Text -> Maybe FilePath -> IO () +reportElement i mpath = do + modl <- buildFile True mpath let me = extractElement i . Evaluate.simplify $ moduleNodes modl case me of Just e -> pPrintNoColor e >> exitSuccess @@ -65,15 +65,15 @@ reportElement i path = do buildDir :: FilePath -> IO [Module] buildDir srcDir = do templates <- Build.listTemplates srcDir - mapM (buildFile False) templates + mapM (buildFile False . Just) templates -buildFile :: Bool -> FilePath -> IO Module -buildFile quiet path = do - when (not quiet) $ putStrLn $ "Reading " <> path <> "..." - nodes <- Evaluate.evaluateFile path >>= Error.unwrap +buildFile :: Bool -> Maybe FilePath -> IO Module +buildFile quiet mpath = do + when (not quiet) $ putStrLn $ "Reading " <> maybe "stdin" id mpath <> "..." + nodes <- Evaluate.evaluateFile mpath >>= Error.unwrap pure Module - { modulePath = path + { modulePath = maybe "." id mpath , moduleNodes = nodes } diff --git a/src/Slab/Run.hs b/src/Slab/Run.hs index 1ac6b2a..ebba7f2 100644 --- a/src/Slab/Run.hs +++ b/src/Slab/Run.hs @@ -45,7 +45,7 @@ run (Command.Watch srcDir renderMode passthrough distDir) = run (Command.Serve srcDir distDir) = Serve.run srcDir distDir run (Command.ReportPages srcDir) = Report.reportPages srcDir run (Command.ReportHeadings path) = Report.reportHeadings path -run (Command.ReportElement i path) = Report.reportElement i path +run (Command.ReportElement i mpath) = Report.reportElement i mpath run (Command.Generate path) = Generate.renderHs path run (Command.CommandWithPath path pmode (Command.Render Command.RenderNormal passthrough)) = do nodes <- executeWithMode path pmode passthrough >>= Error.unwrap @@ -63,14 +63,14 @@ run (Command.CommandWithPath path pmode (Command.Evaluate simpl)) = do if simpl then TL.putStrLn $ pShowNoColor $ Evaluate.simplify nodes else TL.putStrLn $ pShowNoColor nodes -run (Command.CommandWithPath path pmode Command.Parse) = do - nodes <- parseWithMode path pmode >>= Error.unwrap +run (Command.CommandWithPath mpath pmode Command.Parse) = do + nodes <- parseWithMode mpath pmode >>= Error.unwrap TL.putStrLn $ pShowNoColor nodes -run (Command.CommandWithPath path pmode Command.Classes) = do - nodes <- parseWithMode path pmode >>= Error.unwrap +run (Command.CommandWithPath mpath pmode Command.Classes) = do + nodes <- parseWithMode mpath pmode >>= Error.unwrap mapM_ T.putStrLn $ Syntax.extractClasses nodes -run (Command.CommandWithPath path pmode (Command.Fragments mname)) = do - nodes <- parseWithMode path pmode >>= Error.unwrap +run (Command.CommandWithPath mpath pmode (Command.Fragments mname)) = do + nodes <- parseWithMode mpath pmode >>= Error.unwrap let ms = Syntax.extractFragments nodes case mname of Just name -> case Syntax.findFragment name ms of @@ -80,49 +80,51 @@ run (Command.CommandWithPath path pmode (Command.Fragments mname)) = do -------------------------------------------------------------------------------- parseWithMode - :: FilePath + :: (Maybe FilePath) -> Command.ParseMode -> IO (Either Error.Error [Syntax.Block]) -parseWithMode path pmode = runExceptT $ parseWithModeE path pmode +parseWithMode mpath pmode = runExceptT $ parseWithModeE mpath pmode evaluateWithMode - :: FilePath + :: Maybe FilePath -> Command.ParseMode -> IO (Either Error.Error [Syntax.Block]) -evaluateWithMode path pmode = runExceptT $ evaluateWithModeE path pmode +evaluateWithMode mpath pmode = runExceptT $ evaluateWithModeE mpath pmode executeWithMode - :: FilePath + :: Maybe FilePath -> Command.ParseMode -> Command.RunMode -> IO (Either Error.Error [Syntax.Block]) -executeWithMode path pmode passthrough = runExceptT $ executeWithModeE path pmode passthrough +executeWithMode mpath pmode passthrough = + runExceptT $ executeWithModeE mpath pmode passthrough -------------------------------------------------------------------------------- parseWithModeE - :: FilePath + :: Maybe FilePath -> Command.ParseMode -> ExceptT Error.Error IO [Syntax.Block] -parseWithModeE path pmode = +parseWithModeE mpath pmode = case pmode of - Command.ParseShallow -> Parse.parseFileE path - Command.ParseDeep -> PreProcess.preprocessFileE path + Command.ParseShallow -> Parse.parseFileE mpath + Command.ParseDeep -> PreProcess.preprocessFileE mpath evaluateWithModeE - :: FilePath + :: Maybe FilePath -> Command.ParseMode -> ExceptT Error.Error IO [Syntax.Block] -evaluateWithModeE path pmode = do - parsed <- parseWithModeE path pmode - Evaluate.evaluate Evaluate.defaultEnv [T.pack path] parsed +evaluateWithModeE mpath pmode = do + parsed <- parseWithModeE mpath pmode + Evaluate.evaluate Evaluate.defaultEnv [maybe "-" T.pack mpath] parsed executeWithModeE - :: FilePath + :: Maybe FilePath -> Command.ParseMode -> Command.RunMode -> ExceptT Error.Error IO [Syntax.Block] -executeWithModeE path pmode passthrough = - evaluateWithModeE path pmode >>= Execute.execute (Execute.Context path passthrough) +executeWithModeE mpath pmode passthrough = + evaluateWithModeE mpath pmode >>= + Execute.execute (Execute.Context mpath passthrough) -------------------------------------------------------------------------------- -- Play with the whole language. diff --git a/tests/Slab/Runner.hs b/tests/Slab/Runner.hs index 888f69f..ea1367a 100644 --- a/tests/Slab/Runner.hs +++ b/tests/Slab/Runner.hs @@ -53,7 +53,7 @@ mkGoldenTest path = do where action :: IO Text action = do - let ctx = Execute.Context path Command.RunNormal + let ctx = Execute.Context (Just path) Command.RunNormal evaluated <- Execute.executeFile ctx case evaluated of Left _ -> pure "TODO"