@@ -5,10 +5,11 @@ module Reporting
55 , terminal
66 --
77 , attempt
8− , exit
8+ , attemptWithStyle
99 --
1010 , Key
1111 , report
12+ , ask
1213 --
1314 , DKey
1415 , DMsg(..)
@@ -24,6 +25,7 @@ module Reporting
2425
2526
2627import Control.Concurrent
28+import Control.Exception (SomeException, AsyncException(UserInterrupt), catch, fromException, throw)
2729import Control.Monad (when)
2830import qualified Data.ByteString.Builder as B
2931import qualified Data.NonEmptyList as NE
@@ -64,25 +66,31 @@ terminal =
6466-- ATTEMPT
6567
6668
67−attempt :: Style -> IO (Either Help.Report a) -> IO a
68−attempt style work =
69− do result <- work
69+attempt :: (x -> Help.Report) -> IO (Either x a) -> IO a
70+attempt toReport work =
71+ do result <- work `catch` reportExceptionsNicely
7072 case result of
7173 Right a -> return a
72− Left ex -> exit style ex
74+ Left x ->
75+ do Exit.toStderr (toReport x)
76+ Exit.exitFailure
7377
7478
75−exit :: Style -> Help.Report -> IO a
76−exit style rep =
77− case style of
78− Json ->
79− do B.hPutBuilder stderr (Encode.encodeUgly (Exit.toJson rep))
80− Exit.exitFailure
79+attemptWithStyle :: Style -> (x -> Help.Report) -> IO (Either x a) -> IO a
80+attemptWithStyle style toReport work =
81+ do result <- work `catch` reportExceptionsNicely
82+ case result of
83+ Right a -> return a
84+ Left x ->
85+ case style of
86+ Json ->
87+ do B.hPutBuilder stderr (Encode.encodeUgly (Exit.toJson (toReport x)))
88+ Exit.exitFailure
8189
82− Terminal mvar ->
83− do readMVar mvar
84− Exit.toStderr rep
85− Exit.exitFailure
90+ Terminal mvar ->
91+ do readMVar mvar
92+ Exit.toStderr (toReport x)
93+ Exit.exitFailure
8694
8795
8896
@@ -122,6 +130,29 @@ report (Key send) msg =
122130
123131
124132
133+-- ASK
134+
135+
136+ask :: D.Doc -> IO Bool
137+ask doc =
138+ do Help.toStdout doc
139+ askHelp
140+
141+
142+askHelp :: IO Bool
143+askHelp =
144+ do hFlush stdout
145+ input <- getLine
146+ case input of
147+ "" -> return True
148+ "Y" -> return True
149+ "y" -> return True
150+ "n" -> return False
151+ _ ->
152+ do putStr "Must type 'y' for yes or 'n' for no: "
153+ askHelp
154+
155+
125156-- DETAILS
126157
127158
@@ -377,3 +408,40 @@ vbottom = if isWindows then '+' else '┘'
377408putStrFlush :: String -> IO ()
378409putStrFlush str =
379410 hPutStr stdout str >> hFlush stdout
411+
412+
413+
414+-- REPORT EXCEPTIONS NICELY
415+
416+
417+reportExceptionsNicely :: SomeException -> IO a
418+reportExceptionsNicely e =
419+ case fromException e of
420+ Just UserInterrupt -> throw e
421+ _ -> putException e >> throw e
422+
423+
424+putException :: SomeException -> IO ()
425+putException e =
426+ Help.toStderr $ D.stack $
427+ [ D.reflow $
428+ "Oh no! I ran into something that bypassed the normal error reporting process!\
429+ \ I extracted whatever information I could from the internal error:"
430+ , D.vcat $ map (\line -> D.red ">" <> " " <> D.fromChars line) (lines (show e))
431+ , D.reflow $
432+ "These errors are usually pretty confusing, so start by asking around on Slack\
433+ \ or Discourse to see if anyone can get you unstuck quickly."
434+ , "------------------------------------------------------------"
435+ , D.reflow $
436+ "From there, if you are feeling up to it, please try to get your code down to the\
437+ \ smallest version that still triggers this message. Ideally in a single Main.elm\
438+ \ and elm.json file."
439+ , D.reflow $
440+ "From there open a NEW issue at https://github.com/elm/compiler/issues with\
441+ \ your reduced example pasted in directly. (Not a link to a repo or gist!) Do not\
442+ \ worry about if someone else saw something similar. More examples is better!"
443+ , D.reflow $
444+ "This kind of error is usually tied up in larger architectural choices that are\
445+ \ hard to change, so even when we have a couple good examples, it can take some\
446+ \ time to resolve in a solid way."
447+ ]