aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMirek Kratochvil <exa.exa@gmail.com>2023-06-06 17:44:27 +0200
committerMirek Kratochvil <exa.exa@gmail.com>2023-06-07 00:01:14 +0200
commita1a3f0640b78917bdf63e0f20b7a37de8b5dcb68 (patch)
tree6a49fe4a976ea3930824dbfb8065bf584f880c13
parent5f0b66e3635472e10f0c596c45ba1f3544355cb9 (diff)
downloadreploy-a1a3f0640b78917bdf63e0f20b7a37de8b5dcb68.tar.gz
reploy-a1a3f0640b78917bdf63e0f20b7a37de8b5dcb68.tar.bz2
remove the old executable
-rw-r--r--oldsite.hs108
1 files changed, 0 insertions, 108 deletions
diff --git a/oldsite.hs b/oldsite.hs
deleted file mode 100644
index d587e03..0000000
--- a/oldsite.hs
+++ /dev/null
@@ -1,108 +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