58 lines
1.7 KiB
Haskell
58 lines
1.7 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
import Hakyll
|
|
|
|
import Control.Monad ((>=>))
|
|
import Data.Foldable (traverse_)
|
|
import Data.Maybe (fromMaybe)
|
|
import System.FilePath ((</>), dropTrailingPathSeparator, normalise)
|
|
|
|
import Debug.Trace
|
|
|
|
getMount :: Metadata -> Routes
|
|
getMount = maybe idRoute constRoute . lookupString "mount"
|
|
|
|
indexInDir :: Routes -> Routes
|
|
indexInDir = flip composeRoutes . customRoute $ (</> "index.html") . toFilePath
|
|
|
|
extractRedirs :: Identifier -> Rules (Identifier, [Identifier])
|
|
extractRedirs ident = do
|
|
md <- getMetadata ident
|
|
let to = fromMaybe ident $ fromFilePath <$> lookupString "mount" md
|
|
froms =
|
|
fromMaybe [] $
|
|
map (fromFilePath . dropTrailingPathSeparator . normalise) <$>
|
|
lookupStringList "redirects" md
|
|
pure (to, froms)
|
|
|
|
makePage :: Rules ()
|
|
makePage = do
|
|
route $ indexInDir (metadataRoute getMount)
|
|
compile $
|
|
pandocCompiler >>= loadAndApplyTemplate "templates/page.html" pageCtx >>=
|
|
loadAndApplyTemplate "templates/default.html" pageCtx >>=
|
|
relativizeUrls
|
|
|
|
makeRedirects :: Identifier -> [Identifier] -> Rules ()
|
|
makeRedirects to froms =
|
|
create froms $ do
|
|
route $ indexInDir idRoute
|
|
compile . makeItem . Redirect . ('/' :) . toFilePath $ to
|
|
|
|
spawnRedirects :: [Identifier] -> Rules ()
|
|
spawnRedirects = traverse_ (extractRedirs >=> uncurry makeRedirects)
|
|
|
|
main :: IO ()
|
|
main =
|
|
hakyll $
|
|
{- Source the pages -}
|
|
do
|
|
match "external/**/*.md" makePage
|
|
{- Source and process the redirects -}
|
|
getMatches "external/**/*.md" >>= spawnRedirects
|
|
{- Compile the templates (no routing, cache-only) -}
|
|
match "templates/*" $ compile templateBodyCompiler
|
|
|
|
pageCtx :: Context String
|
|
pageCtx = defaultContext
|