git.iko.soy/elk
on 6a96e21 help sign in
elk/builder/src/Reporting/Progress/Terminal.hs
362 lines 9.3 kB history raw
1module Reporting.Progress.Terminal
2 ( create
3 , newPackageOverview
4 )
5 where
8import Control.Concurrent (forkIO)
9import Control.Concurrent.Chan (Chan, newChan, readChan)
10import Control.Concurrent.MVar (newEmptyMVar, putMVar)
11import qualified System.Info as System
12import System.IO (hFlush, hPutStr, stdout)
13import Text.PrettyPrint.ANSI.Leijen ((<>), (<+>))
14import qualified Text.PrettyPrint.ANSI.Leijen as P
15import qualified Elm.Package as Pkg
16import Elm.Package (Name, Version)
18import qualified Deps.Diff as Diff
19import qualified Reporting.Exit as Exit
20import qualified Reporting.Exit.Help as Help
21import Reporting.Progress (Msg(..), Progress(..), Outcome(..), PublishPhase(..), BumpPhase(..))
22import qualified Reporting.Progress as Progress
23import qualified Reporting.Progress.Bar as Bar
27-- CREATE
30create :: IO Progress.Reporter
31create =
32 do chan <- newChan
33 mvar <- newEmptyMVar
34 _ <- forkIO (loop chan (State 0 0 0) >>= putMVar mvar)
35 return (Progress.makeReporter chan mvar)
39-- STATE
42data State =
43 State
44 { _total :: !Int
45 , _good :: !Int
46 , _bad :: !Int
47 }
51-- LOOP
54loop :: Chan Msg -> State -> IO ()
55loop chan state =
56 do msg <- readChan chan
57 case msg of
58 End (Just exit) ->
59 Exit.toStderr exit
61 End Nothing ->
62 return ()
64 Progress progress ->
65 loopHelp chan progress state
68loopHelp :: Chan Msg -> Progress -> State -> IO ()
69loopHelp chan progress state@(State total good bad) =
70 case progress of
73 -- DOWNLOADS
75 DownloadSkip ->
76 do putStrLn "Dependencies loaded from local cache."
77 loop chan state
79 DownloadStart [] ->
80 loop chan state
82 DownloadStart _ ->
83 do putStrLn "Starting downloads...\n"
84 loop chan state
86 DownloadPkgStart _name _version ->
87 loop chan state
89 DownloadPkgEnd name version outcome ->
90 do Help.toStdout (makeBullet name version outcome)
91 loop chan state
93 DownloadEnd Bad ->
94 do putStrLn ""
95 loop chan state
97 DownloadEnd Good ->
98 do putStrLn ""
99 loop chan state
102 -- BUILD DEPS
104 BuildDepsStart size ->
105 do hPutStr stdout "Verifying dependencies..."
106 hFlush stdout
107 loop chan (State size 0 0)
109 BuildDepsProgress ->
110 do let n = good + 1
111 let msg = "\rBuilding dependencies (" ++ show n ++ "/" ++ show total ++ ")"
112 hPutStr stdout msg
113 hFlush stdout
114 loop chan (State total n 0)
116 BuildDepsEnd ->
117 do putStrLn "\rDependencies ready! "
118 loop chan (State 0 0 0)
121 -- COMPILE
123 CompileStart size ->
124 loop chan (State size 0 0)
126 CompileFileStart _ ->
127 loop chan state
129 CompileFileEnd _ Good ->
130 do hPutStr stdout $ Bar.render (good + 1) bad total
131 hFlush stdout
132 loop chan (State total (good + 1) bad)
134 CompileFileEnd _ Bad ->
135 do hPutStr stdout $ Bar.render good (bad + 1) total
136 hFlush stdout
137 loop chan (State total good (bad + 1))
139 CompileEnd ->
140 let
141 message =
142 case (bad, total) of
143 (0, 0) -> "Success!"
144 (0, 1) -> "Success! Compiled 1 module."
145 (0, n) -> "Success! Compiled " ++ show n ++ " modules."
146 (1, _) -> "Detected errors in 1 module."
147 (n, _) -> "Detected errors in " ++ show n ++ " modules."
148 in
149 do hPutStr stdout $ Bar.clear
150 putStrLn message
151 loop chan (State 0 0 0)
154 -- PUBLISH
156 PublishStart name version maybePublishedVersions ->
157 case maybePublishedVersions of
158 Nothing ->
159 do putStrLn newPackageOverview
160 putStrLn "I will now verify that everything is in order..."
161 putStrLn ""
162 loop chan state
164 Just _ ->
165 do putStrLn $ unwords [ "Verifying", Pkg.toString name, Pkg.versionToString version, "..." ]
166 putStrLn ""
167 loop chan state
169 PublishCheckBump version bumpPhase ->
170 do Help.toStdout $ bumpPhaseToChecklistDoc version bumpPhase
171 hFlush stdout
172 loop chan state
174 PublishProgress phase status ->
175 do Help.toStdout $ toChecklistDoc status (toChecklistMessages phase)
176 hFlush stdout
177 loop chan state
179 PublishEnd ->
180 do putStrLn "Success!"
181 loop chan state
184 -- SOLVER
186 UnableToLoadLatestPackages ->
187 do putStrLn ""
188 Help.toStdout $ P.dullyellow (P.text "WARNING:") <+> P.text "I normally check <https://package.elm-lang.org> for new packages\n"
189 putStrLn "here, but my request failed. Are you offline? I will try to continue anyway.\n"
190 loop chan state
194-- BULLETS
197makeBullet :: Name -> Version -> Outcome -> P.Doc
198makeBullet name version outcome =
199 let
200 nm =
201 P.text (Pkg.toString name)
203 vsn =
204 P.text (Pkg.versionToString version)
206 bullet =
207 case outcome of
208 Good -> goodMark
209 Bad -> badMark
210 in
211 P.indent 2 $ bullet <+> nm <+> vsn <> P.text "\n"
214goodMark :: P.Doc
215goodMark =
216 P.green $ P.text $
217 if System.os == "mingw32" then "+" else "●"
220badMark :: P.Doc
221badMark =
222 P.red $ P.text $
223 if System.os == "mingw32" then "X" else "✗"
226waitingMark :: P.Doc
227waitingMark =
228 P.dullyellow $ P.text $
229 if System.os == "mingw32" then "-" else "→"
233-- OVERVIEW OF VERSIONING
236newPackageOverview :: String
237newPackageOverview =
238 unlines
239 [ "This package has never been published before. Here's how things work:"
240 , ""
241 , " - Versions all have exactly three parts: MAJOR.MINOR.PATCH"
242 , ""
243 , " - All packages start with initial version " ++ Pkg.versionToString Pkg.initialVersion
244 , ""
245 , " - Versions are incremented based on how the API changes:"
246 , ""
247 , " PATCH = the API is the same, no risk of breaking code"
248 , " MINOR = values have been added, existing values are unchanged"
249 , " MAJOR = existing values have been changed or removed"
250 , ""
251 , " - I will bump versions for you, automatically enforcing these rules"
252 , ""
253 ]
257-- CHECKLIST
260toChecklistDoc :: Maybe Outcome -> ChecklistMessages -> P.Doc
261toChecklistDoc status (ChecklistMessages waiting success failure) =
262 let
263 padded message =
264 message ++ replicate (length waiting - length message) ' '
265 in
266 case status of
267 Nothing ->
268 P.text " " <> waitingMark <+> P.text waiting
270 Just Good ->
271 P.text "\r " <> goodMark <+> P.text (padded success ++ "\n")
273 Just Bad ->
274 P.text "\r " <> badMark <+> P.text (padded failure ++ "\n\n")
277data ChecklistMessages =
278 ChecklistMessages
279 { _waiting :: String
280 , _success :: String
281 , _failure :: String
282 }
285toChecklistMessages :: PublishPhase -> ChecklistMessages
286toChecklistMessages phase =
287 case phase of
288 CheckReadme ->
289 ChecklistMessages
290 "Looking for README.md"
291 "Found README.md"
292 "Problem with your README.md"
294 CheckLicense ->
295 ChecklistMessages
296 "Looking for LICENSE"
297 "Found LICENSE"
298 "Problem with your LICENSE"
300 CheckTag version ->
301 ChecklistMessages
302 ("Is version " ++ Pkg.versionToString version ++ " tagged on GitHub?")
303 ("Version " ++ Pkg.versionToString version ++ " is tagged on GitHub")
304 ("Version " ++ Pkg.versionToString version ++ " is not tagged on GitHub!")
306 CheckDownload ->
307 ChecklistMessages
308 "Downloading code from GitHub..."
309 "Code downloaded successfully from GitHub"
310 "Could not download code from GitHub!"
312 CheckBuild ->
313 ChecklistMessages
314 "Building downloaded code and generated docs..."
315 "Downloaded code compiles successfully / docs generated\n"
316 "Cannot compile downloaded code!"
318 CheckChanges ->
319 ChecklistMessages
320 "Checking for uncommitted changes..."
321 "No uncommitted changes in local code"
322 "Your local code is different than the code tagged on GitHub"
326-- BUMP PHASE
329bumpPhaseToChecklistDoc :: Pkg.Version -> BumpPhase -> P.Doc
330bumpPhaseToChecklistDoc version bumpPhase =
331 let
332 mkMsgs success =
333 ChecklistMessages
334 ("Checking semantic versioning rules. Is " ++ Pkg.versionToString version ++ " correct?")
335 success
336 ("Version " ++ Pkg.versionToString version ++ " is not correct!")
337 in
339 case bumpPhase of
340 StatedVersion ->
341 toChecklistDoc Nothing $ mkMsgs ""
343 GoodStart ->
344 toChecklistDoc (Just Good) $ mkMsgs $
345 "All packages start at version " ++ Pkg.versionToString Pkg.initialVersion
347 GoodBump old magnitude ->
348 toChecklistDoc (Just Good) $ mkMsgs $
349 toCheckVersionSuccessMessage old version magnitude
351 BadBump ->
352 toChecklistDoc (Just Bad) $ mkMsgs ""
355toCheckVersionSuccessMessage :: Pkg.Version -> Pkg.Version -> Diff.Magnitude -> String
356toCheckVersionSuccessMessage oldVersion newVersion magnitude =
357 let
358 old = Pkg.versionToString oldVersion
359 new = Pkg.versionToString newVersion
360 mag = Diff.magnitudeToString magnitude
361 in
362 "Version number " ++ new ++ " verified (" ++ mag ++ " change, " ++ old ++ " => " ++ new ++ ")"