-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathsite.hs
143 lines (118 loc) · 4.95 KB
/
site.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
import Data.Monoid (mappend)
import Hakyll
import Control.Monad (liftM)
import System.FilePath (takeBaseName)
--------------------------------------------------------------------------------
main :: IO ()
main = hakyllWith config $ do
mkAssets
mkCSS
mkError
mkPages
{- mkPosts; mkArchive; mkPaginate -}
mkIndex
mkTemplate
mkAtomXML
config :: Configuration
config = defaultConfiguration
{ destinationDirectory = "docs"
}
mkAssets, mkCSS, mkError, mkPages, mkIndex,
mkTemplate, mkAtomXML :: Rules ()
mkAssets = match ("images/*" .||. "js/*" .||. "assets/*") $ do
route idRoute
compile copyFileCompiler
mkCSS = match "css/*" $ do
route idRoute
compile compressCssCompiler
mkError = match "error/*" $ do
route $ (gsubRoute "error/" (const "") `composeRoutes` setExtension "html")
compile $ pandocCompiler
>>= applyAsTemplate siteCtx
>>= loadAndApplyTemplate "templates/default.html" (baseSidebarCtx <> siteCtx)
mkPages = 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
mkIndex = match "home.markdown" $ do
route $ constRoute "index.html"
compile $ do
pageName <- takeBaseName . toFilePath <$> getUnderlying
let homeCtx = constField "home" "" `mappend`
siteCtx
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" homeCtx
>>= loadAndApplyTemplate "templates/default.html" (activeSidebarCtx <> homeCtx)
>>= relativizeUrls
mkTemplate = match "templates/*" $ compile templateBodyCompiler
mkAtomXML = create ["atom.xml"] $ do
route idRoute
compile $ do
let feedCtx = postCtx `mappend`
bodyField "description"
posts <- fmap (take 10) . recentFirst =<< loadAllSnapshots "posts/*" "content"
renderAtom feedConfig feedCtx posts
feedConfig :: FeedConfiguration
feedConfig = FeedConfiguration
{ feedTitle = "Programming Languages: Functional Programming"
, feedDescription = "IM, NTU"
, feedAuthorName = "Shin-Cheng Mu"
, feedAuthorEmail = "[email protected]"
, feedRoot = "https://scmu.github.io/plfp"
}
--------------------------------------------------------------------------------
postCtx :: Context String
postCtx =
dateField "date" "%B %e, %Y" `mappend`
defaultContext
siteCtx :: Context String
siteCtx =
baseCtx `mappend`
constField "site_description"
"Programming Languages: Functional Programming" `mappend`
constField "site-url" "https://scmu.github.io/plfp" `mappend`
constField "tagline" "National Taiwan University, 2023" `mappend`
constField "site-title" "程式語言:函數程式設計" `mappend`
constField "copy-year" "2023" `mappend`
constField "github-repo" "https://github.com/hahey/lanyon-hakyll" `mappend`
defaultContext
baseCtx =
constField "baseurl" "https://scmu.github.io/plfp"
-- "http://localhost:8000"
--------------------------------------------------------------------------------
sidebarCtx :: Context String -> Context String
sidebarCtx nodeCtx =
listField "list_pages" nodeCtx (loadAllSnapshots "pages/*" "page-content") `mappend`
defaultContext
baseNodeCtx :: Context String
baseNodeCtx =
urlField "node-url" `mappend`
titleField "page-name" `mappend`
baseCtx `mappend`
defaultContext
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