installs

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

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

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>
+<html>
+{{> head.html}}
 <body>
-        <h1>$title$</h1>
-        $body$
+aaaaaa
 </body>
 </html>