commit a6148fdb91c53c3d4ae217f3ce38361b04a775b9 Author: Mirek Kratochvil Date: Sat May 20 22:19:57 2023 +0200 site kinda works diff --git a/pagedeploy.cabal b/pagedeploy.cabal new file mode 100644 index 0000000..50b861f --- /dev/null +++ b/pagedeploy.cabal @@ -0,0 +1,12 @@ +name: pagedeploy +version: 0.1.0.0 +build-type: Simple +cabal-version: >= 1.10 + +executable site + main-is: site.hs + build-depends: base == 4.* + , hakyll == 4.16.* + , filepath + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 diff --git a/site.hs b/site.hs new file mode 100644 index 0000000..3d77430 --- /dev/null +++ b/site.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Hakyll + +import Control.Monad ((>=>)) +import Data.Foldable (traverse_) +import Data.Maybe (fromMaybe) +import System.FilePath ((), dropTrailingPathSeparator, normalise) + +import Debug.Trace + +getMount :: Metadata -> Routes +getMount = maybe idRoute constRoute . lookupString "mount" + +indexInDir :: Routes -> Routes +indexInDir = flip composeRoutes . customRoute $ ( "index.html") . toFilePath + +extractRedirs :: Identifier -> Rules (Identifier, [Identifier]) +extractRedirs ident = do + md <- getMetadata ident + let to = fromMaybe ident $ fromFilePath <$> lookupString "mount" md + froms = + fromMaybe [] $ + map (fromFilePath . dropTrailingPathSeparator . normalise) <$> + lookupStringList "redirects" md + pure (to, froms) + +makePage :: Rules () +makePage = do + route $ indexInDir (metadataRoute getMount) + compile $ + pandocCompiler >>= loadAndApplyTemplate "templates/page.html" pageCtx >>= + loadAndApplyTemplate "templates/default.html" pageCtx >>= + relativizeUrls + +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) + +main :: IO () +main = + hakyll $ + {- Source the pages -} + do + match "external/**/*.md" makePage + {- Source and process the redirects -} + getMatches "external/**/*.md" >>= spawnRedirects + {- Compile the templates (no routing, cache-only) -} + match "templates/*" $ compile templateBodyCompiler + +pageCtx :: Context String +pageCtx = defaultContext