diff --git a/Makefile b/Makefile index 207c94de..3bc47ab9 100644 --- a/Makefile +++ b/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 diff --git a/hs/Hakyll/Web/Template/Context/Metadata.hs b/hs/Hakyll/Web/Template/Context/Metadata.hs index 6ec408d6..ecad60a4 100644 --- a/hs/Hakyll/Web/Template/Context/Metadata.hs +++ b/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 diff --git a/hs/Main.hs b/hs/Main.hs index 524e1950..331de63c 100644 --- a/hs/Main.hs +++ b/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