Minor refactoring.
This commit is contained in:
parent
a5e1f77d22
commit
78108f5750
3 changed files with 82 additions and 63 deletions
32
Makefile
32
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 .git/' \
|
||||
--filter='P .gitignore' \
|
||||
--filter='P .stack-work' \
|
||||
--filter='P .nojekyll' \
|
||||
--filter='P CNAME' \
|
||||
--delete-excluded \
|
||||
_site/ .
|
||||
rsync -a \
|
||||
--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_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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
57
hs/Main.hs
57
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,34 +147,30 @@ 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
|
||||
>>= loadAndApplyTemplate "templates/page.html" siteSectionContext
|
||||
>>= loadAndApplyTemplate "templates/page.html" siteSectionContext
|
||||
>>= loadAndApplyTemplate "templates/default.html" siteSectionContext
|
||||
>>= prettifyUrls
|
||||
|
||||
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue