Minor refactoring.

Makefile

@@ -120,26 +120,28 @@ list:
 
 .PHONY: publish
 publish: setup-check-rsync
-	make all
-	make test
-	@echo "Creating web branch..."
+	@make all
+	@echo "Cleaning intermediate files"
+	rm -rf $(RAW_DIR)
+	@make test
+	@echo "Creating web branch"
 	git fetch --all
 	git checkout -b web --track origin/web
 	rsync -a                    \
-		--filter='P _site/'      \
-		--filter='P _cache/'     \
+		--filter='P $(SITE_DIR)/' \
+		--filter='P $(CACHE_DIR)' \
 		--filter='P .git/'        \
 		--filter='P .gitignore'   \
 		--filter='P .stack-work'  \
 		--filter='P .nojekyll'    \
 		--filter='P CNAME'        \
 		--delete-excluded         \
-		_site/ .
+		$(SITE_DIR) .
 	git add -A
-	@echo "Publishing web branch..."
+	@echo "Publishing web branch"
 	git commit -m "Publish."
 	git push origin web:web
-	@echo "Deleting web branch..."
+	@echo "Deleting web branch"
 	git checkout dev
 	git branch -D web
 

hs/Hakyll/Web/Template/Context/Metadata.hs

@@ -1,25 +1,47 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Hakyll.Web.Template.Context.Metadata where
+module Hakyll.Web.Template.Context.Metadata
+  ( includeContext
+  , metadataContext
+  , objectContext
+  , restoreMetadata
+  ) where
 
 import           Control.Monad ((<=<))
 import           Data.Aeson (Object, Value(..))
+import qualified Data.ByteString.Char8 as BS
 import qualified Data.HashMap.Strict as H
 import qualified Data.Text as T
 import qualified Data.Vector as V
 import           Hakyll
 import           Text.Printf (printf)
+import qualified Data.Yaml as Y
 
--- |Create a context from a JSON object which loads the included file and uses it to generate a context.
-includeContext :: Context String -> Context Object
+
+-- |Create a |Context| from the |Metadata| associated with an |Item|.
+metadataContext
+  :: Context String -- ^ |Context| used when unfolding a JSON |Array| into a |ListField|.
+  -> Context String
+metadataContext ctx = Context $ \k a i -> do
+  let identifier = itemIdentifier i
+  metadata <- getMetadata identifier
+  item <- makeItem metadata
+  unContext (objectContext ctx) k a item
+
+-- |Create a |Context| from a JSON |Object| which loads data from files under "include" keys.
+includeContext
+  :: Context String -- ^ |Context| used when unfolding a JSON |Array| into a |ListField|.
+  -> Context Object
 includeContext ctx = Context $ \k a i -> do
   let o = itemBody i
   v <- lookupObject "include" o
   identifier <- fromFilePath <$> toString v
   unContext (ctx <> metadataContext ctx) k a =<< load identifier
 
--- |Create a Context based on a JSON Object.
-objectContext :: Context String -> Context Object
+-- |Create a |Context| from a JSON |Object|.
+objectContext
+  :: Context String -- ^ |Context| used when unfolding a JSON |Array| into a |ListField|.
+  -> Context Object
 objectContext ctx = Context $ \k _ i -> do
   let o = itemBody i
   decodeValue ctx =<< lookupObject k o
@@ -34,24 +56,30 @@ decodeValue _ctx (Number n) = return . StringField $ show n
 decodeValue _ctx (Bool   b) = return . StringField $ show b
 decodeValue _ctx v          = fail $ printf "Unsupported value '%s'" (show v)
 
--- |Create a Context based on the Metadata.
-metadataContext :: Context String -> Context String
-metadataContext ctx = Context $ \k a i -> do
-  let identifier = itemIdentifier i
-  metadata <- getMetadata identifier
-  item <- makeItem metadata
-  unContext (objectContext ctx) k a item
-
-lookupObject :: String -> Object -> Compiler Value
+-- |Lookup the |Value| stored in an |Object| at the given key.
+lookupObject :: MonadFail m => String -> Object -> m Value
 lookupObject k o = maybe ifNotFound ifFound (H.lookup (T.pack k) o)
   where
     ifFound    = return
     ifNotFound = fail $ printf "Key '%s' undefined in context '%s'" k (show o)
 
+-- |Convert a |Value| to an |Object|, or fail.
 toObject :: MonadFail m => Value -> m Object
 toObject (Object o) = return o
 toObject v          = fail $ printf "Not an object '%s'" (show v)
 
+-- |Convert a |Value| to an |String|, or fail.
 toString :: MonadFail m => Value -> m String
 toString (String s) = return (T.unpack s)
 toString v          = fail $ printf "Not a string '%s'" (show v)
+
+
+-- |Add the original |Metadata| block back to the file.
+restoreMetadata :: Item String -> Compiler (Item String)
+restoreMetadata item = do
+  metadata <- getMetadata (itemIdentifier item)
+  if H.null metadata then
+    return item
+  else do
+    let yaml = "---\n" <> BS.unpack (Y.encode metadata) <> "---\n\n"
+    withItemBody (\body -> return (yaml <> body)) item

hs/Main.hs

@@ -1,14 +1,12 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-import           Control.Monad ((<=<), forM_)
-import qualified Data.ByteString.Char8 as BS
+import           Control.Monad ((<=<), (>=>), forM_)
 import           Data.Char (toLower)
 import           Data.Functor ((<&>))
 import           Data.List (isPrefixOf, stripPrefix)
 import qualified Data.Text as T
 import qualified Data.Text.ICU as RE
 import qualified Data.Text.ICU.Replace as T
-import qualified Data.Yaml as Y
 import           Hakyll
 import           Hakyll.Web.Agda
 import           Hakyll.Web.Routes.Permalink
@@ -149,30 +147,26 @@ main = do
   -- Build function to fix local URLs
   fixLocalLink <- mkFixLocalLink "src"
 
-  -- Build compiler for Markdown pages
-  let pageCompiler :: Compiler (Item String)
-      pageCompiler = do
-        csl <- load cslFileName
-        bib <- load bibFileName
-        getResourceBody
-          >>= saveSnapshot "raw"
-          >>= readMarkdownWith siteReaderOptions
-          >>= processCites csl bib
-          <&> writeHTML5With siteWriterOptions
-          >>= loadAndApplyTemplate "templates/page.html" siteSectionContext
-          >>= loadAndApplyTemplate "templates/default.html" siteSectionContext
-          >>= prettifyUrls
+  let maybeCompileAgda
+        :: Maybe CommandLineOptions -- ^ If this argument is passed, Agda compilation is used.
+        -> Item String
+        -> Compiler (Item String)
+      maybeCompileAgda Nothing     = return
+      maybeCompileAgda (Just opts) =
+        compileAgdaWith opts >=>
+        withItemBody (return . withUrls fixStdlibLink) >=>
+        withItemBody (return . withUrls fixLocalLink)
 
-  -- Build compiler for literate Agda pages
-  let pageWithAgdaCompiler :: CommandLineOptions -> Compiler (Item String)
-      pageWithAgdaCompiler opts = do
+  -- Build compiler for Markdown pages with optional Literate Agda
+  let pageCompiler
+        :: Maybe CommandLineOptions -- ^ If this argument is passed, Agda compilation is used.
+        -> Compiler (Item String)
+      pageCompiler maybeOpts = do
         csl <- load cslFileName
         bib <- load bibFileName
         getResourceBody
           >>= saveSnapshot "raw"
-          >>= compileAgdaWith opts
-          >>= withItemBody (return . withUrls fixStdlibLink)
-          >>= withItemBody (return . withUrls fixLocalLink)
+          >>= maybeCompileAgda maybeOpts
           >>= readMarkdownWith siteReaderOptions
           >>= processCites csl bib
           <&> writeHTML5With siteWriterOptions
@@ -250,12 +244,12 @@ main = do
     -- Compile sections using literate Agda
     match "src/**.lagda.md" $ do
       route permalinkRoute
-      compile $ pageWithAgdaCompiler agdaOptions
+      compile $ pageCompiler (Just agdaOptions)
 
     -- Compile other sections and pages
     match ("README.md" .||. "src/**.md") $ do
       route permalinkRoute
-      compile pageCompiler
+      compile (pageCompiler Nothing)
 
     -- Compile course pages
     match "courses/**.lagda.md" $ do
@@ -265,11 +259,11 @@ main = do
         let courseOptions = agdaOptions
               { optIncludePaths = courseDir : optIncludePaths agdaOptions
               }
-        pageWithAgdaCompiler courseOptions
+        pageCompiler (Just courseOptions)
 
     match "courses/**.md" $ do
       route permalinkRoute
-      compile pageCompiler
+      compile $ pageCompiler Nothing
 
     match "courses/**.pdf" $ do
       route idRoute
@@ -324,6 +318,8 @@ main = do
         compile copyFileCompiler
 
 
+    -- Raw versions used from Makefile for PDF and EPUB construction
+
     -- Compile raw version of acknowledgements used in constructing the PDF
     match "src/plfa/backmatter/acknowledgements.md" $ version "raw" $ do
       route $ gsubRoute "src/" (const "raw/")
@@ -475,10 +471,3 @@ addShiftedBody key = addDerivedField ("shifted_" <> key) deriveShiftedBody
     shiftHeadersBy body = T.unpack (T.replaceAll re "#$1" (T.pack body))
       where
         re = RE.regex [RE.Multiline] "^(#+)"
-
--- |Add the original metadata block back to the file.
-restoreMetadata :: Item String -> Compiler (Item String)
-restoreMetadata item = do
-  metadata <- getMetadata (itemIdentifier item)
-  let yaml = "---\n" <> BS.unpack (Y.encode metadata) <> "---\n\n"
-  withItemBody (\body -> return (yaml <> body)) item