uniworx.de/src/Main.hs

135 lines
4.6 KiB
Haskell

module Main (main) where
import Prelude
import Hakyll
import Data.List qualified as List
import Data.Maybe
import System.FilePath
import System.FilePath.Glob qualified as Glob
import Data.Yaml qualified as Yaml
import Data.Map (Map)
import Data.Map qualified as Map
import Control.Monad
import Control.Monad.Trans.Maybe
import Control.Applicative
config :: Configuration
config =
defaultConfiguration
{ destinationDirectory = "public"
}
routeAsFilePath :: (FilePath -> FilePath) -> Routes
routeAsFilePath f = customRoute $ f . toFilePath
stripPathPrefix :: FilePath -> (FilePath -> FilePath)
stripPathPrefix (splitDirectories -> prefix) =
joinPath . (\x -> fromMaybe x $ List.stripPrefix prefix x) . splitDirectories
main :: IO ()
main = hakyllWith config $ do
frontendManifest <-
preprocess $
Yaml.decodeFileThrow @_ @(Map String [FilePath]) "frontend/dist/.manifest.yaml"
let
frontendContext = jsContext <> cssContext
where
cssContext = listField "css" innerContext genCSSItems
where
innerContext = urlField "url"
genCSSItems = genManifestItems $ Glob.compile "**/*.css"
jsContext = listField "js" innerContext genCSSItems
where
innerContext = urlField "url"
genCSSItems = genManifestItems $ Glob.compile "**/*.js"
genManifestItems :: Glob.Pattern -> Compiler [Item CopyFile]
genManifestItems p = do
let entryPoint = "main"
resources = filter (Glob.match p) $ frontendManifest Map.! entryPoint
forM resources $ load . fromFilePath . ("frontend/dist" </>) . dropDrive
tags <- buildTags "content/**" $ fromCapture "tags/*.html"
match "content/**" $ do
compile $ do
pandocCompiler
>>= relativizeUrls
forM_ (tagsMap tags) $ \(tag, fromList -> posts) ->
rulesExtraDependencies [tagsDependency tags] $ do
tagItems <- getMatches . fromGlob $ toFilePath (tagsMakeId tags tag) -<.> "*"
let tagItem = pandocCompiler <|> makeItem mempty
rule
| [] <- tagItems = create [tagsMakeId tags tag]
| otherwise = match (fromList tagItems)
rule $ do
route . routeAsFilePath $ (-<.> "html") . stripPathPrefix "tags"
compile $ do
let
ctx =
mconcat
[ listField "tags-nav" defaultContext (metadataSort <=< mapM (uncurry renderTagNav) $ tagsMap tags)
, listField "posts" postContext (metadataSort =<< loadAll posts)
, frontendContext
, defaultContext
]
renderTagNav tag' ids = do
tagItems' <- getMatches . fromGlob $ toFilePath (tagsMakeId tags tag') -<.> "*"
let
tagItem' = return $ Item (fromMaybe (tagsMakeId tags tag') $ listToMaybe tagItems') (mempty :: String)
navRoute
| tag' == "index" = "/"
| otherwise = "/" <> tag' <> ".html"
tagNavCtx =
mconcat
[ constField "tag" tag'
, field "title" . const $
fmap (fromMaybe tag') . runMaybeT . asum $
map (\itemId -> MaybeT $ getMetadataField itemId "title") tagItems'
, constField "route" navRoute
, listField "posts" (constField "tag" tag' <> constField "route" navRoute <> postContext) (metadataSort =<< mapM load ids)
]
tagItem'
>>= loadAndApplyTemplate "templates/tag-nav.html" tagNavCtx
>>= relativizeUrls
postContext =
mconcat
[ field "identifier" (return . takeBaseName . toFilePath . itemIdentifier)
, defaultContext
]
metadataSort :: [Item w] -> Compiler [Item w]
metadataSort = sortOnM $ \Item{itemIdentifier} -> maybe (0 :: Integer) read <$> getMetadataField itemIdentifier "sort"
where
sortOnM :: forall m a b. (Monad m, Ord b) => (a -> m b) -> [a] -> m [a]
sortOnM f = fmap (map snd . List.sortOn fst) . mapM (\x -> (,x) <$> f x)
tagItem
>>= loadAndApplyTemplate "templates/tag.html" ctx
>>= loadAndApplyTemplate "templates/site-layout.html" ctx
>>= relativizeUrls
match "frontend/dist/wp-*/**" $ do
route . routeAsFilePath $ stripPathPrefix "frontend/dist"
compile copyFileCompiler
match "templates/*" $ compile templateBodyCompiler
match "static/**" $ do
route . routeAsFilePath $ stripPathPrefix "static"
compile copyFileCompiler