-
Notifications
You must be signed in to change notification settings - Fork 2
/
Main.hs
132 lines (122 loc) · 4.02 KB
/
Main.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
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import Clay (Css, em, pc, px, sym, (?))
import qualified Clay as C
import Control.Monad
import Data.Aeson (FromJSON, fromJSON)
import qualified Data.Aeson as Aeson
import Data.Text (Text)
import qualified Data.Text as T
import Development.Shake
import GHC.Generics (Generic)
import Lucid
import Main.Utf8
import Rib (IsRoute, Pandoc)
import qualified Rib
import qualified Rib.Parser.Pandoc as Pandoc
import System.FilePath
-- | Route corresponding to each generated static page.
--
-- The `a` parameter specifies the data (typically Markdown document) used to
-- generate the final page text.
data Route a where
Route_Index :: Route [(Route Pandoc, Pandoc)]
Route_Article :: FilePath -> Route Pandoc
-- | The `IsRoute` instance allows us to determine the target .html path for
-- each route. This affects what `routeUrl` will return.
instance IsRoute Route where
routeFile = \case
Route_Index ->
pure "index.html"
Route_Article srcPath ->
pure $ "article" </> srcPath -<.> ".html"
-- | Main entry point to our generator.
--
-- `Rib.run` handles CLI arguments, and takes three parameters here.
--
-- 1. Directory `content`, from which static files will be read.
-- 2. Directory `dest`, under which target files will be generated.
-- 3. Shake action to run.
--
-- In the shake action you would expect to use the utility functions
-- provided by Rib to do the actual generation of your static site.
main :: IO ()
main = withUtf8 $ do
Rib.run "content" "dest" generateSite
-- | Shake action for generating the static site
generateSite :: Action ()
generateSite = do
-- Copy over the static files
Rib.buildStaticFiles ["static/**"]
let writeHtmlRoute :: Route a -> a -> Action ()
writeHtmlRoute r = Rib.writeRoute r . Lucid.renderText . renderPage r
-- Build individual sources, generating .html for each.
articles <-
Rib.forEvery ["*.md"] $ \srcPath -> do
let r = Route_Article srcPath
doc <- Pandoc.parse Pandoc.readMarkdown srcPath
writeHtmlRoute r doc
pure (r, doc)
writeHtmlRoute Route_Index articles
-- | Define your site HTML here
renderPage :: Route a -> a -> Html ()
renderPage route val = html_ [lang_ "en"] $ do
head_ $ do
meta_ [httpEquiv_ "Content-Type", content_ "text/html; charset=utf-8"]
title_ routeTitle
style_ [type_ "text/css"] $ C.render pageStyle
body_ $ do
div_ [class_ "header"] $
a_ [href_ "/"] "Back to Home"
h1_ routeTitle
case route of
Route_Index ->
div_ $
forM_ val $ \(r, src) ->
li_ [class_ "pages"] $ do
let meta = getMeta src
b_ $ a_ [href_ (Rib.routeUrl r)] $ toHtml $ title meta
renderMarkdown `mapM_` description meta
Route_Article _ ->
article_ $
Pandoc.render val
where
routeTitle :: Html ()
routeTitle = case route of
Route_Index -> "Rib sample site"
Route_Article _ -> toHtml $ title $ getMeta val
renderMarkdown :: Text -> Html ()
renderMarkdown =
Pandoc.render . Pandoc.parsePure Pandoc.readMarkdown
-- | Define your site CSS here
pageStyle :: Css
pageStyle =
C.body ? do
C.margin (em 4) (pc 20) (em 1) (pc 20)
".header" ? do
C.marginBottom $ em 2
"li.pages" ? do
C.listStyleType C.none
C.marginTop $ em 1
"b" ? C.fontSize (em 1.2)
"p" ? sym C.margin (px 0)
-- | Metadata in our markdown sources
data SrcMeta = SrcMeta
{ title :: Text,
-- | Description is optional, hence `Maybe`
description :: Maybe Text
}
deriving (Show, Eq, Generic, FromJSON)
-- | Get metadata from Markdown's YAML block
getMeta :: Pandoc -> SrcMeta
getMeta src = case Pandoc.extractMeta src of
Nothing -> error "No YAML metadata"
Just (Left e) -> error $ T.unpack e
Just (Right val) -> case fromJSON val of
Aeson.Error e -> error $ "JSON error: " <> e
Aeson.Success v -> v