docs etc

1 files changed, 47 insertions, 51 deletions

diff --git a/site.hs b/site.hs
index bc4421c..7fd5195 100644
--- a/site.hs
+++ b/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