diff --git a/pagedeploy.cabal b/pagedeploy.cabal index e081cda..124e55f 100644 --- a/pagedeploy.cabal +++ b/pagedeploy.cabal @@ -6,19 +6,20 @@ cabal-version: >= 1.10 executable site main-is: site.hs build-depends: base == 4.* - , hakyll == 4.16.* - , filepath - , extra - , transformers , containers + , data-default + , extra + , filepath + , hakyll == 4.16.* + , microlens + , microlens-aeson + , microlens-mtl + , microlens-th + , mustache , pandoc , pandoc-types - , microlens - , microlens-th - , microlens-mtl - , microlens-aeson - , data-default , text + , transformers , yaml ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 diff --git a/site.hs b/site.hs index 826534e..bc4421c 100644 --- a/site.hs +++ b/site.hs @@ -6,9 +6,11 @@ import Control.Monad.IO.Class import Control.Monad.Trans.State.Lazy import Data.Default (def) import Data.Foldable (traverse_) +import Data.List (nub) import Data.List.Extra (stripSuffix) import qualified Data.Map as M -import Data.Maybe (isJust) +import Data.Maybe (fromMaybe, isJust) +import Data.String (fromString) import qualified Data.Text as T import qualified Data.Text.Encoding import qualified Data.Text.IO as TIO @@ -20,6 +22,7 @@ import Lens.Micro.Mtl import Lens.Micro.TH import System.Environment (getArgs) import System.FilePath ((>), splitPath) +import qualified Text.Mustache as Mu import Text.Pandoc.Class (runIOorExplode) import qualified Text.Pandoc.Definition import qualified Text.Pandoc.Extensions @@ -34,17 +37,25 @@ io = liftIO just _ (Just val) = val just err Nothing = error ("Missing: " ++ err) +data PageInfo = + PageInfo + { _pagePath :: FilePath + , _pageMeta :: Y.Value + , _pagePandoc :: Text.Pandoc.Definition.Pandoc + } + deriving (Show) + +makeLenses ''PageInfo + data SiteState = SiteState - { _pages :: M.Map FilePath ( FilePath - , Y.Value - , Text.Pandoc.Definition.Pandoc -- loc -> (source, meta, markdown) - ) + { _pages :: M.Map FilePath PageInfo , _redirects :: M.Map FilePath FilePath -- from -> to , _htags :: M.Map [String] [FilePath] -- tag sequence -> tagged locs , _installs :: M.Map FilePath FilePath -- file hash -> install location - , _templates :: M.Map FilePath () -- TODO mustache templates + , _templates :: M.Map FilePath Mu.Template -- TODO mustache templates , _outputDir :: FilePath + , _defaultTemplate :: FilePath } deriving (Show) @@ -58,6 +69,7 @@ emptySiteState out = , _installs = M.empty , _templates = M.empty , _outputDir = out + , _defaultTemplate = "default.html" } type Site a = StateT SiteState IO a @@ -90,13 +102,39 @@ loadPage fp = do md <- io $ runIOorExplode $ readMarkdown markdownReadOpts (T.drop 5 markdown) let mount = T.unpack . just ("mount point of " ++ fp) $ yml ^? key "title" . _String - pages %= M.insert mount (fp, yml, md) + pages %= + M.insert mount PageInfo {_pagePath = fp, _pageMeta = yml, _pagePandoc = md} + +pageTemplate :: PageInfo -> Site FilePath +pageTemplate pi = do + dt <- use defaultTemplate + pure . maybe dt T.unpack $ pi ^? pageMeta . key "template" . _String + +pageTemplates :: Site [FilePath] +pageTemplates = nub <$> (gets (^.. pages . traverse) >>= traverse pageTemplate) sourceTemplates :: FilePath -> Site () -sourceTemplates _ = pure () +sourceTemplates templdir = do + ts <- pageTemplates + templs' <- fmap sequence . traverse (io . Mu.automaticCompile [templdir]) $ ts + case templs' of + Left err -> error $ "template compilation: " ++ show err + Right templs -> templates .= M.fromList (zip ts templs) -installPage :: FilePath -> Site () -installPage = undefined +indexFilename :: FilePath -> Site FilePath +indexFilename mount = do + od <- use outputDir + pure (od > mount > "index.html") + +installPage :: FilePath -> PageInfo -> Site () +installPage mount pi = do + tname <- fromString <$> pageTemplate pi + templ <- use $ templates . to (M.! tname) + file <- indexFilename mount + io $ do + putStrLn $ ">>> " ++ file + makeDirectories file + TIO.writeFile file . Mu.substitute templ $ pi ^. pageMeta installFile :: FilePath -> Site FilePath installFile = undefined @@ -116,6 +154,7 @@ renderTags = undefined main = do [targetDir] <- getArgs flip runStateT (emptySiteState targetDir) $ do - traverse sourceTemplates ["templates"] traverse sourcePages ["external"] + sourceTemplates "templates" + use pages >>= traverse (uncurry installPage) . M.assocs get >>= io . print diff --git a/templates/default.html b/templates/default.html index 52c4b44..ca9aee0 100644 --- a/templates/default.html +++ b/templates/default.html @@ -1,12 +1,6 @@ - - -
- - -