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