git.iko.soy/elk
on master help sign in
move the publish logic into terminal/ and do many updates
commitf2a84a78423623c20c834081482cb2fb756eb101 authorEvan Czaplicki <evancz@users.noreply.github.com> dateTue 4 Jun 2019, 15:51 (7 years ago) parent56aea22
2 files changed+453−263
compare with master
unifiedsplit
builder/src/Elm/Publish.hs−255 terminal/src/Publish.hs+453−8
builder/src/Elm/Publish.hsdeleted−255
@@ -1,255 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−module Elm.Publish (publish) where
3−
4−
5−import Control.Monad (when)
6−import Control.Monad.Except (catchError, runExceptT)
7−import Control.Monad.Trans (liftIO, lift)
8−import qualified Data.List as List
9−import qualified Data.Utf8 as Utf8
10−import qualified System.Directory as Dir
11−import qualified System.Exit as Exit
12−import System.FilePath ((</>))
13−import qualified System.IO as IO
14−import qualified System.Process as Process
15−
16−import qualified Deps.Cache as Cache
17−import qualified Deps.Diff as Diff
18−import qualified Deps.Website as Website
19−import qualified Elm.Bump as Bump
20−import qualified Elm.Docs as Docs
21−import qualified Elm.Package as Pkg
22−import qualified Elm.Project.Json as Project
23−import qualified Elm.Project.Summary as Summary
24−import qualified Elm.Version as V
25−import qualified Reporting.Exit as Exit
26−import qualified Reporting.Exit.Publish as E
27−import qualified Reporting.Progress as Progress
28−import qualified Reporting.Task as Task
29−import qualified Stuff.Paths as Path
30−
31−
32−
33−-- PUBLISH
34−
35−
36−publish :: Summary.Summary -> Task.Task ()
37−publish summary@(Summary.Summary root project _ _ _) =
38− case project of
39− Project.App _ ->
40− throw E.Application
41−
42− Project.Pkg (Project.PkgInfo name smry _ version exposed _ _ _) ->
43− do
44− registry <- Cache.mandatoryUpdate
45− let maybePublishedVersions = either (const Nothing) Just (Cache.getVersions name registry)
46−
47− Task.report (Progress.PublishStart name version maybePublishedVersions)
48−
49− when (noExposed exposed) $ throw E.NoExposed
50− when (badSummary smry) $ throw E.NoSummary
51−
52− verifyReadme root
53− verifyLicense root
54− docs <- Task.silently (error "TODO Project.generateDocs summary" summary)
55− verifyVersion name version docs maybePublishedVersions
56− commitHash <- verifyTag name version
57− verifyNoChanges commitHash version
58− zipHash <- verifyZip name version
59−
60− Website.register name version commitHash zipHash
61−
62− Task.report Progress.PublishEnd
63−
64−
65−throw :: E.Exit -> Task.Task a
66−throw exit =
67− Task.throw (Exit.Publish exit)
68−
69−
70−
71−-- VERIFY SUMMARY
72−
73−
74−badSummary :: Utf8.String -> Bool
75−badSummary summary =
76− Utf8.isEmpty summary || Project.defaultSummary == summary
77−
78−
79−noExposed :: Project.Exposed -> Bool
80−noExposed exposed =
81− case exposed of
82− Project.ExposedList modules ->
83− null modules
84−
85− Project.ExposedDict chunks ->
86− all (null . snd) chunks
87−
88−
89−
90−-- VERIFY README
91−
92−
93−verifyReadme :: FilePath -> Task.Task ()
94−verifyReadme root =
95− phase Progress.CheckReadme $
96− do let readmePath = root </> "README.md"
97− exists <- liftIO $ Dir.doesFileExist readmePath
98− case exists of
99− False ->
100− throw E.NoReadme
101−
102− True ->
103− do size <- liftIO $ IO.withFile readmePath IO.ReadMode IO.hFileSize
104− if size < 300
105− then throw E.ShortReadme
106− else return ()
107−
108−
109−
110−-- VERIFY LICENSE
111−
112−
113−verifyLicense :: FilePath -> Task.Task ()
114−verifyLicense root =
115− phase Progress.CheckLicense $
116− do let licensePath = root </> "LICENSE"
117− exists <- liftIO $ Dir.doesFileExist licensePath
118− if exists
119− then return ()
120− else throw E.NoLicense
121−
122−
123−
124−-- VERIFY GITHUB TAG
125−
126−
127−verifyTag :: Pkg.Name -> V.Version -> Task.Task String
128−verifyTag name version =
129− phase (Progress.CheckTag version) $
130− Website.githubCommit name version `catchError` \_ ->
131− throw (E.MissingTag version)
132−
133−
134−
135−-- VERIFY NO LOCAL CHANGES SINCE TAG
136−
137−
138−verifyNoChanges :: String -> V.Version -> Task.Task ()
139−verifyNoChanges commitHash version =
140− phase Progress.CheckChanges $
141− do maybeGit <- liftIO $ Dir.findExecutable "git"
142− case maybeGit of
143− Nothing ->
144− throw E.NoGit
145−
146− Just git ->
147− do -- https://stackoverflow.com/questions/3878624/how-do-i-programmatically-determine-if-there-are-uncommited-changes
148− exitCode <- liftIO $
149− Process.rawSystem git [ "diff-index", "--quiet", commitHash, "--" ]
150−
151− case exitCode of
152− Exit.ExitSuccess ->
153− return ()
154−
155− Exit.ExitFailure _ ->
156− throw (E.LocalChanges version)
157−
158−
159−
160−-- VERIFY THAT ZIP BUILDS / COMPUTE HASH
161−
162−
163−verifyZip :: Pkg.Name -> V.Version -> Task.Task Website.Sha
164−verifyZip name version =
165− withTempDir $ \dir ->
166− do hash <- phase Progress.CheckDownload $
167− Website.githubDownload name version dir
168−
169− phase Progress.CheckBuild $
170− do runner <- Task.getSilentRunner
171− result <- liftIO $ Dir.withCurrentDirectory dir $ runner $
172− Task.silently $ error "TODO Project.generateDocs =<< Project.getRoot"
173− either Task.throw (\_ -> return ()) result
174−
175− return hash
176−
177−
178−withTempDir :: (FilePath -> Task.Task a) -> Task.Task a
179−withTempDir callback =
180− do liftIO $ Dir.createDirectoryIfMissing True Path.prepublishDir
181− result <- lift $ runExceptT $ callback Path.prepublishDir
182− liftIO $ Dir.removeDirectoryRecursive Path.prepublishDir
183− either Task.throw return result
184−
185−
186−
187−-- PHASE REPORTING
188−
189−
190−phase :: Progress.PublishPhase -> Task.Task a -> Task.Task a
191−phase publishPhase task =
192− do Task.report $ Progress.PublishProgress publishPhase Nothing
193−
194− result <- task `catchError` \exit ->
195− do Task.report $ Progress.PublishProgress publishPhase (Just Progress.Bad)
196− Task.throw exit
197−
198− Task.report $ Progress.PublishProgress publishPhase (Just Progress.Good)
199−
200− return result
201−
202−
203−
204−-- VERIFY VERSION
205−
206−
207−verifyVersion :: Pkg.Name -> V.Version -> Docs.Documentation -> Maybe [V.Version] -> Task.Task ()
208−verifyVersion name version docs maybePublishedVersions =
209− let
210− reportBumpPhase bumpPhase =
211− Task.report $ Progress.PublishCheckBump version bumpPhase
212− in
213− do reportBumpPhase Progress.StatedVersion
214− case maybePublishedVersions of
215− Nothing ->
216− if version == V.one then
217− reportBumpPhase Progress.GoodStart
218− else
219− throw (E.NotInitialVersion version)
220−
221− Just publishedVersions ->
222− if elem version publishedVersions then
223− throw $ E.AlreadyPublished version
224− else
225− do (old, magnitude) <- verifyBump name version docs publishedVersions
226− reportBumpPhase (Progress.GoodBump old magnitude)
227−
228− `catchError` \exit ->
229− do reportBumpPhase Progress.BadBump
230− Task.throw exit
231−
232−
233−verifyBump :: Pkg.Name -> V.Version -> Docs.Documentation -> [V.Version] -> Task.Task (V.Version, Diff.Magnitude)
234−verifyBump name statedVersion newDocs publishedVersions =
235− let
236− possibleBumps =
237− Bump.toPossibleBumps publishedVersions
238−
239− isTheBump (_ ,new, _) =
240− statedVersion == new
241− in
242− case List.find isTheBump possibleBumps of
243− Nothing ->
244− throw $ E.InvalidBump statedVersion (last publishedVersions)
245−
246− Just (old, new, magnitude) ->
247− do oldDocs <- Cache.getDocs name old
248− let changes = Diff.diff oldDocs newDocs
249− let realNew = Diff.bump changes old
250− if new == realNew
251− then
252− return (old, magnitude)
253− else
254− throw $ E.BadBump old new magnitude realNew $
255− Diff.toMagnitude changes
terminal/src/Publish.hs+453−8
@@ -1,19 +1,464 @@
1−module Publish (run) where
1+{-# LANGUAGE OverloadedStrings #-}
2+module Publish
3+ ( run
4+ )
5+ where
26
37
4−import qualified Elm.Project as Project
5−import qualified Elm.Publish as Publish
8+import Control.Exception (bracket_)
9+import Control.Monad (void)
10+import qualified Data.List as List
11+import qualified Data.Utf8 as Utf8
12+import qualified System.Directory as Dir
13+import qualified System.Exit as Exit
14+import qualified System.FilePath as FP
15+import System.FilePath ((</>))
16+import qualified System.Info as Info
17+import qualified System.IO as IO
18+import qualified System.Process as Process
19+
20+import qualified Deps.Bump as Bump
21+import qualified Deps.Diff as Diff
22+import qualified Deps.Registry as Registry
23+import qualified Deps.Website as Website
24+import qualified Elm.Docs as Docs
25+import qualified Elm.Magnitude as M
26+import qualified Elm.Outline as Outline
27+import qualified Elm.Package as Pkg
28+import qualified Elm.Version as V
29+import qualified File
30+import qualified Http
31+import qualified Json.Decode as D
32+import qualified Json.String as Json
33+import qualified Reporting
34+import Reporting.Doc ((<+>))
35+import qualified Reporting.Doc as D
36+import qualified Reporting.Exit as Exit
37+import qualified Reporting.Exit.Help as Help
638import qualified Reporting.Task as Task
7−import qualified Reporting.Progress.Terminal as Terminal
39+import qualified Stuff
840
941
1042
1143-- RUN
1244
1345
46+-- TODO mandate no "exposing (..)" in packages to make
47+-- optimization to skip builds in Elm.Details always valid
48+
49+
1450run :: () -> () -> IO ()
1551run () () =
16− do reporter <- Terminal.create
17− Task.run reporter $
18− do summary <- Project.getRoot
19− Publish.publish summary
52+ Reporting.attempt Exit.publishToReport $
53+ Task.run $ publish =<< getEnv
54+
55+
56+
57+-- ENV
58+
59+
60+data Env =
61+ Env
62+ { _root :: FilePath
63+ , _cache :: Stuff.PackageCache
64+ , _manager :: Http.Manager
65+ , _registry :: Registry.Registry
66+ , _outline :: Outline.Outline
67+ }
68+
69+
70+getEnv :: Task.Task Exit.Publish Env
71+getEnv =
72+ do maybeRoot <- Task.io $ Stuff.findRoot
73+ case maybeRoot of
74+ Nothing ->
75+ Task.throw Exit.PublishNoOutline
76+
77+ Just root ->
78+ do cache <- Task.io $ Stuff.getPackageCache
79+ manager <- Task.io $ Http.getManager
80+ registry <- Task.eio Exit.PublishMustHaveLatestRegistry $ Registry.latest manager cache
81+ outlineResult <- Task.io $ Outline.read root
82+ case outlineResult of
83+ Right outline ->
84+ return $ Env root cache manager registry outline
85+
86+ Left problem ->
87+ Task.throw $ Exit.PublishBadOutline problem
88+
89+
90+
91+-- PUBLISH
92+
93+
94+publish :: Env -> Task.Task Exit.Publish ()
95+publish env@(Env root cache manager registry outline) =
96+ case outline of
97+ Outline.App _ ->
98+ Task.throw Exit.PublishApplication
99+
100+ Outline.Pkg (Outline.PkgOutline pkg summary _ vsn exposed _ _ _) ->
101+ do let maybeKnownVersions = Registry.getVersions pkg registry
102+
103+ reportPublishStart pkg vsn maybeKnownVersions
104+
105+ if noExposed exposed then Task.throw Exit.PublishNoExposed else return ()
106+ if badSummary summary then Task.throw Exit.PublishNoSummary else return ()
107+
108+ verifyReadme root
109+ verifyLicense root
110+ docs <- error "TODO Project.generateDocs details" details
111+ verifyVersion env pkg vsn docs maybeKnownVersions
112+ commitHash <- verifyTag manager pkg vsn
113+ verifyNoChanges commitHash vsn
114+ zipHash <- verifyZip manager pkg vsn
115+
116+ register manager pkg vsn commitHash zipHash
117+
118+ putStrLn "Success!"
119+
120+
121+
122+-- VERIFY SUMMARY
123+
124+
125+badSummary :: Json.String -> Bool
126+badSummary summary =
127+ Json.isEmpty summary || Outline.defaultSummary == summary
128+
129+
130+noExposed :: Outline.Exposed -> Bool
131+noExposed exposed =
132+ case exposed of
133+ Outline.ExposedList modules ->
134+ null modules
135+
136+ Outline.ExposedDict chunks ->
137+ all (null . snd) chunks
138+
139+
140+
141+-- VERIFY README
142+
143+
144+verifyReadme :: FilePath -> Task.Task Exit.Publish ()
145+verifyReadme root =
146+ reportReadmePhase $
147+ do let readmePath = root </> "README.md"
148+ exists <- File.exists readmePath
149+ case exists of
150+ False ->
151+ return (Left Exit.PublishNoReadme)
152+
153+ True ->
154+ do size <- IO.withFile readmePath IO.ReadMode IO.hFileSize
155+ if size < 300
156+ then return (Left Exit.PublishShortReadme)
157+ else return (Right ())
158+
159+
160+
161+-- VERIFY LICENSE
162+
163+
164+verifyLicense :: FilePath -> Task.Task Exit.Publish ()
165+verifyLicense root =
166+ reportLicensePhase $
167+ do let licensePath = root </> "LICENSE"
168+ exists <- File.exists licensePath
169+ if exists
170+ then return (Right ())
171+ else return (Left Exit.PublishNoLicense)
172+
173+
174+
175+-- VERIFY GITHUB TAG
176+
177+
178+verifyTag :: Http.Manager -> Pkg.Name -> V.Version -> Task.Task Exit.Publish String
179+verifyTag manager pkg vsn =
180+ reportTagPhase vsn $
181+ Http.post manager (toTagUrl pkg vsn) [Http.accept "application/json"] Exit.PublishCannotGetTag $ \body ->
182+ case D.fromByteString commitHashDecoder body of
183+ Right hash ->
184+ return $ Right hash
185+
186+ Left _ ->
187+ return $ Left (Exit.PublishMissingTag vsn)
188+
189+
190+toTagUrl :: Pkg.Name -> V.Version -> String
191+toTagUrl pkg vsn =
192+ "https://api.github.com/repos/" ++ Pkg.toUrl pkg ++ "/git/refs/tags/" ++ V.toChars vsn
193+
194+
195+commitHashDecoder :: D.Decoder e String
196+commitHashDecoder =
197+ Utf8.toChars <$>
198+ D.field "object" (D.field "sha" D.string)
199+
200+
201+
202+-- VERIFY NO LOCAL CHANGES SINCE TAG
203+
204+
205+verifyNoChanges :: String -> V.Version -> Task.Task Exit.Publish ()
206+verifyNoChanges commitHash vsn =
207+ reportChangesPhase $
208+ do maybeGit <- Dir.findExecutable "git"
209+ case maybeGit of
210+ Nothing ->
211+ return $ Left Exit.PublishNoGit
212+
213+ Just git ->
214+ do -- https://stackoverflow.com/questions/3878624/how-do-i-programmatically-determine-if-there-are-uncommited-changes
215+ exitCode <- Process.rawSystem git [ "diff-index", "--quiet", commitHash, "--" ]
216+ case exitCode of
217+ Exit.ExitSuccess -> return $ Right ()
218+ Exit.ExitFailure _ -> return $ Left (Exit.PublishLocalChanges vsn)
219+
220+
221+
222+-- VERIFY THAT ZIP BUILDS / COMPUTE HASH
223+
224+
225+verifyZip :: Http.Manager -> Pkg.Name -> V.Version -> Task.Task Exit.Publish Http.Sha
226+verifyZip manager pkg vsn =
227+ withTempDir $ \prepublishDir ->
228+ do (sha, archive) <-
229+ reportDownloadPhase $
230+ Http.getArchive manager (toZipUrl pkg vsn)
231+ Exit.PublishCannotGetZip
232+ Exit.PublishCannotDecodeZip
233+ (return . Right)
234+
235+ Task.io $ File.writePackage prepublishDir archive
236+
237+ reportBuildPhase $
238+ Dir.withCurrentDirectory prepublishDir $
239+ do error "TODO Build.generateDocs"
240+ return ()
241+
242+ return sha
243+
244+
245+withTempDir :: FilePath -> (FilePath -> IO a) -> IO a
246+withTempDir root callback =
247+ let
248+ dir = Stuff.prepublishDir root
249+ in
250+ bracket_
251+ (Dir.createDirectoryIfMissing True dir)
252+ (Dir.removeDirectoryRecursive dir)
253+ (callback dir)
254+
255+
256+toZipUrl :: Pkg.Name -> V.Version -> String
257+toZipUrl pkg vsn =
258+ "https://github.com/" ++ Pkg.toUrl pkg ++ "/zipball/" ++ V.toChars vsn ++ "/"
259+
260+
261+
262+-- VERIFY VERSION
263+
264+
265+data GoodVersion
266+ = GoodStart
267+ | GoodBump V.Version M.Magnitude
268+
269+
270+verifyVersion :: Env -> Pkg.Name -> V.Version -> Docs.Documentation -> Maybe Registry.KnownVersions -> Task.Task Exit.Publish ()
271+verifyVersion env pkg vsn newDocs publishedVersions =
272+ reportVersionPhase vsn $
273+ case publishedVersions of
274+ Nothing ->
275+ if vsn == V.one
276+ then return $ Right GoodStart
277+ else return $ Left $ Exit.PublishNotInitialVersion vsn
278+
279+ Just knownVersions@(Registry.KnownVersions latest previous) ->
280+ if vsn == latest || elem vsn previous
281+ then return $ Left $ Exit.PublishAlreadyPublished vsn
282+ else verifyBump env pkg vsn newDocs knownVersions
283+
284+
285+verifyBump :: Env -> Pkg.Name -> V.Version -> Docs.Documentation -> Registry.KnownVersions -> IO (Either Exit.Publish GoodVersion)
286+verifyBump (Env _ cache manager _ _) pkg vsn newDocs knownVersions@(Registry.KnownVersions latest _) =
287+ case List.find (\(_ ,new, _) -> vsn == new) (Bump.getPossibilities knownVersions) of
288+ Nothing ->
289+ return $ Left $
290+ Exit.PublishInvalidBump vsn latest
291+
292+ Just (old, new, magnitude) ->
293+ do result <- Diff.getDocs cache manager pkg old
294+ case result of
295+ Left dp ->
296+ return $ Left $ Exit.PublishCannotGetDocs dp
297+
298+ Right oldDocs ->
299+ let
300+ changes = Diff.diff oldDocs newDocs
301+ realNew = Diff.bump changes old
302+ in
303+ if new == realNew
304+ then return $ Right $ GoodBump old magnitude
305+ else
306+ return $ Left $
307+ Exit.PublishBadBump old new magnitude realNew (Diff.toMagnitude changes)
308+
309+
310+
311+-- REGISTER PACKAGES
312+
313+
314+register :: Http.Manager -> Pkg.Name -> V.Version -> String -> Http.Sha -> Task.Task Exit.Publish ()
315+register manager pkg vsn commitHash sha =
316+ let
317+ url =
318+ Website.route "/register"
319+ [ ("name", Pkg.toChars pkg)
320+ , ("version", V.toChars vsn)
321+ , ("commit-hash", commitHash)
322+ ]
323+ in
324+ Task.eio Exit.PublishCannotRegister $
325+ Http.upload manager url
326+ [ Http.filePart "elm.json" "elm.json"
327+ , Http.filePart "docs.json" (error "TODO generate docs, maybe in memory only?")
328+ , Http.filePart "README.md" "README.md"
329+ , Http.stringPart "github-hash" (Http.shaToChars sha)
330+ ]
331+
332+
333+
334+-- REPORTING
335+
336+
337+reportPublishStart :: Pkg.Name -> V.Version -> Maybe Registry.KnownVersions -> IO ()
338+reportPublishStart pkg vsn maybeKnownVersions =
339+ case maybeKnownVersions of
340+ Nothing ->
341+ putStrLn $ Exit.newPackageOverview ++ "\nI will now verify that everything is in order...\n"
342+
343+ Just _ ->
344+ putStrLn $ "Verifying" ++ Pkg.toChars pkg ++ V.toChars vsn ++ "...\n"
345+
346+
347+
348+-- REPORTING PHASES
349+
350+
351+reportReadmePhase :: IO (Either x a) -> Task.Task x a
352+reportReadmePhase =
353+ reportPhase
354+ "Looking for README.md"
355+ "Found README.md"
356+ "Problem with your README.md"
357+
358+
359+reportLicensePhase :: IO (Either x a) -> Task.Task x a
360+reportLicensePhase =
361+ reportPhase
362+ "Looking for LICENSE"
363+ "Found LICENSE"
364+ "Problem with your LICENSE"
365+
366+
367+reportVersionPhase :: V.Version -> IO (Either x GoodVersion) -> Task.Task x ()
368+reportVersionPhase version work =
369+ let
370+ vsn = V.toChars version
371+
372+ waiting = "Checking semantic versioning rules. Is " ++ vsn ++ " correct?"
373+ failure = "Version " ++ vsn ++ " is not correct!"
374+ success result =
375+ case result of
376+ GoodStart ->
377+ "All packages start at version " ++ V.toChars V.one
378+
379+ GoodBump oldVersion magnitude ->
380+ "Version number " ++ vsn ++ " verified ("
381+ ++ M.toChars magnitude ++ " change, "
382+ ++ V.toChars oldVersion ++ " => " ++ vsn ++ ")"
383+ in
384+ void $ reportCustomPhase waiting success failure work
385+
386+
387+reportTagPhase :: V.Version -> IO (Either x a) -> Task.Task x a
388+reportTagPhase vsn =
389+ reportPhase
390+ ("Is version " ++ V.toChars vsn ++ " tagged on GitHub?")
391+ ("Version " ++ V.toChars vsn ++ " is tagged on GitHub")
392+ ("Version " ++ V.toChars vsn ++ " is not tagged on GitHub!")
393+
394+
395+reportDownloadPhase :: IO (Either x a) -> Task.Task x a
396+reportDownloadPhase =
397+ reportPhase
398+ "Downloading code from GitHub..."
399+ "Code downloaded successfully from GitHub"
400+ "Could not download code from GitHub!"
401+
402+
403+reportBuildPhase :: IO (Either x a) -> Task.Task x a
404+reportBuildPhase =
405+ reportPhase
406+ "Building downloaded code and generated docs..."
407+ "Downloaded code compiles successfully / docs generated\n"
408+ "Cannot compile downloaded code!"
409+
410+
411+reportChangesPhase :: IO (Either x a) -> Task.Task x a
412+reportChangesPhase =
413+ reportPhase
414+ "Checking for uncommitted changes..."
415+ "No uncommitted changes in local code"
416+ "Your local code is different than the code tagged on GitHub"
417+
418+
419+reportPhase :: String -> String -> String -> IO (Either x a) -> Task.Task x a
420+reportPhase waiting success failure work =
421+ reportCustomPhase waiting (\_ -> success) failure work
422+
423+
424+reportCustomPhase :: String -> (a -> String) -> String -> IO (Either x a) -> Task.Task x a
425+reportCustomPhase waiting success failure work =
426+ let
427+ putFlush doc =
428+ Help.toStdout doc >> IO.hFlush IO.stdout
429+
430+ padded message =
431+ message ++ replicate (length waiting - length message) ' '
432+ in
433+ Task.eio id $
434+ do putFlush $ " " <> waitingMark <+> D.fromChars waiting
435+ result <- work
436+ putFlush $
437+ case result of
438+ Right a -> "\r " <> goodMark <+> D.fromChars (padded (success a) ++ "\n")
439+ Left _ -> "\r " <> badMark <+> D.fromChars (padded failure ++ "\n\n")
440+
441+ return result
442+
443+
444+-- MARKS
445+
446+
447+goodMark :: D.Doc
448+goodMark =
449+ D.green $ if isWindows then "+" else "●"
450+
451+
452+badMark :: D.Doc
453+badMark =
454+ D.red $ if isWindows then "X" else "✗"
455+
456+
457+waitingMark :: D.Doc
458+waitingMark =
459+ D.dullyellow $ if isWindows then "-" else "→"
460+
461+
462+isWindows :: Bool
463+isWindows =
464+ Info.os == "mingw32"