From 2e05a304b1ab4e4d00159664041b057588e133e9 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 15 May 2023 15:47:45 +0200 Subject: [PATCH] support special pages that are not concatenations of posts Fixes #4 --- package.yaml | 1 + special/imprint.md | 62 +++++++++++++++++++++++ src/Main.hs | 100 +++++++++++++++++++++++-------------- templates/site-layout.html | 22 +++++++- templates/tag.html | 7 --- 5 files changed, 146 insertions(+), 46 deletions(-) create mode 100644 special/imprint.md diff --git a/package.yaml b/package.yaml index fea9dff..ee99f68 100644 --- a/package.yaml +++ b/package.yaml @@ -36,3 +36,4 @@ executables: - mtl - megaparsec - text + - network-uri diff --git a/special/imprint.md b/special/imprint.md new file mode 100644 index 0000000..e69b19f --- /dev/null +++ b/special/imprint.md @@ -0,0 +1,62 @@ +--- +title: Impressum +--- +# Recessu sumus se aliquem foliis saetigeri vult + +## Navit quod auras + +Lorem markdownum ut *flamina* et mensura fracta, unius rubra. Manibus per rex +pondere, lucoque dotaliaque non festa cera, et. Mercurio dabantur cernens. +Vixque stabat Aeetias Zetesque scrutantur nisi, *tu quam* nec, in sit oculos. +Ille suo ad fecit rector auras hiemsque Thebas illi nunc constitit crinem +Dictaeaque utiliter eras duorum. + +1. Commenta periuria quaeque fuit +2. Quicquid aut essent ora fuit Hiberi oblitus +3. Per est atque ambitione increpor violentam +4. Semineces sedit +5. Iam usus levavit satis nocens + +## Latique volvuntur gnatae + +Inpediunt in remisit miserabile patrem cervix sonantibus +[talia](http://nec.org/) nec *deieci capitis* retraxi mediocris in deos, *sub*. +Addere spelunca, Achilleos: est orbe comminus tangere, nec deus ventos sumptae. +Prius de fuit, dum manibus rubor mitis Denique et inpedientibus sole. +Adpellatque dubio Ericthonium tanto terras, tendebat vulgus divitibusque suarum. +Corpus huic portans Oceanum multiplicique passa quodcumque tu omnes; Chimaera +non verba contentus tellus, tellus tibi. + +- Minos sonat datis celare illic balteus +- Hymettia Neptunus genitore stridentibus longa quoque limine +- Vidit viro vices +- Non insula liquida herbis turba fumabant presso +- Ter laqueosque vices aliter ait femina concipit + +Elice studioque in Eurytidos molimine passu vulgi passim partique ait inprudens +pontum. Titan est en quamvis manibus incubuit iuvenale erat lapis thalamosque +nymphas gaudetque educta ignibus, Troiaeque ait verba quod timor. Digitique +pennas Trachasque errabat cava, sed limina oculos est, carne, et huius triplex +esse; ipse. **Interea sibi** terras; pellant mittit exclamant, lumina prosilit, +matura. + +## Omnibus deos nec lacrimas nec est + +Moriri **temporis** galeae super vestigia nec istis arida: revocantis viroque +excidit et cornua tabellae ferrea. Est dona placent novissimus qui canisve +cumque tu quaerit avari virgis metuitque hominum de duabus undas Hyantius. +Recessit succede forsitan nubere mihi exsistunt iugulo germanam lanas. + +- Quater nisi tumidi +- Ument illam vir Talibus placet vulnera longius +- Nubila ignarus + +In est quid aequora iam clipei, ab gutture Arachnes nymphae inpete, per tamen +saevit. Ego sed animo potiatur, esset, quam sed vinces fuga. **Te** saevus, +parva adhuc gravitas nebulas. Triplici et Niseia domitamque: iussus miles. + +Non nunc! Volventia excussit da quae, mihi accipit sidera flexere aurora +Polydegmona ascensu. Rerum vultus, referebat exiluit urnam, inmiti gener, +laborem, quod date natura quodcumque. Calidi fortunaeque faces, quod ipsa +cultusque illi. Has barba viscera, hospes vera communia munus tremit inque +praemia terrae. diff --git a/src/Main.hs b/src/Main.hs index 0c2c163..5675cb4 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -37,6 +37,8 @@ import System.IO.Error import Data.Void +import Network.URI + config :: Configuration config = defaultConfiguration @@ -53,6 +55,15 @@ stripPathPrefix (splitDirectories -> prefix) = handleIf :: Exception e => (e -> Bool) -> (e -> IO a) -> IO a -> IO a handleIf predicate handler = handle $ \exc -> bool throwIO handler (predicate exc) exc +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) + +unwrapped :: Snapshot +unwrapped = "unwrapped" + main :: IO () main = hakyllWith config $ do frontendManifest <- @@ -142,15 +153,62 @@ main = hakyllWith config $ do | "/" `List.isPrefixOf` x && not ("//" `List.isPrefixOf` x) -> toSiteRoot r ++ x _other -> x - return $ withUrls (relativizeUrls' . renderRoute) <$> item + overPath f str = case parseURIReference str of + Nothing -> f str + Just uri@URI{uriPath} -> uriToString id uri{uriPath = f uriPath} mempty + return $ withUrls (relativizeUrls' . overPath renderRoute) <$> item tags <- buildTags "content/**" $ fromCapture "tags/*.html" + let + applySiteLayout = loadAndApplyTemplate "templates/site-layout.html" . (<> ctx') + where + ctx' = + mconcat + [ listField "tags-nav" defaultContext (metadataSort <=< mapM (uncurry renderTagNav) $ tagsMap tags) + , listField "special-nav" defaultContext $ metadataSort =<< mapM (flip loadSnapshot unwrapped) =<< getMatches (fromGlob "special/**") + , 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' <> ".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 + >>= normalizeUrls + postContext = + mconcat + [ field "identifier" (return . takeBaseName . toFilePath . itemIdentifier) + , defaultContext + ] + specialContext = defaultContext + match "content/**" $ do - compile $ do + compile $ pandocCompiler >>= normalizeUrls + match "special/**" $ do + route . routeAsFilePath $ (-<.> "html") . stripPathPrefix "special" + compile $ + pandocCompiler + >>= saveSnapshot unwrapped + >>= applySiteLayout specialContext + >>= normalizeUrls + forM_ (tagsMap tags) $ \(tag, fromList -> posts) -> rulesExtraDependencies [tagsDependency tags] $ do tagItems <- getMatches . fromGlob $ toFilePath (tagsMakeId tags tag) -<.> "*" @@ -165,47 +223,13 @@ main = hakyllWith config $ do let ctx = mconcat - [ listField "tags-nav" defaultContext (metadataSort <=< mapM (uncurry renderTagNav) $ tagsMap tags) - , listField "posts" postContext (metadataSort =<< loadAll posts) - , frontendContext + [ listField "posts" postContext (metadataSort =<< loadAll posts) , 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 = renderRoute $ "/" <> 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 - >>= normalizeUrls - - 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 + >>= applySiteLayout ctx >>= normalizeUrls match "frontend/dist/wp-*/**" $ do diff --git a/templates/site-layout.html b/templates/site-layout.html index 04b7e9e..37e8148 100644 --- a/templates/site-layout.html +++ b/templates/site-layout.html @@ -7,13 +7,33 @@ $for(css)$ $endfor$ - UniWorX Systems + UniWorX Systems$if(title)$ - $title$$endif$ +
+ +
$body$
+ $for(js)$ $endfor$ diff --git a/templates/tag.html b/templates/tag.html index ec02623..d0c2ca4 100644 --- a/templates/tag.html +++ b/templates/tag.html @@ -1,10 +1,3 @@ - $for(posts)$
$body$