forked from purescript/purescript.github.io
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathsite.hs
More file actions
107 lines (93 loc) · 3.09 KB
/
site.hs
File metadata and controls
107 lines (93 loc) · 3.09 KB
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
--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
import Data.Monoid (mappend, (<>))
import Data.Char (toUpper)
import Data.Foldable (for_)
import Data.String (fromString)
import Data.List (intersperse)
import Data.Maybe (maybeToList)
import qualified Data.Map as Map
import Hakyll
--------------------------------------------------------------------------------
main :: IO ()
main = hakyll $ do
match ("img/**" .||. "js/**" .||. "css/**" .||. "CNAME") $ do
route idRoute
compile copyFileCompiler
create [".nojekyll"] $ do
route idRoute
compile (makeItem ("" :: String))
match "index.html" $ do
let ctx = field "body" (return . itemBody) <> baseCtx (Just "home")
route idRoute
compile $ getResourceBody
>>= loadAndApplyTemplate "templates/default.html" ctx
>>= relativizeUrls
for_ ["learn", "projects", "download"] $ \subsection -> do
let ctx = baseCtx (Just subsection)
match (fromGlob (subsection <> "/index.html")) $ do
route $ idRoute
compile $ getResourceBody
>>= loadAndApplyTemplate "templates/default.html" ctx
>>= relativizeUrls
match "learn/*/*.markdown" $ do
let ctx = postCtx (Just "learn")
route $ setExtension "html"
compile $ pandocCompiler
>>= loadAndApplyTemplate "templates/post.html" ctx
>>= loadAndApplyTemplate "templates/default.html" ctx
>>= relativizeUrls
match "templates/*" $ compile templateCompiler
--------------------------------------------------------------------------------
navItems :: [ (String, String, String) ]
navItems =
[ ("home", "Home", "/")
, ("download", "Download", "/download/")
, ("learn", "Learn", "/learn/")
, ("projects", "Projects", "/projects/")
]
nav :: Maybe String -> String
nav activeSubsection =
concat $
[ "<ul>\n" ]
<> map render navItems
<> [ "</ul>\n" ]
where
render :: (String, String, String) -> String
render (name, text, url) =
concat
[ "<li><a href=\"" , url , "\""
, if activeSubsection == Just name then " class=\"active\"" else ""
, ">"
, text
, "</a></li>"
, "\n"
]
baseCtx :: Maybe String -> Context String
baseCtx activeSubsection =
constField "nav" (nav activeSubsection) <>
maybe mempty (constField "subsection") activeSubsection <>
field "page_title" makePageTitle <>
defaultContext
where
capitalize (x:xs) = toUpper x : xs
capitalize [] = []
makePageTitle item = do
mtitle <- getTitle item
let elems = [ "PureScript" ] <>
maybeToList subsectionTitle <>
maybeToList mtitle
return $ concat $ intersperse " – " elems
subsectionTitle =
activeSubsection >>= \case
"home" -> Nothing
other -> Just (capitalize other)
getTitle :: Item a -> Compiler (Maybe String)
getTitle item = do
metadata <- getMetadata (itemIdentifier item)
return $ Map.lookup "title" metadata
postCtx :: Maybe String -> Context String
postCtx activeSubsection =
dateField "date" "%B %e, %Y" <>
baseCtx activeSubsection