git.iko.soy/elk
on 63fa090 help sign in
elk/builder/src/Reporting/Progress/Terminal.hs
363 lines 9.3 kB history raw
1{-# OPTIONS_GHC -Wall #-}
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 Text.PrettyPrint.ANSI.Leijen ((<>), (<+>))
15import qualified Text.PrettyPrint.ANSI.Leijen as P
16import qualified Elm.Package as Pkg
17import Elm.Package (Name, Version)
19import qualified Deps.Diff as Diff
20import qualified Reporting.Error2 as Error
21import qualified Reporting.Error.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 err) ->
60 Error.toStderr err
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 $ P.dullyellow (P.text "WARNING:") <+> P.text "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 -> P.Doc
199makeBullet name version outcome =
200 let
201 nm =
202 P.text (Pkg.toString name)
204 vsn =
205 P.text (Pkg.versionToString version)
207 bullet =
208 case outcome of
209 Good -> goodMark
210 Bad -> badMark
211 in
212 P.indent 2 $ bullet <+> nm <+> vsn <> P.text "\n"
215goodMark :: P.Doc
216goodMark =
217 P.green $ P.text $
218 if System.os == "mingw32" then "+" else "●"
221badMark :: P.Doc
222badMark =
223 P.red $ P.text $
224 if System.os == "mingw32" then "X" else "✗"
227waitingMark :: P.Doc
228waitingMark =
229 P.dullyellow $ P.text $
230 if System.os == "mingw32" then "-" else "→"
234-- OVERVIEW OF VERSIONING
237newPackageOverview :: String
238newPackageOverview =
239 unlines
240 [ "This package has never been published before. Here's how things work:"
241 , ""
242 , " - Versions all have exactly three parts: MAJOR.MINOR.PATCH"
243 , ""
244 , " - All packages start with initial version " ++ Pkg.versionToString Pkg.initialVersion
245 , ""
246 , " - Versions are incremented based on how the API changes:"
247 , ""
248 , " PATCH = the API is the same, no risk of breaking code"
249 , " MINOR = values have been added, existing values are unchanged"
250 , " MAJOR = existing values have been changed or removed"
251 , ""
252 , " - I will bump versions for you, automatically enforcing these rules"
253 , ""
254 ]
258-- CHECKLIST
261toChecklistDoc :: Maybe Outcome -> ChecklistMessages -> P.Doc
262toChecklistDoc status (ChecklistMessages waiting success failure) =
263 let
264 padded message =
265 message ++ replicate (length waiting - length message) ' '
266 in
267 case status of
268 Nothing ->
269 P.text " " <> waitingMark <+> P.text waiting
271 Just Good ->
272 P.text "\r " <> goodMark <+> P.text (padded success ++ "\n")
274 Just Bad ->
275 P.text "\r " <> badMark <+> P.text (padded failure ++ "\n\n")
278data ChecklistMessages =
279 ChecklistMessages
280 { _waiting :: String
281 , _success :: String
282 , _failure :: String
283 }
286toChecklistMessages :: PublishPhase -> ChecklistMessages
287toChecklistMessages phase =
288 case phase of
289 CheckReadme ->
290 ChecklistMessages
291 "Looking for README.md"
292 "Found README.md"
293 "Problem with your README.md"
295 CheckLicense ->
296 ChecklistMessages
297 "Looking for LICENSE"
298 "Found LICENSE"
299 "Problem with your LICENSE"
301 CheckTag version ->
302 ChecklistMessages
303 ("Is version " ++ Pkg.versionToString version ++ " tagged on GitHub?")
304 ("Version " ++ Pkg.versionToString version ++ " is tagged on GitHub")
305 ("Version " ++ Pkg.versionToString version ++ " is not tagged on GitHub!")
307 CheckDownload ->
308 ChecklistMessages
309 "Downloading code from GitHub..."
310 "Code downloaded successfully from GitHub"
311 "Could not download code from GitHub!"
313 CheckBuild ->
314 ChecklistMessages
315 "Building downloaded code and generated docs..."
316 "Downloaded code compiles successfully / docs generated\n"
317 "Cannot compile downloaded code!"
319 CheckChanges ->
320 ChecklistMessages
321 "Checking for uncommitted changes..."
322 "No uncommitted changes in local code"
323 "Your local code is different than the code tagged on GitHub"
327-- BUMP PHASE
330bumpPhaseToChecklistDoc :: Pkg.Version -> BumpPhase -> P.Doc
331bumpPhaseToChecklistDoc version bumpPhase =
332 let
333 mkMsgs success =
334 ChecklistMessages
335 ("Checking semantic versioning rules. Is " ++ Pkg.versionToString version ++ " correct?")
336 success
337 ("Version " ++ Pkg.versionToString version ++ " is not correct!")
338 in
340 case bumpPhase of
341 StatedVersion ->
342 toChecklistDoc Nothing $ mkMsgs ""
344 GoodStart ->
345 toChecklistDoc (Just Good) $ mkMsgs $
346 "All packages start at version " ++ Pkg.versionToString Pkg.initialVersion
348 GoodBump old magnitude ->
349 toChecklistDoc (Just Good) $ mkMsgs $
350 toCheckVersionSuccessMessage old version magnitude
352 BadBump ->
353 toChecklistDoc (Just Bad) $ mkMsgs ""
356toCheckVersionSuccessMessage :: Pkg.Version -> Pkg.Version -> Diff.Magnitude -> String
357toCheckVersionSuccessMessage oldVersion newVersion magnitude =
358 let
359 old = Pkg.versionToString oldVersion
360 new = Pkg.versionToString newVersion
361 mag = Diff.magnitudeToString magnitude
362 in
363 "Version number " ++ new ++ " verified (" ++ mag ++ " change, " ++ old ++ " => " ++ new ++ ")"