Minor refactoring.
This commit is contained in:
parent
a5e1f77d22
commit
78108f5750
3 changed files with 82 additions and 63 deletions
18
Makefile
18
Makefile
|
@ -120,26 +120,28 @@ list:
|
||||||
|
|
||||||
.PHONY: publish
|
.PHONY: publish
|
||||||
publish: setup-check-rsync
|
publish: setup-check-rsync
|
||||||
make all
|
@make all
|
||||||
make test
|
@echo "Cleaning intermediate files"
|
||||||
@echo "Creating web branch..."
|
rm -rf $(RAW_DIR)
|
||||||
|
@make test
|
||||||
|
@echo "Creating web branch"
|
||||||
git fetch --all
|
git fetch --all
|
||||||
git checkout -b web --track origin/web
|
git checkout -b web --track origin/web
|
||||||
rsync -a \
|
rsync -a \
|
||||||
--filter='P _site/' \
|
--filter='P $(SITE_DIR)/' \
|
||||||
--filter='P _cache/' \
|
--filter='P $(CACHE_DIR)' \
|
||||||
--filter='P .git/' \
|
--filter='P .git/' \
|
||||||
--filter='P .gitignore' \
|
--filter='P .gitignore' \
|
||||||
--filter='P .stack-work' \
|
--filter='P .stack-work' \
|
||||||
--filter='P .nojekyll' \
|
--filter='P .nojekyll' \
|
||||||
--filter='P CNAME' \
|
--filter='P CNAME' \
|
||||||
--delete-excluded \
|
--delete-excluded \
|
||||||
_site/ .
|
$(SITE_DIR) .
|
||||||
git add -A
|
git add -A
|
||||||
@echo "Publishing web branch..."
|
@echo "Publishing web branch"
|
||||||
git commit -m "Publish."
|
git commit -m "Publish."
|
||||||
git push origin web:web
|
git push origin web:web
|
||||||
@echo "Deleting web branch..."
|
@echo "Deleting web branch"
|
||||||
git checkout dev
|
git checkout dev
|
||||||
git branch -D web
|
git branch -D web
|
||||||
|
|
||||||
|
|
|
@ -1,25 +1,47 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Hakyll.Web.Template.Context.Metadata where
|
module Hakyll.Web.Template.Context.Metadata
|
||||||
|
( includeContext
|
||||||
|
, metadataContext
|
||||||
|
, objectContext
|
||||||
|
, restoreMetadata
|
||||||
|
) where
|
||||||
|
|
||||||
import Control.Monad ((<=<))
|
import Control.Monad ((<=<))
|
||||||
import Data.Aeson (Object, Value(..))
|
import Data.Aeson (Object, Value(..))
|
||||||
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import qualified Data.HashMap.Strict as H
|
import qualified Data.HashMap.Strict as H
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
import Hakyll
|
import Hakyll
|
||||||
import Text.Printf (printf)
|
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
|
includeContext ctx = Context $ \k a i -> do
|
||||||
let o = itemBody i
|
let o = itemBody i
|
||||||
v <- lookupObject "include" o
|
v <- lookupObject "include" o
|
||||||
identifier <- fromFilePath <$> toString v
|
identifier <- fromFilePath <$> toString v
|
||||||
unContext (ctx <> metadataContext ctx) k a =<< load identifier
|
unContext (ctx <> metadataContext ctx) k a =<< load identifier
|
||||||
|
|
||||||
-- |Create a Context based on a JSON Object.
|
-- |Create a |Context| from a JSON |Object|.
|
||||||
objectContext :: Context String -> Context Object
|
objectContext
|
||||||
|
:: Context String -- ^ |Context| used when unfolding a JSON |Array| into a |ListField|.
|
||||||
|
-> Context Object
|
||||||
objectContext ctx = Context $ \k _ i -> do
|
objectContext ctx = Context $ \k _ i -> do
|
||||||
let o = itemBody i
|
let o = itemBody i
|
||||||
decodeValue ctx =<< lookupObject k o
|
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 (Bool b) = return . StringField $ show b
|
||||||
decodeValue _ctx v = fail $ printf "Unsupported value '%s'" (show v)
|
decodeValue _ctx v = fail $ printf "Unsupported value '%s'" (show v)
|
||||||
|
|
||||||
-- |Create a Context based on the Metadata.
|
-- |Lookup the |Value| stored in an |Object| at the given key.
|
||||||
metadataContext :: Context String -> Context String
|
lookupObject :: MonadFail m => String -> Object -> m Value
|
||||||
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
|
|
||||||
lookupObject k o = maybe ifNotFound ifFound (H.lookup (T.pack k) o)
|
lookupObject k o = maybe ifNotFound ifFound (H.lookup (T.pack k) o)
|
||||||
where
|
where
|
||||||
ifFound = return
|
ifFound = return
|
||||||
ifNotFound = fail $ printf "Key '%s' undefined in context '%s'" k (show o)
|
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 :: MonadFail m => Value -> m Object
|
||||||
toObject (Object o) = return o
|
toObject (Object o) = return o
|
||||||
toObject v = fail $ printf "Not an object '%s'" (show v)
|
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 :: MonadFail m => Value -> m String
|
||||||
toString (String s) = return (T.unpack s)
|
toString (String s) = return (T.unpack s)
|
||||||
toString v = fail $ printf "Not a string '%s'" (show v)
|
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
|
||||||
|
|
55
hs/Main.hs
55
hs/Main.hs
|
@ -1,14 +1,12 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
import Control.Monad ((<=<), forM_)
|
import Control.Monad ((<=<), (>=>), forM_)
|
||||||
import qualified Data.ByteString.Char8 as BS
|
|
||||||
import Data.Char (toLower)
|
import Data.Char (toLower)
|
||||||
import Data.Functor ((<&>))
|
import Data.Functor ((<&>))
|
||||||
import Data.List (isPrefixOf, stripPrefix)
|
import Data.List (isPrefixOf, stripPrefix)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.ICU as RE
|
import qualified Data.Text.ICU as RE
|
||||||
import qualified Data.Text.ICU.Replace as T
|
import qualified Data.Text.ICU.Replace as T
|
||||||
import qualified Data.Yaml as Y
|
|
||||||
import Hakyll
|
import Hakyll
|
||||||
import Hakyll.Web.Agda
|
import Hakyll.Web.Agda
|
||||||
import Hakyll.Web.Routes.Permalink
|
import Hakyll.Web.Routes.Permalink
|
||||||
|
@ -149,30 +147,26 @@ main = do
|
||||||
-- Build function to fix local URLs
|
-- Build function to fix local URLs
|
||||||
fixLocalLink <- mkFixLocalLink "src"
|
fixLocalLink <- mkFixLocalLink "src"
|
||||||
|
|
||||||
-- Build compiler for Markdown pages
|
let maybeCompileAgda
|
||||||
let pageCompiler :: Compiler (Item String)
|
:: Maybe CommandLineOptions -- ^ If this argument is passed, Agda compilation is used.
|
||||||
pageCompiler = do
|
-> Item String
|
||||||
csl <- load cslFileName
|
-> Compiler (Item String)
|
||||||
bib <- load bibFileName
|
maybeCompileAgda Nothing = return
|
||||||
getResourceBody
|
maybeCompileAgda (Just opts) =
|
||||||
>>= saveSnapshot "raw"
|
compileAgdaWith opts >=>
|
||||||
>>= readMarkdownWith siteReaderOptions
|
withItemBody (return . withUrls fixStdlibLink) >=>
|
||||||
>>= processCites csl bib
|
withItemBody (return . withUrls fixLocalLink)
|
||||||
<&> writeHTML5With siteWriterOptions
|
|
||||||
>>= loadAndApplyTemplate "templates/page.html" siteSectionContext
|
|
||||||
>>= loadAndApplyTemplate "templates/default.html" siteSectionContext
|
|
||||||
>>= prettifyUrls
|
|
||||||
|
|
||||||
-- Build compiler for literate Agda pages
|
-- Build compiler for Markdown pages with optional Literate Agda
|
||||||
let pageWithAgdaCompiler :: CommandLineOptions -> Compiler (Item String)
|
let pageCompiler
|
||||||
pageWithAgdaCompiler opts = do
|
:: Maybe CommandLineOptions -- ^ If this argument is passed, Agda compilation is used.
|
||||||
|
-> Compiler (Item String)
|
||||||
|
pageCompiler maybeOpts = do
|
||||||
csl <- load cslFileName
|
csl <- load cslFileName
|
||||||
bib <- load bibFileName
|
bib <- load bibFileName
|
||||||
getResourceBody
|
getResourceBody
|
||||||
>>= saveSnapshot "raw"
|
>>= saveSnapshot "raw"
|
||||||
>>= compileAgdaWith opts
|
>>= maybeCompileAgda maybeOpts
|
||||||
>>= withItemBody (return . withUrls fixStdlibLink)
|
|
||||||
>>= withItemBody (return . withUrls fixLocalLink)
|
|
||||||
>>= readMarkdownWith siteReaderOptions
|
>>= readMarkdownWith siteReaderOptions
|
||||||
>>= processCites csl bib
|
>>= processCites csl bib
|
||||||
<&> writeHTML5With siteWriterOptions
|
<&> writeHTML5With siteWriterOptions
|
||||||
|
@ -250,12 +244,12 @@ main = do
|
||||||
-- Compile sections using literate Agda
|
-- Compile sections using literate Agda
|
||||||
match "src/**.lagda.md" $ do
|
match "src/**.lagda.md" $ do
|
||||||
route permalinkRoute
|
route permalinkRoute
|
||||||
compile $ pageWithAgdaCompiler agdaOptions
|
compile $ pageCompiler (Just agdaOptions)
|
||||||
|
|
||||||
-- Compile other sections and pages
|
-- Compile other sections and pages
|
||||||
match ("README.md" .||. "src/**.md") $ do
|
match ("README.md" .||. "src/**.md") $ do
|
||||||
route permalinkRoute
|
route permalinkRoute
|
||||||
compile pageCompiler
|
compile (pageCompiler Nothing)
|
||||||
|
|
||||||
-- Compile course pages
|
-- Compile course pages
|
||||||
match "courses/**.lagda.md" $ do
|
match "courses/**.lagda.md" $ do
|
||||||
|
@ -265,11 +259,11 @@ main = do
|
||||||
let courseOptions = agdaOptions
|
let courseOptions = agdaOptions
|
||||||
{ optIncludePaths = courseDir : optIncludePaths agdaOptions
|
{ optIncludePaths = courseDir : optIncludePaths agdaOptions
|
||||||
}
|
}
|
||||||
pageWithAgdaCompiler courseOptions
|
pageCompiler (Just courseOptions)
|
||||||
|
|
||||||
match "courses/**.md" $ do
|
match "courses/**.md" $ do
|
||||||
route permalinkRoute
|
route permalinkRoute
|
||||||
compile pageCompiler
|
compile $ pageCompiler Nothing
|
||||||
|
|
||||||
match "courses/**.pdf" $ do
|
match "courses/**.pdf" $ do
|
||||||
route idRoute
|
route idRoute
|
||||||
|
@ -324,6 +318,8 @@ main = do
|
||||||
compile copyFileCompiler
|
compile copyFileCompiler
|
||||||
|
|
||||||
|
|
||||||
|
-- Raw versions used from Makefile for PDF and EPUB construction
|
||||||
|
|
||||||
-- Compile raw version of acknowledgements used in constructing the PDF
|
-- Compile raw version of acknowledgements used in constructing the PDF
|
||||||
match "src/plfa/backmatter/acknowledgements.md" $ version "raw" $ do
|
match "src/plfa/backmatter/acknowledgements.md" $ version "raw" $ do
|
||||||
route $ gsubRoute "src/" (const "raw/")
|
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))
|
shiftHeadersBy body = T.unpack (T.replaceAll re "#$1" (T.pack body))
|
||||||
where
|
where
|
||||||
re = RE.regex [RE.Multiline] "^(#+)"
|
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