diff options
| -rw-r--r-- | pagedeploy.cabal | 19 | ||||
| -rw-r--r-- | site.hs | 63 | ||||
| -rw-r--r-- | templates/default.html | 16 |
3 files changed, 66 insertions, 32 deletions
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 - , pandoc - , pandoc-types + , data-default + , extra + , filepath + , hakyll == 4.16.* , microlens - , microlens-th - , microlens-mtl , microlens-aeson - , data-default + , microlens-mtl + , microlens-th + , mustache + , pandoc + , pandoc-types , text + , transformers , yaml ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 @@ -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} -sourceTemplates :: FilePath -> Site () -sourceTemplates _ = pure () +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) -installPage :: FilePath -> Site () -installPage = undefined +sourceTemplates :: FilePath -> Site () +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) + +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 @@ -<!doctype html> -<html lang="en"> - <head> - <meta charset="utf-8"> - <meta name="viewport" content="width=device-width, initial-scale=1"> - <title>My Stuffs - $title$</title> - </head> - <body> - <h1>$title$</h1> - $body$ - </body> +<html> +{{> head.html}} +<body> +aaaaaa +</body> </html> |