nek0.eu/src/Main.hs

213 lines
6.8 KiB
Haskell
Raw Normal View History

2016-03-01 07:03:27 +00:00
--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
2017-07-10 15:42:09 +00:00
import Hakyll
import Data.Monoid ((<>))
import Data.List
import Data.Maybe (fromMaybe)
import Data.Time.Format (parseTimeM, defaultTimeLocale)
import Data.Time.Clock (UTCTime)
import System.FilePath (takeFileName)
import Network.HTTP.Base (urlEncode)
import Control.Monad (liftM)
2016-03-01 07:03:27 +00:00
--------------------------------------------------------------------------------
main :: IO ()
2017-07-10 15:42:09 +00:00
main =
2016-03-01 07:03:27 +00:00
hakyllWith config $ do
2016-03-02 11:14:04 +00:00
match "templates/*" $ compile templateCompiler
2016-03-01 07:03:27 +00:00
--copy fonts, images etc.
2016-11-05 02:14:18 +00:00
match
2020-03-08 18:21:22 +00:00
( "site/font/**"
.||. "site/images/**"
.||. "site/vids/**"
2017-12-03 00:48:56 +00:00
.||. "site/humans.txt"
2019-09-13 02:45:15 +00:00
.||. "site/8ADADB98780B5BAF.asc"
2017-12-03 00:48:56 +00:00
.||. "site/robots.txt"
.||. "site/keybase.txt"
2016-11-05 02:14:18 +00:00
) $ do
2017-12-03 00:48:56 +00:00
route myRoute
2016-11-05 02:14:18 +00:00
compile copyFileCompiler
2016-03-01 07:03:27 +00:00
2017-12-03 00:48:56 +00:00
match "site/css/*" $ do
route myRoute
2016-03-01 07:03:27 +00:00
compile compressCssCompiler
-- Build tags
2017-12-03 00:48:56 +00:00
tags <- buildTags "site/posts/*.md" (fromCapture "tags/*.html")
2016-03-01 07:03:27 +00:00
--build tagcloud
2018-07-25 13:53:14 +00:00
let baseCtx = tagCloudField "tags" 100 100 tags <>
2016-03-01 07:03:27 +00:00
defaultContext
2017-12-03 00:48:56 +00:00
match "site/index.md" $ do
2017-12-03 03:00:30 +00:00
route $ myRoute `composeRoutes` setExtension "html"
2016-03-03 22:02:14 +00:00
compile $ do
2018-08-18 09:02:40 +00:00
posts <- fmap (take 6) . recentFirst =<< loadAll "site/posts/*"
2016-03-03 22:02:14 +00:00
let indexCtx = listField "posts" (postCtx tags) (return posts) <>
constField "title" "Home" <>
defaultContext
2016-03-03 23:21:25 +00:00
getResourceBody
2016-03-03 22:02:14 +00:00
>>= applyAsTemplate indexCtx
2016-03-03 23:21:25 +00:00
>>= renderPandoc
2016-03-03 22:02:14 +00:00
>>= loadAndApplyTemplate "templates/default.html" baseCtx
2017-12-03 23:07:46 +00:00
-- >>= relativizeUrls
2016-03-03 22:02:14 +00:00
2017-12-03 00:48:56 +00:00
match (fromList
[ "site/about.md"
, "site/imprint.md"
, "site/contact.md"
]) $ do
route $ myRoute `composeRoutes` setExtension "html"
compile $ pandocCompiler
>>= loadAndApplyTemplate "templates/default.html" baseCtx
2017-12-03 23:07:46 +00:00
-- >>= relativizeUrls
2016-03-01 07:03:27 +00:00
2017-12-03 00:48:56 +00:00
match "site/404.md" $ do
route $ myRoute `composeRoutes` setExtension "html"
2016-03-01 07:03:27 +00:00
compile $ pandocCompiler
>>= loadAndApplyTemplate "templates/default.html" baseCtx
2017-12-03 00:48:56 +00:00
is <- sortIdentifiersByDate <$> getMatches "site/posts/*.md"
2017-07-10 15:42:09 +00:00
2016-03-01 07:03:27 +00:00
pages <- buildPaginateWith
2017-07-10 15:42:09 +00:00
(liftM (paginateEvery 1) . sortRecentFirst)
2017-12-03 00:48:56 +00:00
"site/posts/*.md"
2016-03-01 07:03:27 +00:00
(\n -> is !! (n - 1))
paginateRules pages $ \num _ -> do
2017-12-03 00:48:56 +00:00
route $ myRoute `composeRoutes` setExtension "html"
2016-03-01 07:03:27 +00:00
compile $ do
2016-05-09 22:40:27 +00:00
ident <- getUnderlying
title <- getMetadataField' ident "title"
2016-06-11 09:30:41 +00:00
url <- return . fromMaybe "" =<< getRoute ident
2016-03-03 23:21:45 +00:00
compiled <- getResourceBody >>= renderPandoc
2016-03-01 07:03:27 +00:00
let pageCtx = paginateContext pages num
let flattrCtx = constField "enctitle" (urlEncode title) <>
constField "encurl" (urlEncode $ "https://nek0.eu/" ++ url)
let ctx = (postCtx tags) <> pageCtx <> flattrCtx
2016-03-01 07:03:27 +00:00
full <- loadAndApplyTemplate "templates/post.html" ctx compiled
_ <- saveSnapshot "content" compiled
2019-09-24 02:38:11 +00:00
loadAndApplyTemplate "templates/default.html" (baseCtx <> ctx) full
2016-03-01 07:03:27 +00:00
-- Post tags
tagsRules tags $ \tag pattern -> do
let title = "Posts tagged " ++ tag ++ ":"
-- Copied from posts, need to refactor
2017-12-03 00:48:56 +00:00
route myRoute
2016-03-01 07:03:27 +00:00
compile $ do
posts <- recentFirst =<< loadAll pattern
let ctx = constField "title" title <>
listField "posts" (postCtx tags) (return posts) <>
baseCtx
makeItem ""
2016-03-29 17:29:07 +00:00
>>= loadAndApplyTemplate "templates/post-list.html" ctx
2016-03-01 07:03:27 +00:00
>>= loadAndApplyTemplate "templates/default.html" ctx
>>= relativizeUrls
create ["archive.html"] $ do
route idRoute
compile $ do
2017-12-03 00:48:56 +00:00
posts <- recentFirst =<< loadAll "site/posts/*"
2016-03-01 07:03:27 +00:00
let archiveCtx = listField "posts" (postCtx tags) (return posts) <>
constField "title" "Archives" <>
baseCtx
makeItem ""
>>= loadAndApplyTemplate "templates/archive.html" archiveCtx
>>= loadAndApplyTemplate "templates/default.html" archiveCtx
2017-12-03 23:07:46 +00:00
-- >>= relativizeUrls
2016-03-01 07:03:27 +00:00
-- feeds
create ["atom.xml"] $ do
route idRoute
compile $ do
2018-02-28 17:44:04 +00:00
loadAllSnapshots "site/posts/*.md" "content"
2018-12-23 22:19:51 +00:00
>>= recentFirst
2016-03-01 07:03:27 +00:00
>>= renderAtom feedConf feedCtx
create ["rss.xml"] $ do
route idRoute
compile $ do
2018-02-28 17:44:04 +00:00
loadAllSnapshots "site/posts/*.md" "content"
2018-12-23 22:19:51 +00:00
>>= recentFirst
2016-03-01 07:03:27 +00:00
>>= renderRss feedConf feedCtx
2017-12-03 03:00:05 +00:00
create ["sitemap.xml"] $ do
route idRoute
compile $ do
rposts <- loadAll "site/**/*.md"
rsites <- loadAll "site/*.md"
-- rtxts <- loadAll "site/*.txt"
-- rascs <- loadAll "site/*.asc"
let sites = return (rposts ++ rsites)
let sitemapCtx = mconcat
[ listField "entries"
(postCtx tags <> constField "host" "https://nek0.eu/")
sites
, constField "host" "https://nek0.eu/"
, defaultContext
]
makeItem ""
>>= loadAndApplyTemplate "templates/sitemap.xml" sitemapCtx
2016-03-01 07:03:27 +00:00
--------------------------------------------------------------------------------
2017-07-10 15:42:09 +00:00
sortIdentifiersByDate :: [Identifier] -> [Identifier]
sortIdentifiersByDate =
2017-12-03 03:00:52 +00:00
sortBy byDate
2017-07-10 15:42:09 +00:00
where
byDate id1 id2 =
let fn1 = takeFileName $ toFilePath id1
fn2 = takeFileName $ toFilePath id2
parseTime' fn = parseTimeM True defaultTimeLocale "%Y-%m-%d" $
intercalate "-" $ take 3 $ splitAll "-" fn
in compare
(parseTime' fn1 :: Maybe UTCTime)
(parseTime' fn2 :: Maybe UTCTime)
--------------------------------------------------------------------------------
2016-03-03 21:56:45 +00:00
2016-03-01 07:03:27 +00:00
postCtx :: Tags -> Context String
postCtx tags = mconcat
[ modificationTimeField "mtime" "%U"
, dateField "date" "%B %e, %Y"
2016-03-29 17:24:14 +00:00
, dateField "datetime" "%F"
2016-03-01 07:03:27 +00:00
, tagsField "tags" tags
, defaultContext
]
--------------------------------------------------------------------------------
2016-03-03 21:56:45 +00:00
2016-03-01 07:03:27 +00:00
feedCtx :: Context String
feedCtx = mconcat
[ bodyField "description"
, defaultContext
]
--------------------------------------------------------------------------------
feedConf :: FeedConfiguration
feedConf = FeedConfiguration
{ feedTitle = "nek0's blog"
, feedDescription = "Random things"
, feedAuthorName = "nek0"
, feedAuthorEmail = "nek0@nek0.eu"
2016-03-04 00:21:30 +00:00
, feedRoot = "https://nek0.eu"
2016-03-01 07:03:27 +00:00
}
--------------------------------------------------------------------------------
config :: Configuration
config = defaultConfiguration
2019-08-24 13:37:34 +00:00
{ deployCommand = "rsync --del --checksum -ave 'ssh -p 5555' \\_site/* nek0@nek0.eu:/home/nek0/blog"
2016-03-01 07:03:27 +00:00
}
2017-12-03 00:48:56 +00:00
--------------------------------------------------------------------------------
myRoute :: Routes
myRoute = gsubRoute "site/" (const "")