restructuring source

This commit is contained in:
nek0 2017-07-10 17:42:09 +02:00
parent c58cea80d0
commit ab7c40330a
2 changed files with 31 additions and 11 deletions

View file

@ -27,3 +27,5 @@ executable blog
, hakyll , hakyll
, directory , directory
, HTTP , HTTP
, time
, filepath

View file

@ -1,18 +1,19 @@
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
import Hakyll import Hakyll
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.List (sort, delete) import Data.List
import System.Directory import Data.Maybe (fromMaybe)
import Network.HTTP.Base (urlEncode) import Data.Time.Format (parseTimeM, defaultTimeLocale)
import Data.Maybe (fromMaybe) import Data.Time.Clock (UTCTime)
import System.FilePath (takeFileName)
import Network.HTTP.Base (urlEncode)
import Control.Monad (liftM)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
main :: IO () main :: IO ()
main = do main =
fs <- getDirectoryContents "./posts"
is <- return $ map (fromFilePath . ("posts/" ++)) $ sort $ delete "." $ delete ".." fs
hakyllWith config $ do hakyllWith config $ do
@ -65,8 +66,10 @@ main = do
compile $ pandocCompiler compile $ pandocCompiler
>>= loadAndApplyTemplate "templates/default.html" baseCtx >>= loadAndApplyTemplate "templates/default.html" baseCtx
is <- sortIdentifiersByDate <$> getMatches "posts/*.md"
pages <- buildPaginateWith pages <- buildPaginateWith
(return . map return . sort) (liftM (paginateEvery 1) . sortRecentFirst)
"posts/*.md" "posts/*.md"
(\n -> is !! (n - 1)) (\n -> is !! (n - 1))
@ -133,6 +136,21 @@ main = do
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
sortIdentifiersByDate :: [Identifier] -> [Identifier]
sortIdentifiersByDate =
sortBy byDate
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)
--------------------------------------------------------------------------------
postCtx :: Tags -> Context String postCtx :: Tags -> Context String
postCtx tags = mconcat postCtx tags = mconcat
[ modificationTimeField "mtime" "%U" [ modificationTimeField "mtime" "%U"