From 903a308167ac59b3736944f766f8672a9997e47e Mon Sep 17 00:00:00 2001 From: Mirek Kratochvil Date: Mon, 22 May 2023 23:23:16 +0200 Subject: well stuff --- external/mypage/text.md | 4 +- oldsite.hs | 108 ++++++++++++++++++++++++++++++++++++++++++++++++ pagedeploy.cabal | 11 +++++ site.hs | 100 -------------------------------------------- 4 files changed, 122 insertions(+), 101 deletions(-) create mode 100644 oldsite.hs delete mode 100644 site.hs diff --git a/external/mypage/text.md b/external/mypage/text.md index 14b321c..4dc51cc 100644 --- a/external/mypage/text.md +++ b/external/mypage/text.md @@ -19,5 +19,7 @@ this that ## Something else +![awesome](img/awesome.png) + more nonsense -haha +haha [linek](/tags/) diff --git a/oldsite.hs b/oldsite.hs new file mode 100644 index 0000000..d587e03 --- /dev/null +++ b/oldsite.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Hakyll + +import Control.Monad ((>=>), when) +import Data.Foldable (traverse_) +import Data.List (inits, nub) +import Data.List.Extra (groupSort) +import Data.Maybe (fromMaybe) +import System.FilePath + ( () + , dropTrailingPathSeparator + , joinPath + , normalise + , splitDirectories + ) + +import Debug.Trace + +getMount' :: a -> (String -> a) -> Metadata -> a +getMount' a b = maybe a b . lookupString "mount" + +getMount :: Metadata -> Routes +getMount = getMount' idRoute constRoute + +indexInDir :: Routes -> Routes +indexInDir = flip composeRoutes . customRoute $ ( "index.html") . toFilePath + +makePage :: Rules () +makePage = do + route $ indexInDir (metadataRoute getMount) + compile $ + pandocCompiler >>= loadAndApplyTemplate "templates/page.html" pageCtx >>= + loadAndApplyTemplate "templates/default.html" pageCtx >>= + relativizeUrls + +extractRedirs :: Identifier -> Rules (Identifier, [Identifier]) +extractRedirs ident = do + md <- getMetadata ident + let to = getMount' ident fromFilePath md + froms = + fromMaybe [] $ + map (fromFilePath . dropTrailingPathSeparator . normalise) <$> + lookupStringList "redirects" md + pure (to, froms) + +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) + +extractHTagLinks :: Identifier -> Rules (Identifier, [[String]]) +extractHTagLinks ident = do + md <- getMetadata ident + let to = getMount' ident fromFilePath md + htags = maybe [] (map splitDirectories) $ lookupStringList "tags" md + when (null htags) . fail $ "Uncategorized: " ++ show ident + pure (to, htags) + +invTags :: [(Identifier, [[String]])] -> [([String], [String])] +invTags x = + map (fmap (map ('/' :) . nub . map toFilePath)) $ + groupSort [(t, p) | (p, htl) <- x, ht <- htl, t <- inits ht] + +makeTag :: [FilePath] -> [String] -> Rules () +makeTag htag pages = + create [fromFilePath $ joinPath ("tags" : htag)] $ do + route (indexInDir idRoute) + compile $ do + let ctx = + mconcat + [ constField "title" ("Pages tagged " ++ joinPath htag) + , listField + "htags" + (field "htag" (return . itemBody)) + (traverse makeItem htag) + , listField + "pages" + (field "page" (return . itemBody)) + (traverse makeItem pages) + , defaultContext + ] + makeItem "" >>= loadAndApplyTemplate "templates/tag.html" ctx >>= + loadAndApplyTemplate "templates/default.html" ctx >>= + relativizeUrls + +spawnTags = + traverse extractHTagLinks >=> pure . invTags >=> traverse_ (uncurry makeTag) + +main :: IO () +main = + hakyll $ + {- Source the pages -} + do + match "external/**/*.md" makePage + {- Source and process the redirects -} + getMatches "external/**/*.md" >>= spawnRedirects + {- Source and process the tags -} + getMatches "external/**/*.md" >>= spawnTags + {- Compile the templates (no routing, cache-only) -} + match "templates/*" $ compile templateBodyCompiler + +pageCtx :: Context String +pageCtx = defaultContext diff --git a/pagedeploy.cabal b/pagedeploy.cabal index 3417a34..e081cda 100644 --- a/pagedeploy.cabal +++ b/pagedeploy.cabal @@ -9,5 +9,16 @@ executable site , hakyll == 4.16.* , filepath , extra + , transformers + , containers + , pandoc + , pandoc-types + , microlens + , microlens-th + , microlens-mtl + , microlens-aeson + , data-default + , text + , yaml ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 diff --git a/site.hs b/site.hs deleted file mode 100644 index 174f229..0000000 --- a/site.hs +++ /dev/null @@ -1,100 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -import Hakyll - -import Control.Monad ((>=>), when) -import Data.Foldable (traverse_) -import Data.List (inits, nub) -import Data.List.Extra (groupSort) -import Data.Maybe (fromMaybe) -import System.FilePath - ( () - , dropTrailingPathSeparator - , joinPath - , normalise - , splitDirectories - ) - -import Debug.Trace - -getMount' :: a -> (String -> a) -> Metadata -> a -getMount' a b = maybe a b . lookupString "mount" - -getMount :: Metadata -> Routes -getMount = getMount' idRoute constRoute - -indexInDir :: Routes -> Routes -indexInDir = flip composeRoutes . customRoute $ ( "index.html") . toFilePath - -makePage :: Rules () -makePage = do - route $ indexInDir (metadataRoute getMount) - compile $ - pandocCompiler >>= loadAndApplyTemplate "templates/page.html" pageCtx >>= - loadAndApplyTemplate "templates/default.html" pageCtx >>= - relativizeUrls - -extractRedirs :: Identifier -> Rules (Identifier, [Identifier]) -extractRedirs ident = do - md <- getMetadata ident - let to = getMount' ident fromFilePath md - froms = - fromMaybe [] $ - map (fromFilePath . dropTrailingPathSeparator . normalise) <$> - lookupStringList "redirects" md - pure (to, froms) - -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) - -extractHTagLinks :: Identifier -> Rules (Identifier, [[String]]) -extractHTagLinks ident = do - md <- getMetadata ident - let to = getMount' ident fromFilePath md - htags = maybe [] (map splitDirectories) $ lookupStringList "tags" md - when (null htags) . fail $ "Uncategorized: " ++ show ident - pure (to, htags) - -invTags :: [(Identifier, [[String]])] -> [([String], [String])] -invTags x = map (fmap (map ('/':) . nub . map toFilePath)) $ groupSort [(t, p) | (p, htl) <- x, ht <- htl, t <- inits ht] - -makeTag :: [FilePath] -> [String] -> Rules () -makeTag htag pages = - create [fromFilePath $ joinPath ("tags" : htag)] $ do - route (indexInDir idRoute) - compile $ do - let ctx = - mconcat - [ constField "title" ("Pages tagged " ++ joinPath htag) - , listField "htags" (field "htag" (return . itemBody)) (traverse makeItem htag) - , listField "pages" (field "page" (return . itemBody)) (traverse makeItem pages) - , defaultContext - ] - makeItem "" >>= loadAndApplyTemplate "templates/tag.html" ctx >>= - loadAndApplyTemplate "templates/default.html" ctx >>= - relativizeUrls - -spawnTags = - traverse extractHTagLinks >=> pure . invTags >=> traverse_ (uncurry makeTag) - -main :: IO () -main = - hakyll $ - {- Source the pages -} - do - match "external/**/*.md" makePage - {- Source and process the redirects -} - getMatches "external/**/*.md" >>= spawnRedirects - {- Source and process the tags -} - getMatches "external/**/*.md" >>= spawnTags - {- Compile the templates (no routing, cache-only) -} - match "templates/*" $ compile templateBodyCompiler - -pageCtx :: Context String -pageCtx = defaultContext -- cgit v1.2.3