-
Notifications
You must be signed in to change notification settings - Fork 18
/
re-gen-cabals.lhs
369 lines (332 loc) · 12.3 KB
/
re-gen-cabals.lhs
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
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
Regex Cabal Gen
===============
This tool generates the cabal files for the regex and regex-examples
packages as well as the cabal file for the development tree
(contaiing the combined targets of both packages). In addition it
contains scripts for bumping the version number and generating the
Hackage releases.
The tool is self-testing: run it with no arguments (or `cabal test`).
\begin{code}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Main (main) where
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Char
import Data.IORef
import qualified Data.List as L
import qualified Data.Map as Map
import Data.Maybe
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Prelude.Compat
import qualified Shelly as SH
import System.Directory
import System.Environment
import System.Exit
import System.IO
import TestKit
import Text.Printf
import Text.RE.TDFA.ByteString.Lazy
import Text.RE.TDFA.Text as T
import Text.RE.Tools.Grep
import Text.RE.Tools.Sed
import Text.RE.Types.Match
import Text.RE.Types.Matches
main :: IO ()
main = do
(pn,as) <- (,) <$> getProgName <*> getArgs
case as of
[] -> test
["test"] -> test
["bump-version",vrn] -> bumpVersion vrn
["sdist"] -> sdist
["gen"] -> do
gen "lib/cabal-masters/mega-regex.cabal" "lib/mega-regex.cabal"
gen "lib/cabal-masters/regex.cabal" "lib/regex.cabal"
gen "lib/cabal-masters/regex-with-pcre.cabal" "lib/regex-with-pcre.cabal"
gen "lib/cabal-masters/regex-examples.cabal" "lib/regex-examples.cabal"
establish "mega-regex" "regex"
_ -> do
let prg = ((" "++pn++" ")++)
hPutStr stderr $ unlines
[ "usage:"
, prg "--help"
, prg "[test]"
, prg "bump-version <version>"
, prg "sdist"
, prg "gen"
]
exitWith $ ExitFailure 1
test :: IO ()
test = do
createDirectoryIfMissing False "tmp"
gen "lib/cabal-masters/mega-regex.cabal" "tmp/mega-regex.cabal"
ok <- cmp "tmp/mega-regex.cabal" "lib/mega-regex.cabal"
case ok of
True -> return ()
False -> exitWith $ ExitFailure 1
gen :: FilePath -> FilePath -> IO ()
gen in_f out_f = do
ctx <- setup
LBS.writeFile out_f =<<
sed' (gc_script ctx) =<< substVersion_ =<< include =<<
LBS.readFile in_f
data Ctx =
Ctx
{ _ctx_w_error :: IORef Bool
, _ctx_filter_pcre :: IORef Bool
, _ctx_package_constraints :: IORef (Map.Map LBS.ByteString LBS.ByteString)
, _ctx_test_exe :: IORef (Maybe TestExe)
}
data TestExe =
TestExe
{ _te_test :: Bool
, _te_exe :: Bool
, _te_name :: LBS.ByteString
, _te_text :: LBS.ByteString
}
deriving (Show)
setup :: IO Ctx
setup = Ctx <$> (newIORef True) <*> (newIORef False) <*> (newIORef Map.empty) <*> (newIORef Nothing)
gc_script :: Ctx -> Edits IO RE LBS.ByteString
gc_script ctx = Select
[ LineEdit [re|^%Werror$|] $ w_error_gen ctx
, LineEdit [re|^%Wwarn$|] $ w_warn_gen ctx
, LineEdit [re|^%filter-regex-with-pcre$|] $ w_filter_pcre ctx
, LineEdit [re|^%- +${pkg}(@{%id-}) +${cond}(.*)$|] $ cond_gen ctx
, LineEdit [re|^%build-depends-${lb}(lib|prog) +${list}(@{%id-}( +@{%id-})*)$|]
$ build_depends_gen ctx
, LineEdit [re|^%test +${i}(@{%id-})$|] $ test_exe_gen True False ctx
, LineEdit [re|^%exe +${i}(@{%id-})$|] $ test_exe_gen False True ctx
, LineEdit [re|^%test-exe +${i}(@{%id-})$|] $ test_exe_gen True True ctx
, LineEdit [re|^.*$|] $ default_gen ctx
]
w_error_gen, w_warn_gen, w_filter_pcre, cond_gen, build_depends_gen,
default_gen :: Ctx
-> LineNo
-> Matches LBS.ByteString
-> IO (LineEdit LBS.ByteString)
w_error_gen Ctx{..} _ _ = writeIORef _ctx_w_error True >> return Delete
w_warn_gen Ctx{..} _ _ = writeIORef _ctx_w_error False >> return Delete
w_filter_pcre Ctx{..} _ _ = writeIORef _ctx_filter_pcre True >> return Delete
cond_gen Ctx{..} _ mtchs = do
modifyIORef _ctx_package_constraints $ Map.insert pkg cond
return Delete
where
pkg = captureText [cp|pkg|] mtch
cond = captureText [cp|cond|] mtch
mtch = allMatches mtchs !! 0
build_depends_gen ctx@Ctx{..} _ mtchs = do
we <- readIORef _ctx_w_error
fp <- readIORef _ctx_filter_pcre
mp <- readIORef _ctx_package_constraints
put ctx $ mk_build_depends lb we fp mp lst
where
lb = captureText [cp|lb|] mtch == "lib"
lst = LBS.words $ captureText [cp|list|] mtch
mtch = allMatches mtchs !! 0
default_gen ctx@Ctx{..} _ mtchs = do
mb <- readIORef _ctx_test_exe
case mb of
Nothing -> return $ ReplaceWith ln
Just te -> case isSpace $ LBS.head $ ln<>"\n" of
True -> put ctx ln
False -> adjust_le (<>ln) <$> close_test_exe ctx te
where
ln = matchSource mtch
mtch = allMatches mtchs !! 0
test_exe_gen :: Bool
-> Bool
-> Ctx
-> LineNo
-> Matches LBS.ByteString
-> IO (LineEdit LBS.ByteString)
test_exe_gen is_t is_e ctx _ mtchs = do
mb <- readIORef (_ctx_test_exe ctx)
le <- maybe (return Delete) (close_test_exe ctx) mb
writeIORef (_ctx_test_exe ctx) $ Just $
TestExe
{ _te_test = is_t
, _te_exe = is_e
, _te_name = i
, _te_text = ""
}
return le
where
i = captureText [cp|i|] mtch
mtch = allMatches mtchs !! 0
close_test_exe :: Ctx -> TestExe -> IO (LineEdit LBS.ByteString)
close_test_exe ctx@Ctx{..} te = do
writeIORef _ctx_test_exe Nothing
put ctx $ mconcat $ concat $
[ [ mk_test_exe False te "Executable" | _te_exe te ]
, [ mk_test_exe True te "Test-Suite" | _te_test te ]
]
put :: Ctx -> LBS.ByteString -> IO (LineEdit LBS.ByteString)
put Ctx{..} lbs = do
mb <- readIORef _ctx_test_exe
case mb of
Nothing -> return $ ReplaceWith lbs
Just te -> do
writeIORef _ctx_test_exe $ Just te { _te_text = _te_text te <> lbs <> "\n" }
return Delete
mk_test_exe :: Bool -> TestExe -> LBS.ByteString -> LBS.ByteString
mk_test_exe is_t te te_lbs_kw = (<>_te_text te) $ LBS.unlines $ concat
[ [ LBS.pack $ printf "%s %s" (LBS.unpack te_lbs_kw) nm ]
, [ " type: exitcode-stdio-1.0" | is_t ]
]
where
nm = case is_t of
True -> LBS.unpack $ _te_name te <> "-test"
False -> LBS.unpack $ _te_name te
mk_build_depends :: Bool
-> Bool
-> Bool
-> Map.Map LBS.ByteString LBS.ByteString
-> [LBS.ByteString]
-> LBS.ByteString
mk_build_depends lb we fp mp pks0 = LBS.unlines $
[ " Default-Language: Haskell2010"
, ""
] ++ filter (if lb then const True else const False)
[ " Other-Extensions:"
, " AllowAmbiguousTypes"
, " CPP"
, " DeriveDataTypeable"
, " DeriveGeneric"
, " ExistentialQuantification"
, " FlexibleContexts"
, " FlexibleInstances"
, " FunctionalDependencies"
, " GeneralizedNewtypeDeriving"
, " MultiParamTypeClasses"
, " NoImplicitPrelude"
, " OverloadedStrings"
, " QuasiQuotes"
, " RecordWildCards"
, " ScopedTypeVariables"
, " TemplateHaskell"
, " TypeSynonymInstances"
, " UndecidableInstances"
, ""
, " if !impl(ghc >= 8.0)"
, " Other-Extensions: TemplateHaskell"
, " else"
, " Other-Extensions: TemplateHaskellQuotes"
, ""
] ++
[ " GHC-Options:"
, " -Wall"
, " -fwarn-tabs"
, " " <> w_error_or_warn
, ""
, " Build-depends:"
] ++ (map fmt $ zip (True : repeat False) $ L.sortBy comp pks)
where
w_error_or_warn = case we of
True -> "-Werror"
False -> "-Wwarn"
pks = case fp of
False -> pks0
True -> filter (/= "regex-with-pcre") pks0
fmt (isf,pk) = LBS.pack $
printf " %c %-20s %s"
(if isf then ' ' else ',')
(LBS.unpack pk)
(maybe "" LBS.unpack $ Map.lookup pk mp)
comp x y = case (x=="regex",y=="regex") of
(True ,True ) -> EQ
(True ,False) -> LT
(False,True ) -> GT
(False,False) -> case (x=="regex-with-pcre",y=="regex-with-pcre") of
(True ,True ) -> EQ
(True ,False) -> LT
(False,True ) -> GT
(False,False) -> compare x y
adjust_le :: (LBS.ByteString->LBS.ByteString)
-> LineEdit LBS.ByteString
-> LineEdit LBS.ByteString
adjust_le f le = case le of
NoEdit -> error "adjust_le: not enough context"
ReplaceWith lbs -> ReplaceWith $ f lbs
Delete -> ReplaceWith $ f ""
\end{code}
\begin{code}
sdist :: IO ()
sdist = do
sdist' "regex" "lib/README-regex.md"
sdist' "regex-with-pcre" "lib/README-regex.md"
sdist' "regex-examples" "lib/README-regex-examples.md"
establish "mega-regex" "regex"
vrn_t <- T.pack . presentVrn <$> readCurrentVersion
test_release vrn_t
smy_t <- summary
SH.shelly $ SH.verbosely $ do
SH.run_ "git" ["add","--all"]
SH.run_ "git" ["commit","-m",vrn_t<>": "<>smy_t]
SH.run_ "git" ["tag",vrn_t,"-m",smy_t]
sdist' :: T.Text -> SH.FilePath -> IO ()
sdist' nm readme = do
establish nm nm
SH.shelly $ SH.verbosely $ do
SH.cp readme "README.markdown"
SH.run_ "stack" ["sdist","--stack-yaml","stack-8.0.yaml"]
(pth,tb) <- analyse_so <$> SH.lastStderr
SH.cp (SH.fromText $ pth) $ SH.fromText $ "releases/"<>tb
where
analyse_so so = (mtch!$$[cp|pth|],mtch!$$[cp|tb|])
where
mtch = so T.?=~
[re|^.*Wrote sdist tarball to ${pth}(.*${tb}(regex-.*\.tar\.gz))$|]
establish :: T.Text -> T.Text -> IO ()
establish nm nm' = SH.shelly $ SH.verbosely $ do
SH.rm_f "mega-regex.cabal"
SH.rm_f "regex-with-pcre.cabal"
SH.rm_f "regex.cabal"
SH.rm_f "regex-examples.cabal"
SH.cp (SH.fromText sf) (SH.fromText df)
where
sf = "lib/"<>nm<>".cabal"
df = nm'<>".cabal"
summary :: IO T.Text
summary = do
vrn <- SH.liftIO readCurrentVersion
let vrn_res = concat
[ show $ _vrn_a vrn
, "\\."
, show $ _vrn_b vrn
, "\\."
, show $ _vrn_c vrn
, "\\."
, show $ _vrn_d vrn
]
rex <- compileRegex $ "- \\[[xX]\\] +@{%date} +v"++vrn_res++" +\\[?${smy}([^]]+)"
lns <- linesMatched LinesMatched <$> grepLines rex "lib/md/roadmap-incl.md"
case lns of
[Line _ (Matches _ [mtch])] -> return $ TE.decodeUtf8 $ LBS.toStrict $ mtch !$$ [cp|smy|]
_ -> error "failed to locate the summary text in the roadmap"
test_release :: T.Text -> IO ()
test_release vrn_t = do
setCurrentDirectory "releases/test"
SH.shelly $ SH.verbosely $ do
SH.rm_rf $ SH.fromText "test-regex"
SH.rm_rf $ SH.fromText "test-regex-with-pcre"
SH.rm_rf $ SH.fromText "test-regex-examples"
unpack "regex"
unpack "regex-with-pcre"
unpack "regex-examples"
SH.run_ "stack" ["install"]
setCurrentDirectory "../.."
where
unpack pn = do
SH.run_ "tar" ["xzf","../"<>pn_vrn<>".tar.gz"]
SH.mv (SH.fromText pn_vrn) (SH.fromText $ "test-"<>pn)
where
pn_vrn = pn<>"-"<>vrn_t
\end{code}
let vrn_res = concat [ show $ _vrn_a vrn, "\\.", show $ _vrn_b vrn, "\\.", show $ _vrn_c vrn, "\\.", show $ _vrn_d vrn ]