-- |
-- Module      : Slab.Build
-- Description : Build Slab templates to HTML
--
-- @Slab.Build@ provides types and functions to easily build Slab templates.
-- There are mostly two ways to build templates: by writing the resulting HTML
-- to files, or by writing them to an @STM@-based store.
--
-- Writing to disk is used by the @slab watch@ command. Writing to the @STM@
-- store is used by the @slab serve@ command.
module Slab.Build
  ( buildDir
  , buildFile
  , StmStore
  , buildDirInMemory
  , buildFileInMemory
  , listTemplates
  ) where

import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM qualified as STM
import Data.List (sort)
import Data.Map qualified as M
import Data.Text.IO qualified as T
import Data.Text.Lazy.IO qualified as TL
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.Render qualified as Render
import Slab.Syntax qualified as Syntax
import System.Directory (createDirectoryIfMissing)
import System.FilePath (makeRelative, replaceExtension, takeDirectory, (</>))
import System.FilePath.Glob qualified as Glob

--------------------------------------------------------------------------------
buildDir :: FilePath -> Command.RenderMode -> FilePath -> IO ()
buildDir :: FilePath -> RenderMode -> FilePath -> IO ()
buildDir FilePath
srcDir RenderMode
mode FilePath
distDir = do
  [FilePath]
templates <- FilePath -> IO [FilePath]
listTemplates FilePath
srcDir
  (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> RenderMode -> FilePath -> FilePath -> IO ()
buildFile FilePath
srcDir RenderMode
mode FilePath
distDir) [FilePath]
templates

buildFile :: FilePath -> Command.RenderMode -> FilePath -> FilePath -> IO ()
buildFile :: FilePath -> RenderMode -> FilePath -> FilePath -> IO ()
buildFile FilePath
srcDir RenderMode
mode FilePath
distDir FilePath
path = do
  let path' :: FilePath
path' = FilePath
distDir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath -> FilePath
replaceExtension (FilePath -> FilePath -> FilePath
makeRelative FilePath
srcDir FilePath
path) FilePath
".html"
      dir' :: FilePath
dir' = FilePath -> FilePath
takeDirectory FilePath
path'
  FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Building " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path' FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"..."
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir'

  [Block]
nodes <- FilePath -> IO (Either Error [Block])
Execute.executeFile FilePath
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
  if [Block] -> [Block]
Evaluate.simplify [Block]
nodes [Block] -> [Block] -> Bool
forall a. Eq a => a -> a -> Bool
== []
    then FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"No generated content for " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path
    else case RenderMode
mode of
      RenderMode
Command.RenderNormal ->
        FilePath -> Text -> IO ()
TL.writeFile FilePath
path' (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
      RenderMode
Command.RenderPretty ->
        FilePath -> Text -> IO ()
T.writeFile FilePath
path' (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

--------------------------------------------------------------------------------

type Store = M.Map FilePath [Syntax.Block]

type StmStore = STM.TVar Store

-- | A version of `buildDir` that doesn't write files to disk, but instead
-- record the generated `Syntax.Block`s in STM.
buildDirInMemory :: FilePath -> Command.RenderMode -> StmStore -> IO ()
buildDirInMemory :: FilePath -> RenderMode -> StmStore -> IO ()
buildDirInMemory FilePath
srcDir RenderMode
mode StmStore
store = do
  [FilePath]
templates <- FilePath -> IO [FilePath]
listTemplates FilePath
srcDir
  (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> RenderMode -> StmStore -> FilePath -> IO ()
buildFileInMemory FilePath
srcDir RenderMode
mode StmStore
store) [FilePath]
templates

buildFileInMemory :: FilePath -> Command.RenderMode -> StmStore -> FilePath -> IO ()
buildFileInMemory :: FilePath -> RenderMode -> StmStore -> FilePath -> IO ()
buildFileInMemory FilePath
srcDir RenderMode
mode StmStore
store FilePath
path = do
  let path' :: FilePath
path' = FilePath -> FilePath -> FilePath
replaceExtension (FilePath -> FilePath -> FilePath
makeRelative FilePath
srcDir FilePath
path) FilePath
".html"
  FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Building " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path' FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"..."

  Either Error [Block]
mnodes <- FilePath -> IO (Either Error [Block])
Execute.executeFile FilePath
path
  case Either Error [Block]
mnodes of
    Right [Block]
nodes ->
      if [Block] -> [Block]
Evaluate.simplify [Block]
nodes [Block] -> [Block] -> Bool
forall a. Eq a => a -> a -> Bool
== []
        then FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"No generated content for " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path
        else case RenderMode
mode of
          RenderMode
Command.RenderNormal ->
            STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ StmStore -> (Store -> Store) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
STM.modifyTVar StmStore
store (FilePath -> [Block] -> Store -> Store
writeStore FilePath
path' [Block]
nodes)
          RenderMode
Command.RenderPretty ->
            STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ StmStore -> (Store -> Store) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
STM.modifyTVar StmStore
store (FilePath -> [Block] -> Store -> Store
writeStore FilePath
path' [Block]
nodes)
    Left Error
err -> Error -> IO ()
Error.display Error
err

writeStore :: FilePath -> [Syntax.Block] -> Store -> Store
writeStore :: FilePath -> [Block] -> Store -> Store
writeStore FilePath
path [Block]
blocks = FilePath -> [Block] -> Store -> Store
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert FilePath
path [Block]
blocks

--------------------------------------------------------------------------------
listTemplates :: FilePath -> IO [FilePath]
listTemplates :: FilePath -> IO [FilePath]
listTemplates FilePath
templatesDir = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> FilePath -> IO [FilePath]
Glob.globDir1 Pattern
pat FilePath
templatesDir
 where
  pat :: Pattern
pat = FilePath -> Pattern
Glob.compile FilePath
"**/*.slab"