git.iko.soy/elk
on 8a0fb69 help sign in
elk/builder/src/Reporting/Progress/Terminal.hs
360 lines 9.2 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2module Reporting.Progress.Terminal
3 ( create
4 , newPackageOverview
5 )
6 where
9import Control.Concurrent (forkIO)
10import Control.Concurrent.Chan (Chan, newChan, readChan)
11import Control.Concurrent.MVar (newEmptyMVar, putMVar)
12import qualified System.Info as System
13import System.IO (hFlush, hPutStr, stdout)
14import qualified Elm.Package as Pkg
15import Elm.Package (Name, Version)
17import qualified Deps.Diff as Diff
18import Reporting.Doc ((<>), (<+>))
19import qualified Reporting.Doc as D
20import qualified Reporting.Exit as Exit
21import qualified Reporting.Exit.Help as Help
22import Reporting.Progress (Msg(..), Progress(..), Outcome(..), PublishPhase(..), BumpPhase(..))
23import qualified Reporting.Progress as Progress
24import qualified Reporting.Progress.Bar as Bar
28-- CREATE
31create :: IO Progress.Reporter
32create =
33 do chan <- newChan
34 mvar <- newEmptyMVar
35 _ <- forkIO (loop chan (State 0 0 0) >>= putMVar mvar)
36 return (Progress.makeReporter chan mvar)
40-- STATE
43data State =
44 State
45 { _total :: !Int
46 , _good :: !Int
47 , _bad :: !Int
48 }
52-- LOOP
55loop :: Chan Msg -> State -> IO ()
56loop chan state =
57 do msg <- readChan chan
58 case msg of
59 End (Just exit) ->
60 Exit.toStderr exit
62 End Nothing ->
63 return ()
65 Progress progress ->
66 loopHelp chan progress state
69loopHelp :: Chan Msg -> Progress -> State -> IO ()
70loopHelp chan progress state@(State total good bad) =
71 case progress of
74 -- DOWNLOADS
76 DownloadSkip ->
77 do putStrLn "Dependencies loaded from local cache."
78 loop chan state
80 DownloadStart [] ->
81 loop chan state
83 DownloadStart _ ->
84 do putStrLn "Starting downloads...\n"
85 loop chan state
87 DownloadPkgStart _name _version ->
88 loop chan state
90 DownloadPkgEnd name version outcome ->
91 do Help.toStdout (makeBullet name version outcome)
92 loop chan state
94 DownloadEnd Bad ->
95 do putStrLn ""
96 loop chan state
98 DownloadEnd Good ->
99 do putStrLn ""
100 loop chan state
103 -- BUILD DEPS
105 BuildDepsStart size ->
106 do hPutStr stdout "Verifying dependencies..."
107 hFlush stdout
108 loop chan (State size 0 0)
110 BuildDepsProgress ->
111 do let n = good + 1
112 let msg = "\rBuilding dependencies (" ++ show n ++ "/" ++ show total ++ ")"
113 hPutStr stdout msg
114 hFlush stdout
115 loop chan (State total n 0)
117 BuildDepsEnd ->
118 do putStrLn "\rDependencies ready! "
119 loop chan (State 0 0 0)
122 -- COMPILE
124 CompileStart size ->
125 loop chan (State size 0 0)
127 CompileFileStart _ ->
128 loop chan state
130 CompileFileEnd _ Good ->
131 do hPutStr stdout $ Bar.render (good + 1) bad total
132 hFlush stdout
133 loop chan (State total (good + 1) bad)
135 CompileFileEnd _ Bad ->
136 do hPutStr stdout $ Bar.render good (bad + 1) total
137 hFlush stdout
138 loop chan (State total good (bad + 1))
140 CompileEnd ->
141 let
142 message =
143 case (bad, total) of
144 (0, 0) -> "Success!"
145 (0, 1) -> "Success! Compiled 1 module."
146 (0, n) -> "Success! Compiled " ++ show n ++ " modules."
147 (1, _) -> "Detected errors in 1 module."
148 (n, _) -> "Detected errors in " ++ show n ++ " modules."
149 in
150 do hPutStr stdout $ Bar.clear
151 putStrLn message
152 loop chan (State 0 0 0)
155 -- PUBLISH
157 PublishStart name version maybePublishedVersions ->
158 case maybePublishedVersions of
159 Nothing ->
160 do putStrLn newPackageOverview
161 putStrLn "I will now verify that everything is in order..."
162 putStrLn ""
163 loop chan state
165 Just _ ->
166 do putStrLn $ unwords [ "Verifying", Pkg.toString name, Pkg.versionToString version, "..." ]
167 putStrLn ""
168 loop chan state
170 PublishCheckBump version bumpPhase ->
171 do Help.toStdout $ bumpPhaseToChecklistDoc version bumpPhase
172 hFlush stdout
173 loop chan state
175 PublishProgress phase status ->
176 do Help.toStdout $ toChecklistDoc status (toChecklistMessages phase)
177 hFlush stdout
178 loop chan state
180 PublishEnd ->
181 do putStrLn "Success!"
182 loop chan state
185 -- SOLVER
187 UnableToLoadLatestPackages ->
188 do putStrLn ""
189 Help.toStdout $ D.dullyellow "WARNING:" <+> "I normally check <https://package.elm-lang.org> for new packages\n"
190 putStrLn "here, but my request failed. Are you offline? I will try to continue anyway.\n"
191 loop chan state
195-- BULLETS
198makeBullet :: Name -> Version -> Outcome -> D.Doc
199makeBullet name version outcome =
200 let
201 nm = D.fromText (Pkg.toText name)
202 vsn = D.fromText (Pkg.versionToText version)
204 bullet =
205 case outcome of
206 Good -> goodMark
207 Bad -> badMark
208 in
209 D.indent 2 $ bullet <+> nm <+> vsn <> "\n"
212goodMark :: D.Doc
213goodMark =
214 D.green $
215 if System.os == "mingw32" then "+" else "●"
218badMark :: D.Doc
219badMark =
220 D.red $
221 if System.os == "mingw32" then "X" else "✗"
224waitingMark :: D.Doc
225waitingMark =
226 D.dullyellow $
227 if System.os == "mingw32" then "-" else "→"
231-- OVERVIEW OF VERSIONING
234newPackageOverview :: String
235newPackageOverview =
236 unlines
237 [ "This package has never been published before. Here's how things work:"
238 , ""
239 , " - Versions all have exactly three parts: MAJOR.MINOR.PATCH"
240 , ""
241 , " - All packages start with initial version " ++ Pkg.versionToString Pkg.initialVersion
242 , ""
243 , " - Versions are incremented based on how the API changes:"
244 , ""
245 , " PATCH = the API is the same, no risk of breaking code"
246 , " MINOR = values have been added, existing values are unchanged"
247 , " MAJOR = existing values have been changed or removed"
248 , ""
249 , " - I will bump versions for you, automatically enforcing these rules"
250 , ""
251 ]
255-- CHECKLIST
258toChecklistDoc :: Maybe Outcome -> ChecklistMessages -> D.Doc
259toChecklistDoc status (ChecklistMessages waiting success failure) =
260 let
261 padded message =
262 message ++ replicate (length waiting - length message) ' '
263 in
264 case status of
265 Nothing ->
266 " " <> waitingMark <+> D.fromString waiting
268 Just Good ->
269 "\r " <> goodMark <+> D.fromString (padded success ++ "\n")
271 Just Bad ->
272 "\r " <> badMark <+> D.fromString (padded failure ++ "\n\n")
275data ChecklistMessages =
276 ChecklistMessages
277 { _waiting :: String
278 , _success :: String
279 , _failure :: String
280 }
283toChecklistMessages :: PublishPhase -> ChecklistMessages
284toChecklistMessages phase =
285 case phase of
286 CheckReadme ->
287 ChecklistMessages
288 "Looking for README.md"
289 "Found README.md"
290 "Problem with your README.md"
292 CheckLicense ->
293 ChecklistMessages
294 "Looking for LICENSE"
295 "Found LICENSE"
296 "Problem with your LICENSE"
298 CheckTag version ->
299 ChecklistMessages
300 ("Is version " ++ Pkg.versionToString version ++ " tagged on GitHub?")
301 ("Version " ++ Pkg.versionToString version ++ " is tagged on GitHub")
302 ("Version " ++ Pkg.versionToString version ++ " is not tagged on GitHub!")
304 CheckDownload ->
305 ChecklistMessages
306 "Downloading code from GitHub..."
307 "Code downloaded successfully from GitHub"
308 "Could not download code from GitHub!"
310 CheckBuild ->
311 ChecklistMessages
312 "Building downloaded code and generated docs..."
313 "Downloaded code compiles successfully / docs generated\n"
314 "Cannot compile downloaded code!"
316 CheckChanges ->
317 ChecklistMessages
318 "Checking for uncommitted changes..."
319 "No uncommitted changes in local code"
320 "Your local code is different than the code tagged on GitHub"
324-- BUMP PHASE
327bumpPhaseToChecklistDoc :: Pkg.Version -> BumpPhase -> D.Doc
328bumpPhaseToChecklistDoc version bumpPhase =
329 let
330 mkMsgs success =
331 ChecklistMessages
332 ("Checking semantic versioning rules. Is " ++ Pkg.versionToString version ++ " correct?")
333 success
334 ("Version " ++ Pkg.versionToString version ++ " is not correct!")
335 in
337 case bumpPhase of
338 StatedVersion ->
339 toChecklistDoc Nothing $ mkMsgs ""
341 GoodStart ->
342 toChecklistDoc (Just Good) $ mkMsgs $
343 "All packages start at version " ++ Pkg.versionToString Pkg.initialVersion
345 GoodBump old magnitude ->
346 toChecklistDoc (Just Good) $ mkMsgs $
347 toCheckVersionSuccessMessage old version magnitude
349 BadBump ->
350 toChecklistDoc (Just Bad) $ mkMsgs ""
353toCheckVersionSuccessMessage :: Pkg.Version -> Pkg.Version -> Diff.Magnitude -> String
354toCheckVersionSuccessMessage oldVersion newVersion magnitude =
355 let
356 old = Pkg.versionToString oldVersion
357 new = Pkg.versionToString newVersion
358 mag = Diff.magnitudeToString magnitude
359 in
360 "Version number " ++ new ++ " verified (" ++ mag ++ " change, " ++ old ++ " => " ++ new ++ ")"