remove the old executable
This commit is contained in:
parent
5f0b66e363
commit
a1a3f0640b
108
oldsite.hs
108
oldsite.hs
|
@ -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
|
|
Loading…
Reference in a new issue