site: initial commit
This commit is contained in:
parent
23e70fb123
commit
639f8749fd
GPG key ID:
E5CA1AA0292A0100
198
site.hs
Normal file
198
site.hs
Normal file
|
|
@ -0,0 +1,198 @@
|
|||
--------------------------------------------------------------------------------
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
import Data.Monoid (mappend)
|
||||
import Data.List (sortBy)
|
||||
import Data.Ord (comparing)
|
||||
import Hakyll
|
||||
import Control.Monad (liftM, forM_)
|
||||
import System.FilePath (takeBaseName)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
main :: IO ()
|
||||
main = hakyll $ do
|
||||
match ("images/*" .||. "js/*") $ do
|
||||
route idRoute
|
||||
compile copyFileCompiler
|
||||
|
||||
match "css/*" $ do
|
||||
route idRoute
|
||||
compile compressCssCompiler
|
||||
|
||||
match "error/*" $ do
|
||||
route $ (gsubRoute "error/" (const "") `composeRoutes` setExtension "html")
|
||||
compile $ pandocCompiler
|
||||
>>= applyAsTemplate siteCtx
|
||||
>>= loadAndApplyTemplate "templates/default.html" (baseSidebarCtx <> siteCtx)
|
||||
|
||||
match "pages/*" $ do
|
||||
route $ setExtension "html"
|
||||
compile $ do
|
||||
pageName <- takeBaseName . toFilePath <$> getUnderlying
|
||||
let pageCtx = constField pageName "" `mappend`
|
||||
baseNodeCtx
|
||||
let evalCtx = functionField "get-meta" getMetadataKey `mappend`
|
||||
functionField "eval" (evalCtxKey pageCtx)
|
||||
let activeSidebarCtx = sidebarCtx (evalCtx <> pageCtx)
|
||||
|
||||
pandocCompiler
|
||||
>>= saveSnapshot "page-content"
|
||||
>>= loadAndApplyTemplate "templates/page.html" siteCtx
|
||||
>>= loadAndApplyTemplate "templates/default.html" (activeSidebarCtx <> siteCtx)
|
||||
>>= relativizeUrls
|
||||
|
||||
tags <- buildTags "posts/*" (fromCapture "tags/*.html")
|
||||
|
||||
match "posts/*" $ version "meta" $ do
|
||||
route $ setExtension "html"
|
||||
compile getResourceBody
|
||||
|
||||
match "posts/*" $ do
|
||||
route $ setExtension "html"
|
||||
compile $ do
|
||||
posts <- loadAll ("posts/*" .&&. hasVersion "meta")
|
||||
let taggedPostCtx = (tagsField "tags" tags) `mappend`
|
||||
postCtx `mappend`
|
||||
(relatedPostsCtx posts 3)
|
||||
|
||||
pandocCompiler
|
||||
>>= saveSnapshot "content"
|
||||
>>= loadAndApplyTemplate "templates/post.html" taggedPostCtx
|
||||
>>= loadAndApplyTemplate "templates/default.html" (baseSidebarCtx <> siteCtx)
|
||||
>>= relativizeUrls
|
||||
|
||||
create ["archive.html"] $ do
|
||||
route idRoute
|
||||
compile $ do
|
||||
posts <- recentFirst =<< loadAllSnapshots ("posts/*" .&&. hasNoVersion) "content"
|
||||
let archiveCtx =
|
||||
listField "posts" postCtx (return posts) `mappend`
|
||||
constField "title" "Archive" `mappend`
|
||||
constField "archive" "" `mappend`
|
||||
siteCtx
|
||||
|
||||
makeItem ""
|
||||
>>= loadAndApplyTemplate "templates/archive.html" archiveCtx
|
||||
>>= loadAndApplyTemplate "templates/default.html" (baseSidebarCtx <> archiveCtx)
|
||||
>>= relativizeUrls
|
||||
|
||||
paginate <- buildPaginateWith postsGrouper "posts/*" postsPageId
|
||||
|
||||
paginateRules paginate $ \page pattern -> do
|
||||
route idRoute
|
||||
compile $ do
|
||||
posts <- recentFirst =<< loadAllSnapshots (pattern .&&. hasNoVersion) "content"
|
||||
let indexCtx =
|
||||
constField "title" (if page == 1 then "Home"
|
||||
else "Blog posts, page " ++ show page) `mappend`
|
||||
listField "posts" postCtx (return posts) `mappend`
|
||||
constField "home" "" `mappend`
|
||||
paginateContext paginate page `mappend`
|
||||
siteCtx
|
||||
|
||||
makeItem ""
|
||||
>>= applyAsTemplate indexCtx
|
||||
>>= loadAndApplyTemplate "templates/index.html" indexCtx
|
||||
>>= loadAndApplyTemplate "templates/default.html" (baseSidebarCtx <> indexCtx)
|
||||
>>= relativizeUrls
|
||||
|
||||
match "templates/*" $ compile templateBodyCompiler
|
||||
|
||||
create ["atom.xml"] $ do
|
||||
route idRoute
|
||||
compile $ do
|
||||
let feedCtx = postCtx `mappend`
|
||||
bodyField "description"
|
||||
posts <- fmap (take 10) . recentFirst =<< loadAllSnapshots ("posts/*" .&&. hasNoVersion) "content"
|
||||
renderAtom feedConfig feedCtx posts
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
postsGrouper :: MonadFail m => MonadMetadata m => [Identifier] -> m [[Identifier]]
|
||||
postsGrouper = liftM (paginateEvery 3) . sortRecentFirst
|
||||
|
||||
|
||||
postsPageId :: PageNumber -> Identifier
|
||||
postsPageId n = fromFilePath $ if (n == 1) then "index.html" else show n ++ "/index.html"
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
feedConfig :: FeedConfiguration
|
||||
feedConfig = FeedConfiguration
|
||||
{ feedTitle = "Voices of Capricornia"
|
||||
, feedDescription = "Be Heard"
|
||||
, feedAuthorName = "Voices of Capricornia"
|
||||
, feedAuthorEmail = "collective@voicesofcapricornia.org"
|
||||
, feedRoot = "https://voicesofcapricornia.org"
|
||||
}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
siteCtx :: Context String
|
||||
siteCtx =
|
||||
baseCtx `mappend`
|
||||
constField "site_description" "Voices of Capricornia" `mappend`
|
||||
constField "site-url" "https://voicesofcapricornia.org" `mappend`
|
||||
constField "tagline" "Be Heard" `mappend`
|
||||
constField "site-title" "Voices of Capricornia" `mappend`
|
||||
constField "copy-year" "2021" `mappend`
|
||||
constField "github-repo" "https://source.jfdic.org/voc/voc-web" `mappend`
|
||||
defaultContext
|
||||
|
||||
baseCtx =
|
||||
constField "baseurl" "https://voicesofcapricornia.org"
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
postCtx :: Context String
|
||||
postCtx =
|
||||
dateField "date" "%B %e, %Y" `mappend`
|
||||
defaultContext
|
||||
|
||||
tagsRulesVersioned tags rules =
|
||||
forM_ (tagsMap tags) $ \(tag, identifiers) ->
|
||||
rulesExtraDependencies [tagsDependency tags] $
|
||||
create [tagsMakeId tags tag] $
|
||||
rules tag identifiers
|
||||
|
||||
relatedPostsCtx
|
||||
:: [Item String] -> Int -> Context String
|
||||
relatedPostsCtx posts n = listFieldWith "related_posts" postCtx selectPosts
|
||||
where
|
||||
rateItem ts i = length . filter (`elem` ts) <$> (getTags $ itemIdentifier i)
|
||||
selectPosts s = do
|
||||
postTags <- getTags $ itemIdentifier s
|
||||
let trimmedItems = filter (not . matchPath s) posts
|
||||
take n . reverse <$> sortOnM (rateItem postTags) trimmedItems
|
||||
|
||||
matchPath :: Item String -> Item String -> Bool
|
||||
matchPath x y = eqOn (toFilePath . itemIdentifier) x y
|
||||
|
||||
eqOn :: Eq b => (a -> b) -> a -> a -> Bool
|
||||
eqOn f x y = f x == f y
|
||||
|
||||
sortOnM :: (Monad m, Ord b) => (a -> m b) -> [a] -> m [a]
|
||||
sortOnM f xs = map fst . sortBy (comparing snd) . zip xs <$> mapM f xs
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
sidebarCtx :: Context String -> Context String
|
||||
sidebarCtx nodeCtx =
|
||||
listField "list_pages" nodeCtx (loadAllSnapshots ("pages/*" .&&. hasNoVersion) "page-content") `mappend`
|
||||
defaultContext
|
||||
|
||||
baseNodeCtx :: Context String
|
||||
baseNodeCtx =
|
||||
urlField "node-url" `mappend`
|
||||
titleField "title" `mappend`
|
||||
baseCtx
|
||||
|
||||
baseSidebarCtx = sidebarCtx baseNodeCtx
|
||||
|
||||
evalCtxKey :: Context String -> [String] -> Item String -> Compiler String
|
||||
evalCtxKey context [key] item = (unContext context key [] item) >>= \cf ->
|
||||
case cf of
|
||||
StringField s -> return s
|
||||
_ -> error $ "Internal error: StringField expected"
|
||||
|
||||
getMetadataKey :: [String] -> Item String -> Compiler String
|
||||
getMetadataKey [key] item = getMetadataField' (itemIdentifier item) key
|
||||
14
voc-web.cabal
Normal file
14
voc-web.cabal
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
name: voc-web
|
||||
version: 0.1.0.0
|
||||
build-type: Simple
|
||||
cabal-version: >= 1.10
|
||||
|
||||
executable site
|
||||
main-is: site.hs
|
||||
build-depends: base == 4.*
|
||||
, hakyll == 4.14.*
|
||||
, containers == 0.6.*
|
||||
, filepath == 1.4.*
|
||||
, pandoc
|
||||
ghc-options: -threaded
|
||||
default-language: Haskell2010
|
||||
Loading…
Reference in a new issue