docs etc

README.md

@@ -0,0 +1,4 @@
+
+# reploy
+
+A redo of deployment of R3 sites.

Types.hs

@@ -0,0 +1,60 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | Separated-out main types of the deployment scriptage.
+module Types where
+
+import Control.Monad.Trans.State.Lazy
+import qualified Data.Map as M
+import qualified Data.Set as S
+import qualified Data.Yaml as Y
+import Lens.Micro.TH
+import qualified Text.Mustache as Mu
+import qualified Text.Pandoc.Definition
+
+-- | Information about a single deployed page (with metadata etc).
+data PageInfo =
+  PageInfo
+    { _pagePath :: FilePath -- ^ original path to the markdown file
+    , _pageMeta :: Y.Value -- ^ YAML metadata extracted from the file
+    , _pagePandoc :: Text.Pandoc.Definition.Pandoc -- ^ Page data
+    }
+  deriving (Show)
+
+makeLenses ''PageInfo
+
+-- | Complete internal state of the deployment process that holds all data
+data SiteState =
+  SiteState
+    -- | Map of page mounts to `PageInfo`
+    { _pages :: M.Map FilePath PageInfo
+    -- | Map of redirects (from -> to)
+    , _redirects :: M.Map FilePath FilePath
+    -- | Map of tags, assigning to each tag sequence a list of
+    -- tagged page mounts
+    , _htags :: M.Map [String] [FilePath]
+    -- | List of installed files (prevents overwriting)
+    , _installs :: S.Set FilePath
+    -- | Map of Mustache templates organized by template search path (within
+    -- the template directory)
+    , _templates :: M.Map FilePath Mu.Template
+    , _outputDir :: FilePath -- ^ Directory for output
+    , _defaultTemplate :: FilePath -- ^ Name of the default template
+    }
+  deriving (Show)
+
+makeLenses ''SiteState
+
+-- | Make a completely empty `SiteState` for the `Site` monad.
+emptySiteState =
+  SiteState
+    { _pages = M.empty
+    , _redirects = M.empty
+    , _htags = M.empty
+    , _installs = S.empty
+    , _templates = M.empty
+    , _outputDir = "_site"
+    , _defaultTemplate = "default.html"
+    }
+
+-- | Monad for running the site generator.
+type Site a = StateT SiteState IO a

reploy.cabal

@@ -5,6 +5,7 @@ cabal-version:      >= 1.10
 
 executable site
   main-is:          site.hs
+  other-modules:    Types
   build-depends:    base == 4.*
                   , containers
                   , data-default
@@ -18,6 +19,7 @@ executable site
                   , mustache
                   , pandoc
                   , pandoc-types
+                  , parsec
                   , text
                   , transformers
                   , yaml

site.hs

@@ -1,6 +1,8 @@
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE OverloadedStrings #-}
 
+-- | The main deployment script.
+module Main where
+
 import Control.Monad (unless, when)
 import Control.Monad.IO.Class
 import Control.Monad.Trans.State.Lazy
@@ -19,63 +21,31 @@ import Hakyll.Core.Util.File (getRecursiveContents, makeDirectories)
 import Lens.Micro
 import Lens.Micro.Aeson
 import Lens.Micro.Mtl
-import Lens.Micro.TH
 import System.Environment (getArgs)
 import System.FilePath ((</>), splitPath)
 import qualified Text.Mustache as Mu
+import qualified Text.Parsec.Error
 import Text.Pandoc.Class (runIOorExplode)
-import qualified Text.Pandoc.Definition
 import qualified Text.Pandoc.Extensions
 import Text.Pandoc.Options (ReaderOptions(..))
 import Text.Pandoc.Readers.Markdown (readMarkdown)
 
-import Debug.Trace
+import Types
 
+-- | A shortcut for `liftIO`.
 io :: MonadIO m => IO a -> m a
 io = liftIO
 
+-- | A helper for throwing an error if something is `Nothing`
+just :: String -> Maybe a -> a
 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 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 Mu.Template -- TODO mustache templates
-    , _outputDir :: FilePath
-    , _defaultTemplate :: FilePath
-    }
-  deriving (Show)
-
-makeLenses ''SiteState
-
-emptySiteState out =
-  SiteState
-    { _pages = M.empty
-    , _redirects = M.empty
-    , _htags = M.empty
-    , _installs = M.empty
-    , _templates = M.empty
-    , _outputDir = out
-    , _defaultTemplate = "default.html"
-    }
-
-type Site a = StateT SiteState IO a
-
+-- | Test for whether something listy has a suffix
+hasSuffix :: Eq a => [a] -> [a] -> Bool
 hasSuffix s = isJust . stripSuffix s
 
+-- | Load the pages from a directory and add them to `pages`.
 sourcePages :: FilePath -> Site ()
 sourcePages fp = do
   links <-
@@ -83,6 +53,7 @@ sourcePages fp = do
     getRecursiveContents (pure . const False) fp
   traverse_ loadPage (map (fp </>) links)
 
+-- | Default markdown reading options for Pandoc.
 markdownReadOpts =
   def
     { readerExtensions =
@@ -91,69 +62,94 @@ markdownReadOpts =
           Text.Pandoc.Extensions.pandocExtensions
     }
 
+{- | Extract `PageInfo` about a single page and save it into `pages` in
+ - `SiteState`. -}
 loadPage :: FilePath -> Site ()
 loadPage fp = do
+  io $ putStrLn $ "<<< " ++ fp
   txt <- io $ TIO.readFile fp
+  {- tear out the metadata manually -}
   (T.take 4 txt == "---\n") `unless`
     error ("metadata block start missing in " ++ fp)
   let (meta, markdown) = T.breakOn "\n---\n" (T.drop 4 txt)
   T.null meta `when` error ("metadata block bad in " ++ fp)
+  {- parse everything -}
   yml <- Y.decodeThrow $ Data.Text.Encoding.encodeUtf8 meta
   md <- io $ runIOorExplode $ readMarkdown markdownReadOpts (T.drop 5 markdown)
+  {- find the main mount point for the page -}
   let mount =
         T.unpack . just ("mount point of " ++ fp) $ yml ^? key "title" . _String
+  {- save to the state -}
   pages %=
     M.insert mount PageInfo {_pagePath = fp, _pageMeta = yml, _pagePandoc = md}
 
+-- | Find which template to use for rendering a page.
 pageTemplate :: PageInfo -> Site FilePath
 pageTemplate pi = do
   dt <- use defaultTemplate
   pure . maybe dt T.unpack $ pi ^? pageMeta . key "template" . _String
 
+-- | Collect all templates required for rendering the currently loaded pages.
 pageTemplates :: Site [FilePath]
 pageTemplates = nub <$> (gets (^.. pages . traverse) >>= traverse pageTemplate)
 
+compileTemplate :: FilePath -> FilePath -> Site (Either Text.Parsec.Error.ParseError Mu.Template)
+compileTemplate templdir templ = io $ do
+  putStrLn $ "TTT " ++ (templdir </> templ)
+  Mu.automaticCompile [templdir] templ
+
+-- | Use a template set from a given directory.
 sourceTemplates :: FilePath -> Site ()
 sourceTemplates templdir = do
   ts <- pageTemplates
-  templs' <- fmap sequence . traverse (io . Mu.automaticCompile [templdir]) $ ts
+  templs' <- fmap sequence . traverse (compileTemplate templdir) $ ts
   case templs' of
     Left err -> error $ "template compilation: " ++ show err
     Right templs -> templates .= M.fromList (zip ts templs)
 
+-- | Find the path to the "index.html"  of a given mount.
 indexFilename :: FilePath -> Site FilePath
 indexFilename mount = do
   od <- use outputDir
   pure (od </> mount </> "index.html")
 
+-- | Render a page using the current template.
 installPage :: FilePath -> PageInfo -> Site ()
 installPage mount pi = do
-  tname <- fromString <$> pageTemplate pi
-  templ <- use $ templates . to (M.! tname)
+  {- find the correct template and metadata -}
+  tname <- pageTemplate pi
+  templ <- use $ templates . to (M.! fromString tname)
   file <- indexFilename mount
   io $ do
     putStrLn $ ">>> " ++ file
     makeDirectories file
     TIO.writeFile file . Mu.substitute templ $ pi ^. pageMeta
 
+{- | Install a file. Files are installed into a single shared location. That
+ - prevents file duplication and also gives a bit of control for where the
+ - files reside and what are their names. -}
 installFile :: FilePath -> Site FilePath
 installFile = undefined
 
-makeRedirect :: FilePath -> FilePath -> Site ()
-makeRedirect = undefined
+{- | Install a simple redirect handler page. -}
+installRedirect :: FilePath -> FilePath -> Site ()
+installRedirect = undefined
 
-makeRedirects :: Site ()
-makeRedirects = undefined
+-- | Install all redirects required by pages.
+installRedirects :: Site ()
+installRedirects = undefined
 
+-- | Render a site for a given tag string.
 renderTag :: [String] -> Site ()
 renderTag = undefined
 
+-- | Render all tag sites.
 renderTags :: Site ()
 renderTags = undefined
 
-main = do
-  [targetDir] <- getArgs
-  flip runStateT (emptySiteState targetDir) $ do
+-- | Build the whole site.
+main =
+  flip runStateT emptySiteState $ do
     traverse sourcePages ["external"]
     sourceTemplates "templates"
     use pages >>= traverse (uncurry installPage) . M.assocs