on efe80bc help sign in
104 lines 2.0 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Exit.Compile
4 ( Exit(..)
5 , toJson
6 , toDoc
7 )
8 where
11import qualified Data.List as List
12import qualified Data.Time.Clock as Time
14import qualified Elm.Compiler as Compiler
15import qualified Elm.ModuleName as ModuleName
16import qualified Json.Encode as Encode
17import qualified Reporting.Doc as D
21-- EXITS
24data Exit =
25 Exit
26 { _name :: ModuleName.Raw
27 , _path :: FilePath
28 , _time :: Time.UTCTime
29 , _source :: String
30 , _errors :: [Compiler.Error]
31 }
35-- TO JSON
38toJson :: Exit -> Encode.Value
39toJson (Exit name path _ source errors) =
40 Compiler.errorsToJson name path source errors
44-- TO DOC
47toDoc :: Exit -> [Exit] -> D.Doc
48toDoc e es =
49 let
50 (exit, exits) = sortByTime e es
51 in
52 D.vcat (toDocHelp exit exits)
55toDocHelp :: Exit -> [Exit] -> [D.Doc]
56toDocHelp e1 exits =
57 case exits of
58 [] ->
59 [exitToDoc e1]
61 e2 : otherErrors ->
62 exitToDoc e1 : separator (_name e1) (_name e2) : toDocHelp e2 otherErrors
65exitToDoc :: Exit -> D.Doc
66exitToDoc (Exit _name path _time source errors) =
67 Compiler.errorsToDoc path source errors
70separator :: ModuleName.Raw -> ModuleName.Raw -> D.Doc
71separator beforeName afterName =
72 let
73 before = ModuleName.nameToChars beforeName ++ " ↑ "
74 after = " ↓ " ++ ModuleName.nameToChars afterName
75 in
76 D.dullred $ D.vcat $
77 [ D.indent (80 - length before) (D.fromChars before)
78 , "====o======================================================================o===="
79 , D.fromChars after
80 , D.empty
81 , D.empty
82 ]
86-- SORT BY TIME
89sortByTime :: Exit -> [Exit] -> (Exit, [Exit])
90sortByTime exit exits =
91 case List.sortBy timeCompare exits of
92 [] ->
93 (exit, [])
95 e:es ->
96 if _time exit < _time e then
97 (exit, e:es)
98 else
99 (e, List.insertBy timeCompare exit es)
102timeCompare :: Exit -> Exit -> Ordering
103timeCompare e1 e2 =
104 compare (_time e1) (_time e2)