425 lines
15 KiB
Haskell
425 lines
15 KiB
Haskell
--------------------------------------------------------------------------------
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
import Control.Monad (filterM)
|
|
import Data.Maybe (fromMaybe)
|
|
import Data.Monoid (mappend)
|
|
import Data.Time
|
|
import Data.Time.Format (parseTimeM, defaultTimeLocale, formatTime)
|
|
import Hakyll
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
main :: IO ()
|
|
main = hakyll $ do
|
|
match "images/**" $ do
|
|
route idRoute
|
|
compile copyFileCompiler
|
|
|
|
match "lib/**" $ do
|
|
route idRoute
|
|
compile copyFileCompiler
|
|
|
|
match "css/*" $ do
|
|
route idRoute
|
|
compile compressCssCompiler
|
|
|
|
match (fromList ["about.rst", "contact.markdown"]) $ do
|
|
route $ setExtension "html"
|
|
compile $ pandocCompiler
|
|
>>= loadAndApplyTemplate "templates/default.html" staticPageContext
|
|
>>= relativizeUrls
|
|
|
|
match "posts/*" $ do
|
|
route $ setExtension "html"
|
|
compile $ do
|
|
identifier <- getUnderlying
|
|
metadata <- getMetadata identifier
|
|
let language = lookupString "language" metadata
|
|
|
|
pandocCompiler
|
|
>>= loadAndApplyTemplate "templates/post.html" (postCtx language)
|
|
>>= loadAndApplyTemplate "templates/default.html" (postCtx language)
|
|
>>= relativizeUrls
|
|
|
|
match "events/*" $ do
|
|
route $ setExtension "html"
|
|
compile $ do
|
|
identifier <- getUnderlying
|
|
metadata <- getMetadata identifier
|
|
let language = lookupString "language" metadata
|
|
|
|
pandocCompiler
|
|
>>= loadAndApplyTemplate "templates/event.html" (postCtx language)
|
|
>>= loadAndApplyTemplate "templates/default.html" (postCtx language)
|
|
>>= relativizeUrls
|
|
|
|
match "pages/en/japan/language/**" $ do
|
|
route $ setExtension "html"
|
|
compile $ do
|
|
identifier <- getUnderlying
|
|
metadata <- getMetadata identifier
|
|
let language = lookupString "language" metadata
|
|
|
|
pandocCompiler
|
|
>>= loadAndApplyTemplate "templates/japan-language-note.html" (postCtx language)
|
|
>>= loadAndApplyTemplate "templates/default.html" (postCtx language)
|
|
>>= relativizeUrls
|
|
|
|
match "pages/*/plamo/**" $ do
|
|
route $ setExtension "html"
|
|
compile $ do
|
|
identifier <- getUnderlying
|
|
metadata <- getMetadata identifier
|
|
let language = lookupString "language" metadata
|
|
|
|
let dateValue = lookupString "date" metadata
|
|
purchaseDateValue = lookupString "purchase_date" metadata
|
|
formattedPurchaseDate = maybe "" formatDate purchaseDateValue
|
|
modelKitTemplate =
|
|
if dateValue == Just "1990-01-01"
|
|
then "templates/model-kit-not-ready.html"
|
|
else "templates/model-kit.html"
|
|
|
|
extendedCtx = constField "formatted_purchase_date" formattedPurchaseDate <> (postCtx language)
|
|
|
|
pandocCompiler
|
|
>>= loadAndApplyTemplate modelKitTemplate extendedCtx
|
|
>>= loadAndApplyTemplate "templates/default.html" extendedCtx
|
|
>>= relativizeUrls
|
|
|
|
match "pages/*/radio/fielddays/*" $ do
|
|
route $ setExtension "html"
|
|
compile $ do
|
|
identifier <- getUnderlying
|
|
metadata <- getMetadata identifier
|
|
let language = lookupString "language" metadata
|
|
|
|
pandocCompiler
|
|
>>= loadAndApplyTemplate "templates/radio.html" (postCtx language)
|
|
>>= loadAndApplyTemplate "templates/default.html" (postCtx language)
|
|
>>= relativizeUrls
|
|
|
|
match "pages/*/software/**" $ do
|
|
route $ setExtension "html"
|
|
compile $ do
|
|
identifier <- getUnderlying
|
|
metadata <- getMetadata identifier
|
|
let language = lookupString "language" metadata
|
|
|
|
pandocCompiler
|
|
-- >>= loadAndApplyTemplate "templates/software-post.html" (postCtx language)
|
|
>>= loadAndApplyTemplate "templates/default.html" (postCtx language)
|
|
>>= relativizeUrls
|
|
|
|
create ["archive.html"] $ do
|
|
route idRoute
|
|
compile $ do
|
|
identifier <- getUnderlying
|
|
metadata <- getMetadata identifier
|
|
let language = lookupString "language" metadata
|
|
let lang = fromMaybe "en" language
|
|
|
|
posts <- recentFirst =<< loadAll "posts/*"
|
|
let archiveCtx =
|
|
listField "posts" (postCtx language) (return posts) <>
|
|
constField "title" "Archives" <>
|
|
constField "language" lang <>
|
|
langDict lang <>
|
|
defaultContext
|
|
|
|
makeItem ""
|
|
>>= loadAndApplyTemplate "templates/archive.html" archiveCtx
|
|
>>= loadAndApplyTemplate "templates/default.html" archiveCtx
|
|
>>= relativizeUrls
|
|
|
|
match (fromList
|
|
[ "nl/plamo.html"
|
|
, "jp/plamo.html"
|
|
, "en/plamo.html"
|
|
]) $ do
|
|
route idRoute
|
|
compile $ do
|
|
-- ident <- getUnderlying
|
|
-- language <- getMetadataField' ident "language"
|
|
|
|
identifier <- getUnderlying
|
|
metadata <- getMetadata identifier
|
|
let language = lookupString "language" metadata
|
|
let lang = fromMaybe "en" language
|
|
|
|
let urla = "pages/" ++ lang ++ "/plamo/**"
|
|
kits <- recentFirst =<< loadAll (fromGlob (urla))
|
|
|
|
let plamoCtx =
|
|
listField "kits" kitCtx (return kits) <>
|
|
langDict lang <>
|
|
defaultContext
|
|
|
|
getResourceBody
|
|
>>= applyAsTemplate plamoCtx
|
|
>>= loadAndApplyTemplate "templates/default.html" plamoCtx
|
|
>>= relativizeUrls
|
|
|
|
match (fromList
|
|
[ "nl/japan.html"
|
|
, "jp/japan.html"
|
|
, "en/japan.html"
|
|
]) $ do
|
|
route idRoute
|
|
compile $ do
|
|
identifier <- getUnderlying
|
|
metadata <- getMetadata identifier
|
|
let language = lookupString "language" metadata
|
|
let lang = fromMaybe "en" language
|
|
|
|
notes <- loadAll "pages/en/japan/language/notes/*"
|
|
|
|
let japanCtx =
|
|
listField "notes" (postCtx language) (return notes) <>
|
|
langDict lang <>
|
|
defaultContext
|
|
|
|
getResourceBody
|
|
>>= applyAsTemplate japanCtx
|
|
>>= loadAndApplyTemplate "templates/default.html" japanCtx
|
|
>>= relativizeUrls
|
|
|
|
match (fromList
|
|
[ "nl/radio.html"
|
|
, "jp/radio.html"
|
|
, "en/radio.html"
|
|
]) $ do
|
|
route idRoute
|
|
compile $ do
|
|
identifier <- getUnderlying
|
|
metadata <- getMetadata identifier
|
|
let language = lookupString "language" metadata
|
|
let lang = fromMaybe "en" language
|
|
|
|
fielddays <- loadAll $ (fromGlob ("pages/" ++ lang ++ "/radio/fielddays/*"))
|
|
fielddays <- recentFirst fielddays
|
|
|
|
let radioCtx =
|
|
listField "fielddays" (postCtx language) (return fielddays) <>
|
|
langDict lang <>
|
|
defaultContext
|
|
|
|
getResourceBody
|
|
>>= applyAsTemplate radioCtx
|
|
>>= loadAndApplyTemplate "templates/default.html" radioCtx
|
|
>>= relativizeUrls
|
|
|
|
match (fromList
|
|
[ "nl/software.html"
|
|
, "jp/software.html"
|
|
, "en/software.html"
|
|
]) $ do
|
|
route idRoute
|
|
compile $ do
|
|
identifier <- getUnderlying
|
|
metadata <- getMetadata identifier
|
|
let language = lookupString "language" metadata
|
|
let lang = fromMaybe "en" language
|
|
|
|
projects <- loadAll $ (fromGlob ("pages/" ++ lang ++ "/software/projects/*"))
|
|
projects <- recentFirst projects
|
|
|
|
let softwareCtx =
|
|
listField "projects" (postCtx language) (return projects) <>
|
|
langDict lang <>
|
|
defaultContext
|
|
|
|
getResourceBody
|
|
>>= applyAsTemplate softwareCtx
|
|
>>= loadAndApplyTemplate "templates/default.html" softwareCtx
|
|
>>= relativizeUrls
|
|
|
|
match (fromList
|
|
[ "nl/code/blazor.html"
|
|
, "jp/code/blazor.html"
|
|
, "en/code/blazor.html"
|
|
]) $ do
|
|
route idRoute
|
|
compile $ do
|
|
identifier <- getUnderlying
|
|
metadata <- getMetadata identifier
|
|
let language = lookupString "language" metadata
|
|
let lang = fromMaybe "en" language
|
|
|
|
blazorPages <- loadAll "pages/en/software/code/blazor/*"
|
|
|
|
let softwareCtx =
|
|
listField "blazorPages" (postCtx language) (return blazorPages) <>
|
|
langDict lang <>
|
|
defaultContext
|
|
|
|
pandocCompiler
|
|
>>= loadAndApplyTemplate "templates/code.html" softwareCtx
|
|
>>= loadAndApplyTemplate "templates/default.html" softwareCtx
|
|
>>= relativizeUrls
|
|
|
|
match (fromList
|
|
[ "nl/code/elm.html"
|
|
, "jp/code/elm.html"
|
|
, "en/code/elm.html"
|
|
]) $ do
|
|
route idRoute
|
|
compile $ do
|
|
identifier <- getUnderlying
|
|
metadata <- getMetadata identifier
|
|
let language = lookupString "language" metadata
|
|
let lang = fromMaybe "en" language
|
|
|
|
elmPages <- loadAll "pages/en/software/code/elm/*"
|
|
|
|
let softwareCtx =
|
|
listField "elmPages" (postCtx language) (return elmPages) <>
|
|
langDict lang <>
|
|
defaultContext
|
|
|
|
pandocCompiler
|
|
>>= loadAndApplyTemplate "templates/code.html" softwareCtx
|
|
>>= loadAndApplyTemplate "templates/default.html" softwareCtx
|
|
>>= relativizeUrls
|
|
|
|
match (fromList
|
|
[ "nl/code/haskell.html"
|
|
, "jp/code/haskell.html"
|
|
, "en/code/haskell.html"
|
|
]) $ do
|
|
route idRoute
|
|
compile $ do
|
|
identifier <- getUnderlying
|
|
metadata <- getMetadata identifier
|
|
let language = lookupString "language" metadata
|
|
let lang = fromMaybe "en" language
|
|
|
|
haskellPages <- loadAll "pages/en/software/code/haskell/*"
|
|
|
|
let softwareCtx =
|
|
listField "haskellPages" (postCtx language) (return haskellPages) <>
|
|
langDict lang <>
|
|
defaultContext
|
|
|
|
pandocCompiler
|
|
>>= loadAndApplyTemplate "templates/code.html" softwareCtx
|
|
>>= loadAndApplyTemplate "templates/default.html" softwareCtx
|
|
>>= relativizeUrls
|
|
|
|
match (fromList
|
|
[ "index.html"
|
|
, "nl/index.html"
|
|
, "jp/index.html"
|
|
, "en/index.html"
|
|
]) $ do
|
|
route idRoute
|
|
compile $ do
|
|
posts <- recentFirst =<< loadAll "posts/*"
|
|
now <- unsafeCompiler getCurrentTime
|
|
ident <- getUnderlying
|
|
--language <- getMetadataField' ident "language"
|
|
|
|
identifier <- getUnderlying
|
|
metadata <- getMetadata identifier
|
|
let language = lookupString "language" metadata
|
|
let lang = fromMaybe "en" language
|
|
|
|
-- Seven days from today.
|
|
let cutoff = addUTCTime (7 * 24 * 60 * 60) now
|
|
|
|
events <-
|
|
loadAll "events/*"
|
|
>>= filterM (isUpcoming cutoff)
|
|
>>= chronological
|
|
|
|
let indexCtx =
|
|
-- (<> is the modern version of `mappend`.)
|
|
listField "posts" (postCtx language) (return posts) <>
|
|
listField "events" (postCtx language) (return events) <>
|
|
langDict lang <>
|
|
defaultContext
|
|
|
|
getResourceBody
|
|
>>= applyAsTemplate indexCtx
|
|
>>= loadAndApplyTemplate "templates/default.html" indexCtx
|
|
>>= relativizeUrls
|
|
|
|
match "templates/*" $ compile templateBodyCompiler
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
staticPageContext :: Context String
|
|
staticPageContext =
|
|
langDict "en" <>
|
|
defaultContext
|
|
|
|
formatDate :: String -> String
|
|
formatDate s =
|
|
case parseTimeM True defaultTimeLocale "%Y-%m-%d" s :: Maybe Day of
|
|
Just day -> formatTime defaultTimeLocale "%e %B %Y" day
|
|
Nothing -> s
|
|
|
|
postCtx :: Maybe String -> Context String
|
|
postCtx language =
|
|
let lang = fromMaybe "en" language
|
|
in
|
|
dateField "date" "%e %B %Y" <>
|
|
constField "language" lang <>
|
|
langDict lang <>
|
|
defaultContext
|
|
|
|
kitCtx :: Context String
|
|
kitCtx =
|
|
(field "formatted_purchase_date" $ \item -> do
|
|
metadata <- getMetadata (itemIdentifier item)
|
|
let purchaseDateValue = lookupString "purchase_date" metadata
|
|
return $ maybe "" formatDate purchaseDateValue
|
|
)
|
|
<> postCtx Nothing
|
|
|
|
isUpcoming :: UTCTime -> Item a -> Compiler Bool
|
|
isUpcoming cutoff item = do
|
|
metadata <- getMetadata (itemIdentifier item)
|
|
case lookupString "date" metadata of
|
|
Nothing -> return False
|
|
Just ds ->
|
|
case parseTimeM True defaultTimeLocale "%Y-%m-%d" ds of
|
|
Nothing -> return False
|
|
Just date -> return (date >= cutoff)
|
|
|
|
langDict :: String -> Context a
|
|
langDict "nl" =
|
|
constField "switcher" "Taal" <>
|
|
constField "title-japan" "Japan" <>
|
|
constField "title-plamo" "Plamo" <>
|
|
constField "title-radio" "Radio" <>
|
|
constField "title-software" "Software" <>
|
|
constField "text-plamo-not-ready" "Deze model-kit heeft nog geen gepubliceerd werk." <>
|
|
constField "text-plamo-back" "Terug naar plamo kits" <>
|
|
constField "text-radio-back" "Terug naar radio overzicht" <>
|
|
mempty
|
|
|
|
langDict "jp" =
|
|
constField "switcher" "言語" <>
|
|
constField "title-japan" "日本" <>
|
|
constField "title-plamo" "プラモ" <>
|
|
constField "title-radio" "ラジオ" <>
|
|
constField "title-software" "ソフトウェア" <>
|
|
constField "text-plamo-not-ready" "この模型キットには、まだ制作例が公開されていません。" <>
|
|
constField "text-plamo-back" "プラモデルキットに戻る" <>
|
|
constField "text-radio-back" "ラジオに戻る" <>
|
|
mempty
|
|
|
|
langDict "en" =
|
|
constField "switcher" "Language" <>
|
|
constField "title-japan" "Japan" <>
|
|
constField "title-plamo" "Plamo" <>
|
|
constField "title-radio" "Radio" <>
|
|
constField "title-software" "Software" <>
|
|
constField "text-plamo-not-ready" "This model kit has no work published for it yet." <>
|
|
constField "text-plamo-back" "Back to plamo kits" <>
|
|
constField "text-radio-back" "Back to radio overview" <>
|
|
mempty
|
|
|
|
langDict _ = mempty
|