module Slab.Report
( run
) where
import Slab.Build qualified as Build
import Slab.Error qualified as Error
import Slab.Evaluate qualified as Evaluate
import Slab.Syntax qualified as Syntax
run :: FilePath -> IO ()
run :: String -> IO ()
run String
srcDir = do
[Module]
modules <- String -> IO [Module]
buildDir String
srcDir
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Read " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([Module] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Module]
modules) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" modules."
let pages :: [Module]
pages = (Module -> Bool) -> [Module] -> [Module]
forall a. (a -> Bool) -> [a] -> [a]
filter Module -> Bool
isPage [Module]
modules
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show ([Module] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Module]
pages) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" pages."
(Module -> IO ()) -> [Module] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn (String -> IO ()) -> (Module -> String) -> Module -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> String
modulePath) [Module]
pages
data Module = Module
{ Module -> String
modulePath :: FilePath
, Module -> [Block]
moduleNodes :: [Syntax.Block]
}
deriving (Int -> Module -> String -> String
[Module] -> String -> String
Module -> String
(Int -> Module -> String -> String)
-> (Module -> String)
-> ([Module] -> String -> String)
-> Show Module
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Module -> String -> String
showsPrec :: Int -> Module -> String -> String
$cshow :: Module -> String
show :: Module -> String
$cshowList :: [Module] -> String -> String
showList :: [Module] -> String -> String
Show)
isPage :: Module -> Bool
isPage :: Module -> Bool
isPage Module {moduleNodes :: Module -> [Block]
moduleNodes = (Block
x : [Block]
_)} = Block -> Bool
Syntax.isDoctype Block
x
isPage Module
_ = Bool
False
buildDir :: FilePath -> IO [Module]
buildDir :: String -> IO [Module]
buildDir String
srcDir = do
[String]
templates <- String -> IO [String]
Build.listTemplates String
srcDir
(String -> IO Module) -> [String] -> IO [Module]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO Module
buildFile [String]
templates
buildFile :: FilePath -> IO Module
buildFile :: String -> IO Module
buildFile String
path = do
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Reading " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
path String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"..."
[Block]
nodes <- String -> IO (Either Error [Block])
Evaluate.evaluateFile String
path 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
Module -> IO Module
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Module
{ modulePath :: String
modulePath = String
path
, moduleNodes :: [Block]
moduleNodes = [Block]
nodes
}