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
144
145
146
147
148
|
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Pages where
import Control.Monad (forM)
import Control.Monad.IO.Class (liftIO)
import Data.List (find)
import Data.Text (Text)
import Data.Text.IO qualified as T
import Language.Haskell.TH.Syntax (addDependentFile)
import System.Directory (makeAbsolute, listDirectory)
import Text.Mustache.Compile qualified as M
import Text.Mustache.Types qualified as M
import Pages.TH
data IndexData = IndexData
{ networks :: [IndexNetworkData] }
data IndexNetworkData = IndexNetworkData
{ name :: Text
, channels :: [IndexChannelData] }
data IndexChannelData = IndexChannelData
{ name :: Text
, alias :: Text }
data CalendarData = CalendarData
{ network :: Text
, channel :: Text
, alias :: Text
, years :: [CalendarYearData]
}
data CalendarYearData = CalendarYearData
{ year :: Int
, monrows :: [CalendarMonthRowData] }
data CalendarMonthRowData = CalendarMonthRowData
{ months :: [CalendarMonthData] }
data CalendarMonthData = CalendarMonthData
{ display :: Bool
, month :: Int
, month00 :: Text
, monthname :: Text
, weeks :: [CalendarWeekData]
, phantomweek :: Bool }
data CalendarWeekData = CalendarWeekData
{ days :: [CalendarDayData'] }
data CalendarDayData' = CalendarDayData'
{ date :: Maybe Int
, date00 :: Text }
data LogData = LogData
{ network :: Text
, channel :: Text
, alias :: Text
, totalevents :: Text
, efAll :: Bool
, efCompr :: Bool
, picker :: PickerData
, events :: [EventData () Text]
}
data CalendarDayData = CalendarDayData
{ network :: Text
, channel :: Text
, alias :: Text
, efAll :: Bool
, efCompr :: Bool
, date :: Text
, picker :: CalendarPickerData
, events :: [EventData Text ()]
}
data PickerData = PickerData
{ prevpage :: Maybe Int
, nextpage :: Maybe Int
, firstpage :: Bool
, leftdots :: Bool
, rightdots :: Bool
, lastpage :: Bool
, leftnums :: [Int]
, curnum :: Int
, rightnums :: [Int]
, npages :: Int
}
data CalendarPickerData = CalendarPickerData
{ prevpage :: Maybe Text
, nextpage :: Maybe Text }
data EventData tm dttm = EventData
{ classlist :: Maybe Text
, time :: tm
, datetime :: dttm
, linkid :: Text
, nickwrap1 :: Maybe Text
, nick :: Text
, nickwrap2 :: Maybe Text
, message :: Text
}
$(do let dropSuffix suf str =
let (actualSuf, rstr) = splitAt (length suf) (reverse str)
in if actualSuf == reverse suf then reverse rstr else str
let inlinePartials :: [M.Template] -> M.Template -> M.Template
inlinePartials ps (M.Template topname ast _) = M.Template topname (concatMap go ast) mempty
where
go :: M.Node Text -> [M.Node Text]
go n@M.TextBlock{} = [n]
go (M.Section named nodes) = [M.Section named (concatMap go nodes)]
go (M.InvertedSection named nodes) = [M.InvertedSection named (concatMap go nodes)]
go n@M.Variable{} = [n]
-- sorry for the lost indent
go (M.Partial _indent partialname) =
case find ((== partialname) . M.name) ps of
Just (M.Template _ ast' _) -> concatMap go ast'
Nothing -> error $ "Partial not found: " ++ partialname
partialFiles <- liftIO $ listDirectory "pages/partials"
partials <- forM partialFiles $ \fname -> do
path <- liftIO $ makeAbsolute ("pages/partials/" ++ fname)
tplSrc <- liftIO $ T.readFile path
addDependentFile path
let name = dropSuffix ".mustache" fname
case M.compileTemplate name tplSrc of
Right tpl -> return tpl
Left err -> fail $ "Reading " ++ path ++ ": " ++ show err
let makeDecs name dataname = do
path <- liftIO $ makeAbsolute ("pages/" ++ name ++ ".mustache")
tplSrc <- liftIO $ T.readFile path
addDependentFile path
tpl <- case M.compileTemplate name tplSrc of
Right tpl -> return tpl
Left err -> fail $ "Reading " ++ path ++ ": " ++ show err
let tpl' = inlinePartials partials tpl
makeRender tpl' dataname
concat <$> mapM (uncurry makeDecs)
[("log", ''LogData)
,("calendar-day", ''CalendarDayData)
,("index", ''IndexData)
,("calendar", ''CalendarData)])
|
