restructuring source
This commit is contained in:
parent
c58cea80d0
commit
ab7c40330a
2 changed files with 31 additions and 11 deletions
|
@ -27,3 +27,5 @@ executable blog
|
||||||
, hakyll
|
, hakyll
|
||||||
, directory
|
, directory
|
||||||
, HTTP
|
, HTTP
|
||||||
|
, time
|
||||||
|
, filepath
|
||||||
|
|
40
src/Main.hs
40
src/Main.hs
|
@ -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"
|
||||||
|
|
Loading…
Reference in a new issue