-
Notifications
You must be signed in to change notification settings - Fork 0
/
Build.hs
executable file
·215 lines (194 loc) · 8.79 KB
/
Build.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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
#!/usr/bin/env stack
-- stack --install-ghc runghc --package shake --package template --package directory --package containers --package text --package filepath --package strip-ansi-escape --package html-entities --package time
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wall #-}
-- | Assemble README and Reflections
import Control.Monad
import Data.Char
import Data.Foldable
import Data.List
import Data.Maybe
import Data.String.AnsiEscapeCodes.Strip.Text
import Data.Text (Text)
import Data.Text.Template
import Data.Time
import Development.Shake
import Development.Shake.FilePath
import Text.Printf
import Text.Read
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified HTMLEntities.Text as H
-- CONSTANTS
year :: Integer
year = 2016
github :: String
github = "mstksg"
otherYears :: S.Set Integer
otherYears = S.fromList [2016 .. 2020]
ctx0 :: M.Map Text Text
ctx0 = M.fromList [
("year" , T.pack (show year) )
, ("github", T.pack github )
, ("name" , "Justin Le" )
, ("email" , "justin@jle.im" )
, ("rss" , "http://feeds.feedburner.com/jle-advent-of-code-2016")
, ("other_years", yearLinks )
]
opts :: ShakeOptions
opts = shakeOptions { shakeFiles = "_build"
, shakeVersion = "1.0"
, shakeVerbosity = Chatty
, shakeThreads = 1 -- for benchmarks to work properly
}
parseDayFp :: FilePath -> Maybe Int
parseDayFp = readMaybe . filter validChar . takeBaseName
where
validChar p = isDigit p || p == '_'
reflPath :: Int -> FilePath
reflPath d = "reflections" </> printf "day%02d.md" d
reflOutPath :: Int -> FilePath
reflOutPath d = "_reflections" </> printf "day%02d.md" d
reflOutCodedPath :: Int -> FilePath
reflOutCodedPath d = "_reflections" </> printf "day%02d-coded.md" d
reflXmlPath :: Int -> FilePath
reflXmlPath d = "_reflections" </> printf "day%02d.xml" d
benchPath :: Int -> FilePath
benchPath d = "bench-out" </> printf "day%02d.txt" d
main :: IO ()
main = shakeArgs opts $ do
want ["README.md", "reflections.md", "feed.xml"]
"reflections.md" %> \fp -> do
days <- getDays
bodies <- forM (M.toList days) $ \(d, hasRefl) ->
if hasRefl
then T.pack <$> readFile' (reflOutPath d)
else T.pack <$> readFile' (reflOutCodedPath d)
let yearUrls = tUnlines' . flip foldMap otherYears $ \oy ->
T.pack
(printf "[%04d]: https://github.com/%s/advent-of-code-%04d/blob/master/reflections.md" oy github oy)
<$ guard (oy /= year)
toc = flip map (M.toList days) $ \(d, hasRefl) ->
if hasRefl
then printf "* [Day %d](#day-%d)" d d
else printf "* [Day %d](#day-%d) *(no reflection yet)*" d d
ctx = ctx0 <> M.fromList
[ ("toc" , T.pack $ unlines' toc )
, ("body", T.intercalate "\n\n\n" bodies)
, ("other_links", yearUrls )
]
writeTemplate fp ctx "template/reflections.md.template"
"README.md" %> \fp -> do
days <- getDays
let mkRow d = case M.lookup d days of
Just True ->
printf "| Day %2d | [x][d%02dr] | [x][d%02dg] | [x][d%02dh] | [x][d%02db] |"
d d d d d
Just False ->
printf "| Day %2d | | [x][d%02dg] | [x][d%02dh] | [x][d%02db] |"
d d d d
Nothing ->
printf "| Day %2d | | | | |"
d
table = unlines' $
"| Challenge | Reflections | Code | Rendered | Benchmarks |"
: "| --------- | ----------- | --------- | ---------- | ---------- |"
: map mkRow [1..25]
links = unlines' . M.foldMapWithKey mkLinks $ days
yearUrls = tUnlines' . flip foldMap otherYears $ \oy ->
T.pack (printf "[%04d]: https://github.com/%s/advent-of-code-%04d" oy github oy)
<$ guard (oy /= year)
ctx = ctx0 <> M.fromList
[ ("table" , T.pack table)
, ("links" , T.pack links)
, ("other_links", yearUrls )
]
writeTemplate fp ctx "template/README.md.template"
"feed.xml" %> \fp -> do
days <- reflectionDays
bodies <- forM (reverse (toList days)) $ \d ->
T.pack <$> readFile' (reflXmlPath d)
time <- utcToZonedTime (read "EST") <$> liftIO getCurrentTime
let ctx = ctx0 <> M.fromList
[ ("body", T.intercalate "\n" bodies)
, ("time", T.pack . formatTime defaultTimeLocale rfc822DateFormat $ time )
]
writeTemplate fp ctx "template/feed.xml.template"
"_reflections/*.md" %> \fp -> do
let Just d = parseDayFp fp
hasRefl = not $ "coded" `isInfixOf` fp
refl <- if hasRefl
then T.pack <$> readFile' (reflPath d)
else pure "*Reflection not yet written -- please check back later!*"
bench <- T.pack <$> readFile' (benchPath d)
let ctx = ctx0 <> M.fromList
[ ("daylong" , T.pack $ printf "%02d" d)
, ("dayshort" , T.pack $ printf "%d" d )
, ("body" , refl )
, ("benchmarks", bench )
]
writeTemplate fp ctx "template/reflection.md.template"
"_reflections/*.xml" %> \fp -> do
let Just d = parseDayFp fp
refl <- readFile' (reflOutPath d)
Stdout html <- cmd ("pandoc -t html -f markdown" :: String)
(Stdin refl)
let time = ZonedTime
(LocalTime (fromGregorian year 12 d)
(TimeOfDay 1 0 0)
)
(read "EST")
ctx = ctx0 <> M.fromList
[ ("day" , T.pack $ printf "%d" d )
, ("body", H.text . T.pack $ html )
, ("time", T.pack . formatTime defaultTimeLocale rfc822DateFormat $ time )
]
writeTemplate fp ctx "template/feed-item.xml.template"
"bench-out/*.txt" %> \fp -> do
let Just d = parseDayFp fp
Stdout out <- cmd ("stack run --" :: String) (printf "bench %d" d :: String)
writeFileChanged fp . T.unpack . T.strip . stripAnsiEscapeCodes . T.pack $ out
"clean" ~> do
removeFilesAfter "_reflections" ["//*"]
-- removeFilesAfter "bench-out" ["//*"]
removeFilesAfter "_build" ["//*"]
where
reflectionDays = S.fromList . mapMaybe parseDayFp <$> getDirectoryFiles "reflections" ["*.md"]
codedDays = do
ds <- mapMaybe parseDayFp <$> getDirectoryFiles codePath ["*.hs"]
fmap S.fromList . flip filterM ds $ \d -> do
let dayFile = codePath </> printf "Day%02d.hs" d
not . ("AOC.Prelude" `T.isInfixOf`) . T.pack <$> readFile' dayFile
getDays = do
rd <- M.fromSet (const True ) <$> reflectionDays
cd <- M.fromSet (const False) <$> codedDays
pure $ M.unionWith (||) rd cd
writeTemplate fp ctx templ = do
out <- flip substitute (ctx M.!) . T.pack <$> readFile' templ
writeFileChanged fp (TL.unpack out)
yearLinks :: Text
yearLinks = T.intercalate " / " . flip map (S.toList otherYears) $ \oy ->
let linker | oy == year = "%04d"
| otherwise = "[%04d][]"
in T.pack $ printf "*%s*" (printf linker oy :: String)
mkLinks :: Int -> Bool -> [String]
mkLinks d hasRef = catMaybes [
Just $ printf "[d%02dg]: https://github.com/mstksg/advent-of-code-%04d/blob/master/src/AOC/Challenge/Day%02d.hs"
d year d
, Just $ printf "[d%02dh]: https://mstksg.github.io/advent-of-code-%04d/src/AOC.Challenge.Day%02d.html"
d year d
, do guard hasRef
Just $ printf "[d%02dr]: https://github.com/mstksg/advent-of-code-%04d/blob/master/reflections.md#day-%d"
d year d
, Just $ printf "[d%02db]: https://github.com/mstksg/advent-of-code-%04d/blob/master/reflections.md#day-%d-benchmarks"
d year d
]
unlines' :: [String] -> String
unlines' = intercalate "\n"
tUnlines' :: [Text] -> Text
tUnlines' = T.intercalate "\n"
codePath :: FilePath
codePath = "src/AOC/Challenge"