a36152c · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Switch everything over to going through Reporting.Doc

a36152cEvan Czaplicki9 years ago

builder/src/Deps/Get.hs+5−5

compare with master

unifiedsplit

@@ -21,7 +21,6 @@ import Data.Map (Map)

21import qualified Data.Text as Text

22import qualified System.Directory as Dir

23import System.FilePath ((</>))

24−import qualified Text.PrettyPrint.ANSI.Leijen as P

26import qualified Elm.Docs as Docs

25import qualified Elm.Docs as Docs

27import qualified Elm.Package as Pkg

26import qualified Elm.Package as Pkg

@@ -29,12 +28,13 @@ import qualified Elm.Package as Pkg

29import qualified Deps.Website as Website

28import qualified Deps.Website as Website

30import qualified Elm.Project.Json as Project

29import qualified Elm.Project.Json as Project

31import qualified File.IO as IO

30import qualified File.IO as IO

32−import qualified Reporting.Suggest as Suggest

31+import qualified Json.Decode as Decode

32+import qualified Reporting.Doc as D

33import qualified Reporting.Exit as Exit

34import qualified Reporting.Exit.Assets as E

35import qualified Reporting.Progress as Progress

36+import qualified Reporting.Suggest as Suggest

36import qualified Reporting.Task as Task

37import qualified Reporting.Task as Task

37−import qualified Json.Decode as Decode

@@ -189,13 +189,13 @@ docs name version =

189 Task.throw $ Exit.Assets $ E.CorruptDocumentation name version

190

191

192−errorToDocs :: Docs.Error -> [P.Doc]

192+errorToDocs :: Docs.Error -> [D.Doc]

193errorToDocs err =

194 let

195 details =

196 case err of

197 Docs.BadAssociativity txt ->

198− ["Binary","operators","cannot","have",P.red (P.text (show txt)),"as","their","associativity."]

198+ ["Binary","operators","cannot","have",D.red (D.fromString (show txt)),"as","their","associativity."]

199

200 Docs.BadName ->

201 ["It","is","not","a","valid","module","name."]

builder/src/Deps/Website.hs+3−2

@@ -13,6 +13,7 @@ module Deps.Website

13 )

14 where

16+

16import Prelude hiding (zip)

17import Prelude hiding (zip)

17import qualified Codec.Archive.Zip as Zip

18import qualified Codec.Archive.Zip as Zip

18import Control.Monad (void)

19import Control.Monad (void)

@@ -29,12 +30,12 @@ import qualified Network.HTTP.Client.MultipartFormData as Multi

29import qualified Network.HTTP.Types as Http

30import qualified Network.HTTP.Types as Http

30import qualified System.Directory as Dir

31import qualified System.Directory as Dir

31import System.FilePath ((</>), splitFileName)

32import System.FilePath ((</>), splitFileName)

32−import qualified Text.PrettyPrint.ANSI.Leijen as P

34import Elm.Package (Name, Version)

35import qualified Elm.Package as Pkg

36import qualified Json.Decode as D

38+import qualified Reporting.Doc as D

38import qualified Reporting.Exit.Http as E

39import qualified Reporting.Exit.Http as E

39import qualified Reporting.Progress as Progress

40import qualified Reporting.Progress as Progress

40import qualified Reporting.Task as Task

41import qualified Reporting.Task as Task

@@ -128,7 +129,7 @@ fetchByteString path =

128 return $ Right $ LBS.toStrict $ Client.responseBody response

129 return $ Right $ LBS.toStrict $ Client.responseBody response

129

130

131

131−fetchJson :: String -> (e -> [P.Doc]) -> D.Decoder e a -> String -> Http.Fetch a

132+fetchJson :: String -> (e -> [D.Doc]) -> D.Decoder e a -> String -> Http.Fetch a

132fetchJson rootName errorToDocs decoder path =

133fetchJson rootName errorToDocs decoder path =

133 Http.package path [] $ \request manager ->

134 Http.package path [] $ \request manager ->

134 do response <- Client.httpLbs request manager

135 do response <- Client.httpLbs request manager

builder/src/Elm/Bump.hs+9−9

@@ -8,8 +8,6 @@ module Elm.Bump

9import Control.Monad.Trans (liftIO)

10import qualified Data.List as List

11−import Text.PrettyPrint.ANSI.Leijen ((<>), (<+>))

12−import qualified Text.PrettyPrint.ANSI.Leijen as P

14import qualified Deps.Diff as Diff

12import qualified Deps.Diff as Diff

15import qualified Deps.Get as Get

13import qualified Deps.Get as Get

@@ -17,6 +15,8 @@ import qualified Elm.Package as Pkg

17import qualified Elm.Project as Project

15import qualified Elm.Project as Project

18import qualified Elm.Project.Json as Project

16import qualified Elm.Project.Json as Project

19import qualified Elm.Project.Summary as Summary

17import qualified Elm.Project.Summary as Summary

18+import Reporting.Doc ((<>), (<+>))

19+import qualified Reporting.Doc as D

20import qualified Reporting.Exit as Exit

21import qualified Reporting.Exit.Bump as E

22import qualified Reporting.Exit.Help as Help

@@ -92,7 +92,7 @@ checkNewPackage root info@(Project.PkgInfo _ _ _ version _ _ _ _) =

92 changeVersion root info Pkg.initialVersion $

93 "It looks like the version in elm.json has been changed though!\n\

94 \Would you like me to change it back to "

95− <> P.text (Pkg.versionToString Pkg.initialVersion) <> "? [Y/n] "

95+ <> D.fromText (Pkg.versionToText Pkg.initialVersion) <> "? [Y/n] "

@@ -107,11 +107,11 @@ suggestVersion summary@(Summary.Summary root _ _ _ _) info@(Project.PkgInfo name

107 let newVersion = Diff.bump changes version

108 changeVersion root info newVersion $

109 let

110− old = P.text $ Pkg.versionToString version

110+ old = D.fromText $ Pkg.versionToText version

111− new = P.text $ Pkg.versionToString newVersion

111+ new = D.fromText $ Pkg.versionToText newVersion

112− mag = P.text $ Diff.magnitudeToString (Diff.toMagnitude changes)

112+ mag = D.fromString $ Diff.magnitudeToString (Diff.toMagnitude changes)

113 in

114− "Based on your new API, this should be a" <+> P.green mag <+> "change (" <> old <> " => " <> new <> ")\n"

114+ "Based on your new API, this should be a" <+> D.green mag <+> "change (" <> old <> " => " <> new <> ")\n"

115 <> "Bail out of this command and run 'elm diff' for a full explanation.\n"

116 <> "\n"

117 <> "Should I perform the update (" <> old <> " => " <> new <> ") in elm.json? [Y/n] "

@@ -121,7 +121,7 @@ suggestVersion summary@(Summary.Summary root _ _ _ _) info@(Project.PkgInfo name

121-- CHANGE VERSION

122

123

124−changeVersion :: FilePath -> Project.PkgInfo -> Pkg.Version -> P.Doc -> Task.Task ()

124+changeVersion :: FilePath -> Project.PkgInfo -> Pkg.Version -> D.Doc -> Task.Task ()

125changeVersion root info targetVersion explanation =

126 do liftIO $ Help.toStdout explanation

127 approved <- Task.getApproval

@@ -135,5 +135,5 @@ changeVersion root info targetVersion explanation =

135

136 liftIO $ Help.toStdout $

137 "Version changed to "

138− <> P.green (P.text (Pkg.versionToString targetVersion))

138+ <> D.green (D.fromText (Pkg.versionToText targetVersion))

139 <> "!\n"

builder/src/Elm/Diff.hs+35−40

@@ -11,8 +11,6 @@ import Control.Monad.Except (liftIO)

11import qualified Data.List as List

12import qualified Data.Map as Map

13import qualified Data.Maybe as Maybe

14−import Text.PrettyPrint.ANSI.Leijen ((<>), (<+>))

15−import qualified Text.PrettyPrint.ANSI.Leijen as P

17import Deps.Diff (PackageChanges(..), ModuleChanges(..), Changes(..), Magnitude(..))

15import Deps.Diff (PackageChanges(..), ModuleChanges(..), Changes(..), Magnitude(..))

18import qualified Deps.Diff as Diff

16import qualified Deps.Diff as Diff

@@ -25,6 +23,8 @@ import qualified Elm.Package as Pkg

25import qualified Elm.Project as Project

23import qualified Elm.Project as Project

26import qualified Elm.Project.Json as Project

24import qualified Elm.Project.Json as Project

27import qualified Elm.Project.Summary as Summary

25import qualified Elm.Project.Summary as Summary

26+import Reporting.Doc ((<>), (<+>))

27+import qualified Reporting.Doc as D

28import qualified Reporting.Exit as Exit

29import qualified Reporting.Exit.Diff as E

30import qualified Reporting.Exit.Help as Help

@@ -109,7 +109,7 @@ getPackageInfo =

109-- WRITE DOC

110

111

112−writeDoc :: P.Doc -> Task.Task ()

112+writeDoc :: D.Doc -> Task.Task ()

113writeDoc doc =

114 liftIO $ Help.toStdout (doc <> "\n")

115

@@ -118,57 +118,57 @@ writeDoc doc =

118-- TO DOC

119

120

121−toDoc :: PackageChanges -> P.Doc

121+toDoc :: PackageChanges -> D.Doc

122toDoc changes@(PackageChanges added changed removed) =

123 if null added && Map.null changed && null removed then

124− "No API changes detected, so this is a" <+> P.green "PATCH" <+> "change."

124+ "No API changes detected, so this is a" <+> D.green "PATCH" <+> "change."

125 else

126 let

127 magDoc =

128− P.text (Diff.magnitudeToString (Diff.toMagnitude changes))

128+ D.fromString (Diff.magnitudeToString (Diff.toMagnitude changes))

129

130 header =

131− "This is a" <+> P.green magDoc <+> "change."

131+ "This is a" <+> D.green magDoc <+> "change."

132

133 addedChunk =

134 if null added then [] else

135 [ Chunk "ADDED MODULES" MINOR $

136− P.vcat $ map (P.text . Module.nameToString) added

136+ D.vcat $ map (D.fromString . Module.nameToString) added

137 ]

138

139 removedChunk =

140 if null removed then [] else

141 [ Chunk "REMOVED MODULES" MAJOR $

142− P.vcat $ map (P.text . Module.nameToString) removed

142+ D.vcat $ map (D.fromString . Module.nameToString) removed

143 ]

144

145 chunks =

146 addedChunk ++ removedChunk ++ map changesToChunk (Map.toList changed)

147 in

148− P.vcat (header : "" : map chunkToDoc chunks)

148+ D.vcat (header : "" : map chunkToDoc chunks)

149

150

151data Chunk =

152 Chunk

153 { _title :: String

154 , _magnitude :: Magnitude

155− , _details :: P.Doc

155+ , _details :: D.Doc

156 }

157

158

159−chunkToDoc :: Chunk -> P.Doc

159+chunkToDoc :: Chunk -> D.Doc

160chunkToDoc (Chunk title magnitude details) =

161 let

162 magDoc =

163 Diff.magnitudeToString magnitude

164

165 header =

166− "----" <+> P.text title <+> "-" <+> P.text magDoc <+> "----"

166+ "----" <+> D.fromString title <+> "-" <+> D.fromString magDoc <+> "----"

167 in

168− P.vcat

168+ D.vcat

169− [ P.dullcyan header

169+ [ D.dullcyan header

170 , ""

171− , P.indent 4 details

171+ , D.indent 4 details

172 , ""

173 , ""

174 ]

@@ -193,21 +193,21 @@ changesToChunk (name, changes@(ModuleChanges unions aliases values binops)) =

193 changesToDocTriple binopToDoc binops

194 in

195 Chunk (N.toString name) magnitude $

196− P.vcat $ List.intersperse "" $ Maybe.catMaybes $

196+ D.vcat $ List.intersperse "" $ Maybe.catMaybes $

197 [ changesToDoc "Added" unionAdd aliasAdd valueAdd binopAdd

198 , changesToDoc "Removed" unionRemove aliasRemove valueRemove binopRemove

199 , changesToDoc "Changed" unionChange aliasChange valueChange binopChange

200 ]

201

202

203−changesToDocTriple :: (k -> v -> P.Doc) -> Changes k v -> ([P.Doc], [P.Doc], [P.Doc])

203+changesToDocTriple :: (k -> v -> D.Doc) -> Changes k v -> ([D.Doc], [D.Doc], [D.Doc])

204changesToDocTriple entryToDoc (Changes added changed removed) =

205 let

206 indented (name, value) =

207− P.indent 4 (entryToDoc name value)

207+ D.indent 4 (entryToDoc name value)

208

209 diffed (name, (oldValue, newValue)) =

210− P.vcat

210+ D.vcat

211 [ " - " <> entryToDoc name oldValue

212 , " + " <> entryToDoc name newValue

213 , ""

@@ -219,48 +219,48 @@ changesToDocTriple entryToDoc (Changes added changed removed) =

219 )

220

221

222−changesToDoc :: String -> [P.Doc] -> [P.Doc] -> [P.Doc] -> [P.Doc] -> Maybe P.Doc

222+changesToDoc :: String -> [D.Doc] -> [D.Doc] -> [D.Doc] -> [D.Doc] -> Maybe D.Doc

223changesToDoc categoryName unions aliases values binops =

224 if null unions && null aliases && null values && null binops then

225 Nothing

226

227 else

228− Just $ P.vcat $

228+ Just $ D.vcat $

229− P.text categoryName <> ":" : unions ++ aliases ++ binops ++ values

229+ D.fromString categoryName <> ":" : unions ++ aliases ++ binops ++ values

230

231

232−unionToDoc :: N.Name -> Docs.Union -> P.Doc

232+unionToDoc :: N.Name -> Docs.Union -> D.Doc

233unionToDoc name (Docs.Union _ tvars ctors) =

234 let

235 setup =

236− "type" <+> nameToDoc name <+> P.hsep (map nameToDoc tvars)

236+ "type" <+> D.fromName name <+> D.hsep (map D.fromName tvars)

237

238 ctorDoc (ctor, tipes) =

239 typeDoc (Type.Type ctor tipes)

240 in

241− P.hang 4 (P.sep (setup : zipWith (<+>) ("=" : repeat "|") (map ctorDoc ctors)))

241+ D.hang 4 (D.sep (setup : zipWith (<+>) ("=" : repeat "|") (map ctorDoc ctors)))

242

243

244−aliasToDoc :: N.Name -> Docs.Alias -> P.Doc

244+aliasToDoc :: N.Name -> Docs.Alias -> D.Doc

245aliasToDoc name (Docs.Alias _ tvars tipe) =

246 let

247 declaration =

248− "type" <+> "alias" <+> P.hsep (map nameToDoc (name:tvars)) <+> "="

248+ "type" <+> "alias" <+> D.hsep (map D.fromName (name:tvars)) <+> "="

249 in

250− P.hang 4 (P.sep [ declaration, typeDoc tipe ])

250+ D.hang 4 (D.sep [ declaration, typeDoc tipe ])

251

252

253−valueToDoc :: N.Name -> Docs.Value -> P.Doc

253+valueToDoc :: N.Name -> Docs.Value -> D.Doc

254valueToDoc name (Docs.Value _ tipe) =

255− P.hang 4 $ P.sep [ nameToDoc name <+> P.colon, typeDoc tipe ]

255+ D.hang 4 $ D.sep [ D.fromName name <+> ":", typeDoc tipe ]

256

257

258−binopToDoc :: N.Name -> Docs.Binop -> P.Doc

258+binopToDoc :: N.Name -> Docs.Binop -> D.Doc

259binopToDoc name (Docs.Binop _ tipe associativity (Docs.Precedence n)) =

260− "(" <> nameToDoc name <> ")" <+> P.colon <+> typeDoc tipe <> P.black details

260+ "(" <> D.fromName name <> ")" <+> ":" <+> typeDoc tipe <> D.black details

261 where

262 details =

263− " (" <> nameToDoc assoc <> "/" <> P.int n <> ")"

263+ " (" <> D.fromName assoc <> "/" <> D.fromInt n <> ")"

264

265 assoc =

266 case associativity of

@@ -269,11 +269,6 @@ binopToDoc name (Docs.Binop _ tipe associativity (Docs.Precedence n)) =

269 Docs.Right -> "right"

270

271

272−typeDoc :: Type.Type -> P.Doc

272+typeDoc :: Type.Type -> D.Doc

273typeDoc tipe =

274 Type.toDoc Type.None tipe

275−

276−

277−nameToDoc :: N.Name -> P.Doc

278−nameToDoc name =

279− P.text (N.toString name)

builder/src/Elm/Install.hs+24−26

@@ -1,3 +1,4 @@

1+{-# LANGUAGE OverloadedStrings #-}

1module Elm.Install

2module Elm.Install

2 ( install

3 ( install

3 )

4 )

@@ -9,9 +10,7 @@ import Control.Monad.Except (catchError, lift, liftIO)

9import Data.Map (Map, (!))

10import Data.Map (Map, (!))

10import qualified Data.Map as Map

11import qualified Data.Map as Map

11import qualified Data.Map.Merge.Lazy as Map

12import qualified Data.Map.Merge.Lazy as Map

12−import qualified System.IO as IO

13+import System.IO (stdout)

13−import Text.PrettyPrint.ANSI.Leijen ((<>), (<+>))

14−import qualified Text.PrettyPrint.ANSI.Leijen as P

16import qualified Elm.Package as Pkg

15import qualified Elm.Package as Pkg

17import Elm.Package (Name, Version)

16import Elm.Package (Name, Version)

@@ -24,6 +23,8 @@ import Elm.Project.Constraint (Constraint)

24import qualified Elm.Project.Constraint as Con

23import qualified Elm.Project.Constraint as Con

25import qualified Elm.Project.Json as Project

24import qualified Elm.Project.Json as Project

26import qualified Elm.Project.Root as Root

25import qualified Elm.Project.Root as Root

26+import Reporting.Doc ((<>), (<+>))

27+import qualified Reporting.Doc as D

27import qualified Reporting.Exit as Exit

28import qualified Reporting.Exit as Exit

28import qualified Reporting.Task as Task

29import qualified Reporting.Task as Task

@@ -226,9 +227,6 @@ withApproval toString changes attemptInstall =

226

227

227 changeDocs =

228 changeDocs =

228 Map.foldrWithKey (addChange toString widths) (Docs [] [] []) changes

229 Map.foldrWithKey (addChange toString widths) (Docs [] [] []) changes

229−

230− printDoc doc =

231− P.displayIO IO.stdout $ P.renderPretty 1 80 doc

232 in

230 in

233 case changeDocs of

231 case changeDocs of

234 Docs [] [] [] ->

232 Docs [] [] [] ->

@@ -236,13 +234,13 @@ withApproval toString changes attemptInstall =

236

234

237 Docs inserts [] [] ->

235 Docs inserts [] [] ->

238 do liftIO $ putStrLn "Adding the following dependencies:\n"

236 do liftIO $ putStrLn "Adding the following dependencies:\n"

239− liftIO $ printDoc $ P.indent 2 (P.vcat (reverse inserts))

237+ liftIO $ D.toAnsi stdout $ D.indent 2 (D.vcat (reverse inserts))

240 liftIO $ putStrLn "\n"

238 liftIO $ putStrLn "\n"

241 attemptInstall

239 attemptInstall

242

240

243 Docs _ _ _ ->

241 Docs _ _ _ ->

244 do liftIO $ putStrLn "Here is my plan:"

242 do liftIO $ putStrLn "Here is my plan:"

245− liftIO $ printDoc $ viewChangeDocs changeDocs

243+ liftIO $ D.toAnsi stdout $ viewChangeDocs changeDocs

246 liftIO $ putStrLn "\nDo you approve? [Y/n]: "

244 liftIO $ putStrLn "\nDo you approve? [Y/n]: "

247 Task.withApproval attemptInstall

245 Task.withApproval attemptInstall

248

246

@@ -253,29 +251,29 @@ withApproval toString changes attemptInstall =

253

251

254data ChangeDocs =

252data ChangeDocs =

255 Docs

253 Docs

256− { _doc_inserts :: [P.Doc]

254+ { _doc_inserts :: [D.Doc]

257− , _doc_changes :: [P.Doc]

255+ , _doc_changes :: [D.Doc]

258− , _doc_removes :: [P.Doc]

256+ , _doc_removes :: [D.Doc]

259 }

257 }

260

258

261

259

262−viewChangeDocs :: ChangeDocs -> P.Doc

260+viewChangeDocs :: ChangeDocs -> D.Doc

263viewChangeDocs (Docs inserts changes removes) =

261viewChangeDocs (Docs inserts changes removes) =

264− P.indent 2 $ P.vcat $ concat $

262+ D.indent 2 $ D.vcat $ concat $

265 [ viewNonZero "Add:" inserts

263 [ viewNonZero "Add:" inserts

266 , viewNonZero "Change:" changes

264 , viewNonZero "Change:" changes

267 , viewNonZero "Remove:" removes

265 , viewNonZero "Remove:" removes

268 ]

266 ]

269

267

270

268

271−viewNonZero :: String -> [P.Doc] -> [P.Doc]

269+viewNonZero :: String -> [D.Doc] -> [D.Doc]

272viewNonZero title entries =

270viewNonZero title entries =

273 if null entries then

271 if null entries then

274 []

272 []

275 else

273 else

276− [ P.text ""

274+ [ ""

277− , P.text title

275+ , D.fromString title

278− , P.indent 2 (P.vcat (reverse entries))

276+ , D.indent 2 (D.vcat (reverse entries))

279 ]

277 ]

280

278

281

279

@@ -296,34 +294,34 @@ addChange toString widths name change (Docs inserts changes removes) =

296 Docs inserts changes (viewRemove toString widths name old : removes)

294 Docs inserts changes (viewRemove toString widths name old : removes)

297

295

298

296

299−viewInsert :: (a -> String) -> Widths -> Name -> a -> P.Doc

297+viewInsert :: (a -> String) -> Widths -> Name -> a -> D.Doc

300viewInsert toString (Widths nameWidth leftWidth _) name new =

298viewInsert toString (Widths nameWidth leftWidth _) name new =

301 viewName nameWidth name <+> pad leftWidth (toString new)

299 viewName nameWidth name <+> pad leftWidth (toString new)

302

300

303

301

304−viewChange :: (a -> String) -> Widths -> Name -> a -> a -> P.Doc

302+viewChange :: (a -> String) -> Widths -> Name -> a -> a -> D.Doc

305viewChange toString (Widths nameWidth leftWidth rightWidth) name old new =

303viewChange toString (Widths nameWidth leftWidth rightWidth) name old new =

306− P.hsep

304+ D.hsep

307 [ viewName nameWidth name

305 [ viewName nameWidth name

308 , pad leftWidth (toString old)

306 , pad leftWidth (toString old)

309− , P.text "=>"

307+ , "=>"

310 , pad rightWidth (toString new)

308 , pad rightWidth (toString new)

311 ]

309 ]

312

310

313

311

314−viewRemove :: (a -> String) -> Widths -> Name -> a -> P.Doc

312+viewRemove :: (a -> String) -> Widths -> Name -> a -> D.Doc

315viewRemove toString (Widths nameWidth leftWidth _) name old =

313viewRemove toString (Widths nameWidth leftWidth _) name old =

316 viewName nameWidth name <+> pad leftWidth (toString old)

314 viewName nameWidth name <+> pad leftWidth (toString old)

317

315

318

316

319−viewName :: Int -> Name -> P.Doc

317+viewName :: Int -> Name -> D.Doc

320viewName width name =

318viewName width name =

321− P.fill (width + 3) (P.text (Pkg.toString name))

319+ D.fill (width + 3) (D.fromText (Pkg.toText name))

322

320

323

321

324−pad :: Int -> String -> P.Doc

322+pad :: Int -> String -> D.Doc

325pad width string =

323pad width string =

326− P.text (replicate (width - length string) ' ') <> P.text string

324+ D.fromString (replicate (width - length string) ' ') <> D.fromString string

327

325

328

326

329

327

builder/src/Reporting/Exit.hs+22−30

@@ -8,9 +8,6 @@ module Reporting.Exit

8 where

11−import Data.Monoid ((<>))

12−import qualified Text.PrettyPrint.ANSI.Leijen as P

13−

14import qualified Elm.Compiler as Compiler

11import qualified Elm.Compiler as Compiler

15import qualified Elm.Compiler.Module as Module

12import qualified Elm.Compiler.Module as Module

16import qualified Elm.Package as Pkg

13import qualified Elm.Package as Pkg

@@ -74,18 +71,18 @@ toReport exit =

74 NoElmJson ->

71 NoElmJson ->

75 Help.report "WELCOME" Nothing

72 Help.report "WELCOME" Nothing

76 "It looks like you are trying to start a new Elm project. Very exciting! :D"

73 "It looks like you are trying to start a new Elm project. Very exciting! :D"

77− [ P.fillSep

74+ [ D.fillSep

78 ["I","very","highly","recommend","working","through"

75 ["I","very","highly","recommend","working","through"

79− ,P.green "<https://guide.elm-lang.org>","which","will","teach","you","the"

76+ ,D.green "<https://guide.elm-lang.org>","which","will","teach","you","the"

80 ,"basics","of","Elm,","including","how","to","start","new","projects."

77 ,"basics","of","Elm,","including","how","to","start","new","projects."

81 ]

78 ]

82− , P.fillSep

79+ , D.fillSep

83 ["For","folks","who","have","already","built","stuff","with","Elm,","the"

80 ["For","folks","who","have","already","built","stuff","with","Elm,","the"

84− ,"problem","is","just","that","there","is","no",P.dullyellow "elm.json","yet."

81+ ,"problem","is","just","that","there","is","no",D.dullyellow "elm.json","yet."

85 ,"If","you","want","to","work","from","an","example,","check","out","the"

82 ,"If","you","want","to","work","from","an","example,","check","out","the"

86 ,"one","at","<https://github.com/evancz/elm-todomvc/blob/master/elm.json>"

83 ,"one","at","<https://github.com/evancz/elm-todomvc/blob/master/elm.json>"

87 ]

84 ]

88− , Help.reflow

85+ , D.reflow

89 "Whatever your scenario, I hope you have a lovely time using Elm!"

86 "Whatever your scenario, I hope you have a lovely time using Elm!"

90 ]

87 ]

@@ -105,9 +102,9 @@ toReport exit =

105 Help.report "IMPORT CYCLE" Nothing

102 Help.report "IMPORT CYCLE" Nothing

106 "Your module imports form a cycle:"

103 "Your module imports form a cycle:"

107 [ D.cycle 4 names

104 [ D.cycle 4 names

108− , Help.reflow $

105+ , D.reflow $

109 "Learn more about why this is disallowed and how to break cycles here:"

106 "Learn more about why this is disallowed and how to break cycles here:"

110− ++ Help.hintLink "import-cycles"

107+ ++ D.makeLink "import-cycles"

111 ]

108 ]

112

109

113 Deps depsError ->

110 Deps depsError ->

@@ -129,8 +126,8 @@ toReport exit =

129 "This usually happens if you try to modify dependency constraints by\

126 "This usually happens if you try to modify dependency constraints by\

130 \ hand. I recommend deleting any dependency you added recently (or all\

127 \ hand. I recommend deleting any dependency you added recently (or all\

131 \ of them if things are bad) and then adding them again with:"

128 \ of them if things are bad) and then adding them again with:"

132− [ P.indent 4 $ P.green "elm install"

129+ [ D.indent 4 $ D.green "elm install"

133− , Help.reflow $

130+ , D.reflow $

134 "And do not be afaid to ask for help on Slack if you get stuck!"

131 "And do not be afaid to ask for help on Slack if you get stuck!"

135 ]

132 ]

136

133

@@ -138,12 +135,12 @@ toReport exit =

138 Help.report "OLD DEPENDENCIES" (Just "elm.json")

135 Help.report "OLD DEPENDENCIES" (Just "elm.json")

139 ( "The following packages do not work with Elm " ++ Pkg.versionToString Compiler.version ++ " right now:"

136 ( "The following packages do not work with Elm " ++ Pkg.versionToString Compiler.version ++ " right now:"

140 )

137 )

141− [ P.indent 4 $ P.vcat $ map (P.red . P.text . Pkg.toString) badPackages

138+ [ D.indent 4 $ D.vcat $ map (D.red . D.fromString . Pkg.toString) badPackages

142− , Help.reflow $

139+ , D.reflow $

143 "This may be because it is not upgraded yet. It may be because a\

140 "This may be because it is not upgraded yet. It may be because a\

144 \ better solution came along, so there was no need to upgrade it.\

141 \ better solution came along, so there was no need to upgrade it.\

145 \ Etc. Try asking around on Slack to learn more about the topic."

142 \ Etc. Try asking around on Slack to learn more about the topic."

146− , Help.note

143+ , D.toSimpleNote

147 "Whatever the case, please be kind to the relevant package authors! Having\

144 "Whatever the case, please be kind to the relevant package authors! Having\

148 \ friendly interactions with users is great motivation, and conversely, getting\

145 \ friendly interactions with users is great motivation, and conversely, getting\

149 \ berated by strangers on the internet sucks your soul dry. Furthermore, package\

146 \ berated by strangers on the internet sucks your soul dry. Furthermore, package\

@@ -155,37 +152,32 @@ toReport exit =

155 CannotMakeNothing ->

152 CannotMakeNothing ->

156 Help.report "NO INPUT" Nothing

153 Help.report "NO INPUT" Nothing

157 "What should I make though? I need more information, like:"

154 "What should I make though? I need more information, like:"

158− [ P.vcat

155+ [ D.vcat

159− [ P.indent 4 $ P.green "elm make MyThing.elm"

156+ [ D.indent 4 $ D.green "elm make MyThing.elm"

160− , P.indent 4 $ P.green "elm make This.elm That.elm"

157+ , D.indent 4 $ D.green "elm make This.elm That.elm"

161 ]

158 ]

162− , Help.reflow

159+ , D.reflow

163 "However many files you give, I will create one JS file out of them."

160 "However many files you give, I will create one JS file out of them."

164 ]

161 ]

165

162

166 CannotOptimizeDebug m ms ->

163 CannotOptimizeDebug m ms ->

167 Help.report "DEBUG REMNANTS" Nothing

164 Help.report "DEBUG REMNANTS" Nothing

168 "There are uses of the `Debug` module in the following modules:"

165 "There are uses of the `Debug` module in the following modules:"

169− [ P.indent 4 $ P.red $ P.vcat $ map (P.text . Module.nameToString) (m:ms)

166+ [ D.indent 4 $ D.red $ D.vcat $ map (D.fromString . Module.nameToString) (m:ms)

170− , Help.reflow "But the --optimize flag only works if all `Debug` functions are removed!"

167+ , D.reflow "But the --optimize flag only works if all `Debug` functions are removed!"

171− , toSimpleNote $

168+ , D.toSimpleNote $

172 "The issue is that --optimize strips out info needed by `Debug` functions.\

169 "The issue is that --optimize strips out info needed by `Debug` functions.\

173 \ Here are two examples:"

170 \ Here are two examples:"

174− , P.indent 4 $ Help.reflow $

171+ , D.indent 4 $ D.reflow $

175 "(1) It shortens record field names. This makes the generated JavaScript is\

172 "(1) It shortens record field names. This makes the generated JavaScript is\

176 \ smaller, but `Debug.toString` cannot know the real field names anymore."

173 \ smaller, but `Debug.toString` cannot know the real field names anymore."

177− , P.indent 4 $ Help.reflow $

174+ , D.indent 4 $ D.reflow $

178 "(2) Values like `type Height = Height Float` are unboxed. This reduces\

175 "(2) Values like `type Height = Height Float` are unboxed. This reduces\

179 \ allocation, but it also means that `Debug.toString` cannot tell if it is\

176 \ allocation, but it also means that `Debug.toString` cannot tell if it is\

180 \ looking at a `Height` or `Float` value."

177 \ looking at a `Height` or `Float` value."

181− , Help.reflow $

178+ , D.reflow $

182 "There are a few other cases like that, and it will be much worse once we start\

179 "There are a few other cases like that, and it will be much worse once we start\

183 \ inlining code. That optimization could move `Debug.log` and `Debug.todo` calls,\

180 \ inlining code. That optimization could move `Debug.log` and `Debug.todo` calls,\

184 \ resulting in unpredictable behavior. I hope that clarifies why this restriction\

181 \ resulting in unpredictable behavior. I hope that clarifies why this restriction\

185 \ exists!"

182 \ exists!"

186 ]

183 ]

187−

188−

189−toSimpleNote :: String -> P.Doc

190−toSimpleNote message =

191− P.fillSep ((P.underline "Note" <> ":") : map P.text (words message))

builder/src/Reporting/Exit/Assets.hs+28−28

@@ -9,11 +9,11 @@ module Reporting.Exit.Assets

9 where

12−import Data.Monoid ((<>))

13import qualified Data.Text as Text

12import qualified Data.Text as Text

14−import qualified Text.PrettyPrint.ANSI.Leijen as P

16import qualified Elm.Package as Pkg

14import qualified Elm.Package as Pkg

15+import Reporting.Doc ((<>))

16+import qualified Reporting.Doc as D

17import qualified Reporting.Exit.Help as Help

@@ -33,7 +33,7 @@ data Exit

35data ElmJsonProblem

36− = BadJson P.Doc

36+ = BadJson D.Doc

37 | BadDepDup String String Pkg.Name [Pkg.Name]

38 | BadSrcDir FilePath

@@ -54,7 +54,7 @@ toReport exit =

54 CorruptBinary path ->

55 Help.report "CORRUPT BINARY" (Just path)

56 ("The binary data at " ++ path ++ " is corrupt.")

57− [ Help.reflow $

57+ [ D.reflow $

58 "Maybe a program is modifying your elm-stuff/ or ELM_HOME\

59 \ directory in unexpected ways? Both of those are just caches, so\

60 \ you can try deleting them and they will be rebuilt from scratch."

@@ -74,7 +74,7 @@ corruptJsonToReport path pkg vsn =

74 ( "The " ++ path ++ " for " ++ Pkg.toString pkg

75 ++ " " ++ Pkg.versionToString vsn ++ " got corrupted somehow."

76 )

77− [ Help.reflow $

77+ [ D.reflow $

78 "I removed it from my file cache, so if it was some transient\

79 \ error it should be fixed if you try the same thing again.\

80 \ Please report this if it seems like an Elm problem though!"

@@ -94,8 +94,8 @@ elmJsonProblemToReport problem =

94 BadSrcDir dir ->

95 Help.report "BAD JSON" (Just "elm.json")

96 "The \"source-directories\" in your elm.json lists the following directory:"

97− [ P.indent 4 (P.dullyellow (P.text dir))

97+ [ D.indent 4 (D.dullyellow (D.fromString dir))

98− , Help.reflow "I cannot find that directory though! Is it missing? Is there a typo?"

98+ , D.reflow "I cannot find that directory though! Is it missing? Is there a typo?"

99 ]

100

101 BadDepDup field1 field2 dup dups ->

@@ -116,13 +116,13 @@ elmJsonProblemToReport problem =

116 else

117 "The following packages appear twice in your elm.json file:"

118 )

119− [ P.dullyellow $ P.indent 4 $ P.vcat $

119+ [ D.dullyellow $ D.indent 4 $ D.vcat $

120− map (P.text . Pkg.toString) (dup:dups)

120+ map (D.fromString . Pkg.toString) (dup:dups)

121− , Help.reflow $

121+ , D.reflow $

122 "The " ++ packagesAre ++ " available in \"" ++ field1

123 ++ "\", so it is redundant to list it again in \"" ++ field2

124 ++ "\". It is already available! " ++ advice

125− , Help.reflow "More help at <https://github.com/elm-lang/elm-package/blob/master/TODO>"

125+ , D.reflow "More help at <https://github.com/elm-lang/elm-package/blob/master/TODO>"

126 ]

127

128

@@ -143,49 +143,49 @@ data BadElmJsonContent

143 | BadSummaryTooLong

144

145

146−badContentToDocs :: BadElmJsonContent -> [P.Doc]

146+badContentToDocs :: BadElmJsonContent -> [D.Doc]

147badContentToDocs badContent =

148 case badContent of

149 BadType _ ->

150 ["The","only","valid","types","of","elm.json","are"

151− ,P.green "\"application\"","and",P.green "\"package\"" <> "."

151+ ,D.green "\"application\"","and",D.green "\"package\"" <> "."

152 ]

153

154 BadPkgName problem ->

155− map P.text (words problem)

155+ map D.fromString (words problem)

156

157 BadVersion txt ->

158− ["You","provided",P.red (P.text (show txt))

158+ ["You","provided",D.red (D.fromString (show txt))

159 ,"which","is","not","a","valid","version.","I","need","something","like"

160− ,P.green "\"1.0.0\"","or",P.green "\"2.0.4\"" <> "."

160+ ,D.green "\"1.0.0\"","or",D.green "\"2.0.4\"" <> "."

161 ]

162

163 BadConstraint problem ->

164− map P.text (words ("It is not a valid constraint. " ++ problem))

164+ map D.fromString (words ("It is not a valid constraint. " ++ problem))

165

166 BadModuleName name ->

167− ["You","provided",P.text (show name),"which","is","not","a","valid","module","name."

167+ ["You","provided",D.fromString (show name),"which","is","not","a","valid","module","name."

168− ,"I","need","something","like",P.green "\"Html.Events\"","or",P.green "\"Browser.Navigation\"" <> "."

168+ ,"I","need","something","like",D.green "\"Html.Events\"","or",D.green "\"Browser.Navigation\"" <> "."

169 ]

170

171 BadModuleHeaderTooLong header ->

172− ["The",P.text (show header),"header","is","too","long."

172+ ["The",D.fromString (show header),"header","is","too","long."

173− ,"I","need","it","to","be",P.green "under",P.green "20",P.green "characters"

173+ ,"I","need","it","to","be",D.green "under",D.green "20",D.green "characters"

174 ,"to","ensure","that","formatting","is","nice","on","the","package","website."

175 ]

176

177 BadDependencyName name ->

178− ["The",P.text (show name),"entry","is","not","a","valid","package","name."

178+ ["The",D.fromString (show name),"entry","is","not","a","valid","package","name."

179 ,"I","recommend","deleting","it,","finding","the","package","you","want","on"

180 ,"the","package","website,","and","installing","it","with","the"

181− ,P.green "`elm install`","command","instead."

181+ ,D.green "`elm install`","command","instead."

182 ]

183

184 BadLicense _given suggestions ->

185 case suggestions of

186 [] ->

187 ["I","need","an","OSI","approved","SPDX","license,","like"

188− ,P.green "\"BSD-3-Clause\"","or",P.green "\"MIT\".","See"

188+ ,D.green "\"BSD-3-Clause\"","or",D.green "\"MIT\".","See"

189 ,"<https://spdx.org/licenses/>","for","a","full","list","of","options."

190 ]

191

@@ -195,20 +195,20 @@ badContentToDocs badContent =

195 ++ ["See","<https://spdx.org/licenses/>","for","a","full","list","of","options."]

196

197 BadDirectoryNotString ->

198− ["I","need","a",P.green "STRING","that","points","to","a","directory","of","Elm","code."

198+ ["I","need","a",D.green "STRING","that","points","to","a","directory","of","Elm","code."

199 ]

200

201 BadSummaryTooLong ->

202 ["Your","summary","is","too","long.","I","need","it","to"

203− ,"be",P.green "under",P.green "80",P.green "characters."

203+ ,"be",D.green "under",D.green "80",D.green "characters."

204 ]

205

206

207−oneOf :: Text.Text -> [Text.Text] -> [P.Doc]

207+oneOf :: Text.Text -> [Text.Text] -> [D.Doc]

208oneOf code codes =

209 let

210 toDoc spdx =

211− P.green (P.text (show spdx))

211+ D.green (D.fromString (show spdx))

212 in

213 case codes of

214 [] ->

builder/src/Reporting/Exit/Bump.hs+7−8

@@ -6,10 +6,9 @@ module Reporting.Exit.Bump

6 where

9−import Data.Monoid ((<>))

10−import qualified Text.PrettyPrint.ANSI.Leijen as P

11−

12import qualified Elm.Package as Pkg

9import qualified Elm.Package as Pkg

10+import Reporting.Doc ((<>))

11+import qualified Reporting.Doc as D

13import qualified Reporting.Exit.Help as Help

12import qualified Reporting.Exit.Help as Help

@@ -37,16 +36,16 @@ toReport exit =

38 Unbumpable vsn versions ->

37 Unbumpable vsn versions ->

39 Help.docReport "UNBUMPABLE" (Just "elm.json")

38 Help.docReport "UNBUMPABLE" (Just "elm.json")

40− ( P.fillSep

39+ ( D.fillSep

41 ["Your","elm.json","says","I","should","bump","relative","to","version"

40 ["Your","elm.json","says","I","should","bump","relative","to","version"

42− ,P.red (P.text (Pkg.versionToString vsn)) <> ","

41+ ,D.red (D.fromText (Pkg.versionToText vsn)) <> ","

43 ,"but","I","cannot","find","that","version","on","<https://package.elm-lang.org>."

42 ,"but","I","cannot","find","that","version","on","<https://package.elm-lang.org>."

44 ,"That","means","there","is","no","API","for","me","to","diff","against","and"

43 ,"That","means","there","is","no","API","for","me","to","diff","against","and"

45 ,"figure","out","if","these","are","MAJOR,","MINOR,","or","PATCH","changes."

44 ,"figure","out","if","these","are","MAJOR,","MINOR,","or","PATCH","changes."

46 ]

45 ]

47 )

46 )

48− [ P.fillSep $

47+ [ D.fillSep $

49− ["Try","bumping","again","after","changing","the",P.dullyellow "\"version\"","in","elm.json"]

48+ ["Try","bumping","again","after","changing","the",D.dullyellow "\"version\"","in","elm.json"]

50 ++ if length versions == 1 then ["to:"] else ["to","one","of","these:"]

49 ++ if length versions == 1 then ["to:"] else ["to","one","of","these:"]

51− , P.vcat $ map (P.green . P.text . Pkg.versionToString) versions

50+ , D.vcat $ map (D.green . D.fromText . Pkg.versionToText) versions

52 ]

51 ]

builder/src/Reporting/Exit/Compile.hs+11−11

@@ -11,11 +11,11 @@ module Reporting.Exit.Compile

11import qualified Data.List as List

12import qualified Data.Text as Text

13import qualified Data.Time.Clock as Time

14−import qualified Text.PrettyPrint.ANSI.Leijen as P

16import qualified Elm.Compiler as Compiler

15import qualified Elm.Compiler as Compiler

17import qualified Elm.Compiler.Module as Module

16import qualified Elm.Compiler.Module as Module

18import qualified Json.Encode as Encode

17import qualified Json.Encode as Encode

18+import qualified Reporting.Doc as D

@@ -45,15 +45,15 @@ toJson (Exit name path _ source errors) =

45-- TO DOC

48−toDoc :: Exit -> [Exit] -> P.Doc

48+toDoc :: Exit -> [Exit] -> D.Doc

49toDoc e es =

50 let

51 (exit, exits) = sortByTime e es

52 in

53− P.vcat (toDocHelp exit exits)

53+ D.vcat (toDocHelp exit exits)

56−toDocHelp :: Exit -> [Exit] -> [P.Doc]

56+toDocHelp :: Exit -> [Exit] -> [D.Doc]

57toDocHelp e1 exits =

58 case exits of

59 [] ->

@@ -63,23 +63,23 @@ toDocHelp e1 exits =

63 exitToDoc e1 : separator (_name e1) (_name e2) : toDocHelp e2 otherErrors

66−exitToDoc :: Exit -> P.Doc

66+exitToDoc :: Exit -> D.Doc

67exitToDoc (Exit _name path _time source errors) =

68 Compiler.errorsToDoc path source errors

71−separator :: Module.Raw -> Module.Raw -> P.Doc

71+separator :: Module.Raw -> Module.Raw -> D.Doc

72separator beforeName afterName =

73 let

74 before = Module.nameToString beforeName ++ " ↑ "

75 after = " ↓ " ++ Module.nameToString afterName

76 in

77− P.dullred $ P.vcat $

77+ D.dullred $ D.vcat $

78− [ P.indent (80 - length before) (P.text before)

78+ [ D.indent (80 - length before) (D.fromString before)

79 , "====o======================================================================o===="

80− , P.text after

80+ , D.fromString after

81− , P.empty

81+ , D.empty

82− , P.empty

82+ , D.empty

83 ]

builder/src/Reporting/Exit/Crawl.hs+34−34

@@ -13,12 +13,12 @@ import qualified Data.Char as Char

13import qualified Data.Map as Map

14import qualified Data.Text.Encoding as Text

15import qualified Data.Time.Clock as Time

16−import qualified Text.PrettyPrint.ANSI.Leijen as P

17−import Text.PrettyPrint.ANSI.Leijen ((<+>), (<>))

19import qualified Elm.Compiler as Compiler

17import qualified Elm.Compiler as Compiler

20import qualified Elm.Compiler.Module as Module

18import qualified Elm.Compiler.Module as Module

21import qualified Elm.Package as Pkg

19import qualified Elm.Package as Pkg

20+import Reporting.Doc ((<+>), (<>))

21+import qualified Reporting.Doc as D

22import qualified Reporting.Exit.Compile as Compile

23import qualified Reporting.Exit.Help as Help

@@ -65,18 +65,18 @@ toReport exit =

65 RootFileNotFound path ->

66 Help.report "FILE NOT FOUND" Nothing

67 "You want me to compile this file:"

68− [ P.indent 4 $ P.dullyellow $ P.text path

68+ [ D.indent 4 $ D.dullyellow $ D.fromString path

69 , "I cannot find it though! Is there a typo?"

70 ]

72 RootModuleNameDuplicate name paths ->

73 Help.report "DUPLICATE NAMES" Nothing

74 "I am trying to compile multiple modules with the same name:"

75− [ P.indent 4 $ P.dullyellow $ P.vcat $

75+ [ D.indent 4 $ D.dullyellow $ D.vcat $

76− map P.text paths

76+ map D.fromString paths

77− , P.fillSep $

77+ , D.fillSep $

78 [ "These", "modules", if length paths == 2 then "both" else "all", "claim"

79− , "to", "be", "named", P.dullyellow (P.text (Module.nameToString name)) <> "."

79+ , "to", "be", "named", D.dullyellow (D.fromString (Module.nameToString name)) <> "."

80 , "Change", "them", "to", "have", "unique", "names", "and", "you"

81 , "should", "be", "all", "set!"

82 ]

@@ -97,8 +97,8 @@ toReport exit =

97 BadKernelHeader filePath ->

98 Help.report "BAD KERNEL HEADER" Nothing

99 "I ran into a bad header in this file:"

100− [ P.indent 4 $ P.dullyellow $ P.text filePath

100+ [ D.indent 4 $ D.dullyellow $ D.fromString filePath

101− , Help.reflow $

101+ , D.reflow $

102 "NOTE: Kernel code is only available to core Elm libraries to ensure\

103 \ the portability and security of the Elm ecosystem. This restriction\

104 \ also makes it possible to improve code gen (i.e. performance) without\

@@ -133,9 +133,9 @@ problemToReport problem =

133 Help.report "MODULE NAME MISMATCH" (Just path)

134 ( "The file at " ++ path ++ " has a typo in the module name. It says:"

135 )

136− [ P.indent 4 $ P.dullyellow $ "module" <+> P.red (P.text (Module.nameToString actual)) <+> "exposing (..)"

136+ [ D.indent 4 $ D.dullyellow $ "module" <+> D.red (D.fromString (Module.nameToString actual)) <+> "exposing (..)"

137 , "Looks like a typo or copy/paste error. Instead it needs to say:"

138− , P.indent 4 $ P.dullyellow $ "module" <+> P.green (P.text (Module.nameToString expected)) <+> "exposing (..)"

138+ , D.indent 4 $ D.dullyellow $ "module" <+> D.green (D.fromString (Module.nameToString expected)) <+> "exposing (..)"

139 , "Make the change and you should be all set!"

140 ]

141

@@ -159,16 +159,16 @@ badTagToDoc path name tag hintName summary =

159 ("UNEXPECTED " ++ map Char.toUpper tag ++ " MODULE")

160 (Just path)

161 summary

162− [ P.fillSep $

162+ [ D.fillSep $

163 [ "Get", "rid", "of", "all", "the"

164− , P.red (P.text tag)

164+ , D.red (D.fromString tag)

165 , "stuff", "in"

166− , P.dullyellow (P.text (Module.nameToString name))

166+ , D.dullyellow (D.fromString (Module.nameToString name))

167 , "to", "proceed."

168 ]

169− , Help.note $

169+ , D.toSimpleNote $

170 "You can learn the reasoning behind this design choice at "

171− ++ Help.hintLink hintName

171+ ++ D.makeLink hintName

172 ]

173

174

@@ -182,11 +182,11 @@ namelessToDoc path name =

182 ( "The `" ++ Module.nameToString name

183 ++ "` module must start with a line like this:"

184 )

185− [ P.indent 4 $ P.dullyellow $ P.text $

185+ [ D.indent 4 $ D.dullyellow $ D.fromString $

186 "module " ++ Module.nameToString name ++ " exposing (..)"

187− , Help.reflow $

187+ , D.reflow $

188 "Try adding that as the first line of your file!"

189− , Help.note $

189+ , D.toSimpleNote $

190 "It is best to replace (..) with an explicit list of types and\

191 \ functions you want to expose. If you know a value is only used\

192 \ WITHIN this module, it is extra easy to refactor. This kind of\

@@ -200,8 +200,8 @@ notFoundToDoc origin child dirs =

200 ElmJson ->

201 Help.report "MODULE NOT FOUND" (Just "elm.json")

202 "Your elm.json says your project has the following module:"

203− [ P.indent 4 $ P.red $ P.text $ Module.nameToString child

203+ [ D.indent 4 $ D.red $ D.fromString $ Module.nameToString child

204− , Help.reflow $

204+ , D.reflow $

205 "When creating packages, all modules must live in the\

206 \ src/ directory, but I cannot find it there."

207 ]

@@ -217,20 +217,20 @@ notFoundToDoc origin child dirs =

217 (notFoundDetails child dirs)

218

219

220−notFoundDetails :: Module.Raw -> [FilePath] -> [P.Doc]

220+notFoundDetails :: Module.Raw -> [FilePath] -> [D.Doc]

221notFoundDetails child dirs =

222 let

223 simulatedCode =

224− P.indent 4 $ P.red $ P.text $ "import " ++ Module.nameToString child

224+ D.indent 4 $ D.red $ D.fromString $ "import " ++ Module.nameToString child

225 in

226 case Map.lookup child Pkg.suggestions of

227 Just pkg ->

228 [ simulatedCode

229− , Help.reflow $

229+ , D.reflow $

230 "Do you want the one from the " ++ Pkg.toString pkg

231 ++ " package? If so, run this command to add that dependency to your elm.json file:"

232− , P.indent 4 $ P.green $ P.text $ "elm install " ++ Pkg.toString pkg

232+ , D.indent 4 $ D.green $ D.fromString $ "elm install " ++ Pkg.toString pkg

233− , Help.reflow $

233+ , D.reflow $

234 "If you want a local file, make sure the directory that contains the `"

235 ++ Module.nameToString child

236 ++ "` module is listed in your elm.json \"source-directories\" field."

@@ -239,7 +239,7 @@ notFoundDetails child dirs =

239 Nothing ->

240 [ simulatedCode

241 , "I cannot find that module! Is there a typo in the module name?"

242− , Help.reflow $

242+ , D.reflow $

243 case dirs of

244 [] ->

245 "The \"source-directories\" field of your elm.json is empty, so I only\

@@ -263,12 +263,12 @@ ambiguousToDoc origin child paths pkgs =

263

264 makeReport maybePath summary yellowString =

265 Help.report "AMBIGUOUS IMPORT" maybePath summary

266− [ P.indent 4 $ P.dullyellow $ P.text yellowString

266+ [ D.indent 4 $ D.dullyellow $ D.fromString yellowString

267− , Help.reflow $

267+ , D.reflow $

268 "I found multiple module with that name though:"

269− , P.indent 4 $ P.dullyellow $ P.vcat $

269+ , D.indent 4 $ D.dullyellow $ D.vcat $

270− map P.text $ paths ++ map pkgToString pkgs

270+ map D.fromString $ paths ++ map pkgToString pkgs

271− , Help.reflow $

271+ , D.reflow $

272 if null paths then

273 "It looks like the name clash is in your dependencies, which is\

274 \ out of your control. Elm does not support this scenario right\

@@ -319,8 +319,8 @@ kernelNameToDoc origin kernelName =

319 )

320 in

321 Help.report "BAD MODULE NAME" maybePath statement

322− [ P.indent 4 $ P.dullyellow $ P.text $ Module.nameToString kernelName

322+ [ D.indent 4 $ D.dullyellow $ D.fromString $ Module.nameToString kernelName

323− , Help.reflow $

323+ , D.reflow $

324 "But names like that are reserved for internal use.\

325 \ Switch to a name outside of the Elm/Kernel/ namespace."

326 ]

builder/src/Reporting/Exit/Deps.hs+18−19

@@ -6,12 +6,11 @@ module Reporting.Exit.Deps

6 where

9−import Text.PrettyPrint.ANSI.Leijen ((<>))

10−import qualified Text.PrettyPrint.ANSI.Leijen as P

11−

12import qualified Elm.Compiler as Compiler

9import qualified Elm.Compiler as Compiler

13import qualified Elm.Package as Pkg

10import qualified Elm.Package as Pkg

14import qualified Elm.Project.Constraint as Con

11import qualified Elm.Project.Constraint as Con

12+import Reporting.Doc ((<>))

13+import qualified Reporting.Doc as D

15import qualified Reporting.Exit.Help as Help

14import qualified Reporting.Exit.Help as Help

@@ -40,8 +39,8 @@ toReport exit =

40 Help.report "CORRUPT CACHE" Nothing

39 Help.report "CORRUPT CACHE" Nothing

41 ( "I ran into an unknown package while exploring dependencies:"

40 ( "I ran into an unknown package while exploring dependencies:"

42 )

41 )

43− [ P.indent 4 $ P.dullyellow $ P.text $ Pkg.toString pkg

42+ [ D.indent 4 $ D.dullyellow $ D.fromString $ Pkg.toString pkg

44− , Help.reflow $

43+ , D.reflow $

45 "This suggests that your ELM_HOME directory has been corrupted.\

44 "This suggests that your ELM_HOME directory has been corrupted.\

46 \ Maybe some program is messing with it? It is just cached files,\

45 \ Maybe some program is messing with it? It is just cached files,\

47 \ so you can delete it and see if that fixes the issue."

46 \ so you can delete it and see if that fixes the issue."

@@ -49,25 +48,25 @@ toReport exit =

50 PackageNotFound package suggestions ->

49 PackageNotFound package suggestions ->

51 Help.docReport "PACKAGE NOT FOUND" Nothing

50 Help.docReport "PACKAGE NOT FOUND" Nothing

52− ( P.fillSep

51+ ( D.fillSep

53 ["I","cannot","find","a"

52 ["I","cannot","find","a"

54− ,P.red (P.text (Pkg.toString package))

53+ ,D.red (D.fromString (Pkg.toString package))

55 ,"package","on","the","package","website."

54 ,"package","on","the","package","website."

56 ]

55 ]

57 )

56 )

58 [ "Maybe you want one of these instead?"

57 [ "Maybe you want one of these instead?"

59− , P.indent 4 $ P.dullyellow $ P.vcat $ map (P.text . Pkg.toString) suggestions

58+ , D.indent 4 $ D.dullyellow $ D.vcat $ map (D.fromString . Pkg.toString) suggestions

60 , "But check <https://package.elm-lang.org> to see all possibilities!"

59 , "But check <https://package.elm-lang.org> to see all possibilities!"

61 ]

60 ]

63 AppBadElm version ->

62 AppBadElm version ->

64 Help.report "ELM VERSION MISMATCH" Nothing

63 Help.report "ELM VERSION MISMATCH" Nothing

65 "Your elm.json says this application needs a different version of Elm."

64 "Your elm.json says this application needs a different version of Elm."

66− [ P.fillSep

65+ [ D.fillSep

67 [ "It", "requires"

66 [ "It", "requires"

68− , P.green (P.text (Pkg.versionToString version)) <> ","

67+ , D.green (D.fromString (Pkg.versionToString version)) <> ","

69 , "but", "you", "are", "using"

68 , "but", "you", "are", "using"

70− , P.red (P.text (Pkg.versionToString Compiler.version))

69+ , D.red (D.fromString (Pkg.versionToString Compiler.version))

71 , "right", "now."

70 , "right", "now."

72 ]

71 ]

73 ]

72 ]

@@ -75,10 +74,10 @@ toReport exit =

75 PkgBadElm constraint ->

74 PkgBadElm constraint ->

76 Help.report "ELM VERSION MISMATCH" Nothing

75 Help.report "ELM VERSION MISMATCH" Nothing

77 "Your elm.json says this package needs a version of Elm in this range:"

76 "Your elm.json says this package needs a version of Elm in this range:"

78− [ P.indent 4 $ P.dullyellow $ P.text $ Con.toString constraint

77+ [ D.indent 4 $ D.dullyellow $ D.fromString $ Con.toString constraint

79− , P.fillSep

78+ , D.fillSep

80 [ "But", "you", "are", "using", "Elm"

79 [ "But", "you", "are", "using", "Elm"

81− , P.red (P.text (Pkg.versionToString Compiler.version))

80+ , D.red (D.fromString (Pkg.versionToString Compiler.version))

82 , "right", "now."

81 , "right", "now."

83 ]

82 ]

84 ]

83 ]

@@ -86,11 +85,11 @@ toReport exit =

86 BadDeps ->

85 BadDeps ->

87 Help.report "CLASHING PACKAGE DEPENDENCIES" Nothing

86 Help.report "CLASHING PACKAGE DEPENDENCIES" Nothing

88 "The dependencies in your elm.json are not compatible."

87 "The dependencies in your elm.json are not compatible."

89− [ Help.reflow $

88+ [ D.reflow $

90 "Did you change them by hand? Try to change it back! It is much\

89 "Did you change them by hand? Try to change it back! It is much\

91 \ better to add dependencies with commands like this:"

90 \ better to add dependencies with commands like this:"

92− , P.indent 4 $ P.dullyellow $ P.text $ "elm install elm-lang/http"

91+ , D.indent 4 $ D.dullyellow "elm install elm-lang/http"

93− , Help.reflow $

92+ , D.reflow $

94 "Please ask for help on the Elm slack <http://elmlang.herokuapp.com/> if\

93 "Please ask for help on the Elm slack <http://elmlang.herokuapp.com/> if\

95 \ you are running into something that seems trickier than this."

94 \ you are running into something that seems trickier than this."

96 ]

95 ]

@@ -98,8 +97,8 @@ toReport exit =

98 BuildFailure pkg vsn ->

97 BuildFailure pkg vsn ->

99 Help.report "CORRUPT DEPENDENCY" Nothing

98 Help.report "CORRUPT DEPENDENCY" Nothing

100 "I ran into a problem while building the following package:"

99 "I ran into a problem while building the following package:"

101− [ P.indent 4 $ P.dullyellow $ P.text $ Pkg.toString pkg ++ " " ++ Pkg.versionToString vsn

100+ [ D.indent 4 $ D.dullyellow $ D.fromString $ Pkg.toString pkg ++ " " ++ Pkg.versionToString vsn

102− , Help.reflow $

101+ , D.reflow $

103 "This probably means the downloaded files got corrupted somehow.\

102 "This probably means the downloaded files got corrupted somehow.\

104 \ Maybe try deleting your ELM_HOME and see if that resolves the issue?"

103 \ Maybe try deleting your ELM_HOME and see if that resolves the issue?"

105 ]

104 ]

builder/src/Reporting/Exit/Diff.hs+9−8

@@ -5,10 +5,11 @@ module Reporting.Exit.Diff

5 )

6 where

8import qualified Data.List as List

9import qualified Data.List as List

9−import qualified Text.PrettyPrint.ANSI.Leijen as P

11import qualified Elm.Package as Pkg

12+import qualified Reporting.Doc as D

12import qualified Reporting.Exit.Help as Help

13import qualified Reporting.Exit.Help as Help

@@ -33,32 +34,32 @@ toReport exit =

33 Help.report "CANNOT DIFF APPLICATIONS" Nothing

34 Help.report "CANNOT DIFF APPLICATIONS" Nothing

34 "I cannot perform diffs on applications, only packages! If you are\

35 "I cannot perform diffs on applications, only packages! If you are\

35 \ just curious to see a diff, try running this command:"

36 \ just curious to see a diff, try running this command:"

36− [ P.indent 4 $ P.green $ "elm diff elm-lang/html 5.1.1 6.0.0"

37+ [ D.indent 4 $ D.green $ "elm diff elm-lang/html 5.1.1 6.0.0"

37 ]

38 ]

39 UnknownPackage pkg suggestions ->

40 UnknownPackage pkg suggestions ->

40 Help.report "UNKNOWN PACKAGE" Nothing

41 Help.report "UNKNOWN PACKAGE" Nothing

41 ( "I cannot find a package called:"

42 ( "I cannot find a package called:"

42 )

43 )

43− [ P.indent 4 $ P.red $ P.text $ Pkg.toString pkg

44+ [ D.indent 4 $ D.red $ D.fromText $ Pkg.toText pkg

44 , "Maybe you want one of these instead?"

45 , "Maybe you want one of these instead?"

45− , P.indent 4 $ P.dullyellow $ P.vcat $ map (P.text . Pkg.toString) suggestions

46+ , D.indent 4 $ D.dullyellow $ D.vcat $ map (D.fromText . Pkg.toText) suggestions

46 , "But check <https://package.elm-lang.org> to see all possibilities!"

47 , "But check <https://package.elm-lang.org> to see all possibilities!"

47 ]

48 ]

49 UnknownVersion _pkg vsn realVersions ->

50 UnknownVersion _pkg vsn realVersions ->

50 Help.docReport "UNKNOWN VERSION" Nothing

51 Help.docReport "UNKNOWN VERSION" Nothing

51− ( P.fillSep $

52+ ( D.fillSep $

52− [ "Version", P.red (P.text (Pkg.versionToString vsn))

53+ [ "Version", D.red (D.fromText (Pkg.versionToText vsn))

53 , "has", "never", "been", "published,", "so", "I"

54 , "has", "never", "been", "published,", "so", "I"

54 , "cannot", "diff", "against", "it."

55 , "cannot", "diff", "against", "it."

55 ]

56 ]

56 )

57 )

57 [ "Here are all the versions that HAVE been published:"

58 [ "Here are all the versions that HAVE been published:"

58− , P.indent 4 $ P.dullyellow $ P.vcat $

59+ , D.indent 4 $ D.dullyellow $ D.vcat $

59 let

60 let

60 sameMajor v1 v2 = Pkg._major v1 == Pkg._major v2

61 sameMajor v1 v2 = Pkg._major v1 == Pkg._major v2

61− mkRow vsns = P.hsep $ map (P.text . Pkg.versionToString) vsns

62+ mkRow vsns = D.hsep $ map (D.fromText . Pkg.versionToText) vsns

62 in

63 in

63 map mkRow $ List.groupBy sameMajor (List.sort realVersions)

64 map mkRow $ List.groupBy sameMajor (List.sort realVersions)

64 , "Want one of those instead?"

65 , "Want one of those instead?"

builder/src/Reporting/Exit/Help.hs+20−72

@@ -7,10 +7,6 @@ module Reporting.Exit.Help

7 , compilerReport

8 , reportToDoc

9 , reportToJson

10− , hintLink

11− , stack

12− , reflow

13− , note

14 , toString

10 , toString

15 , toStdout

11 , toStdout

16 , toStderr

12 , toStderr

@@ -18,16 +14,13 @@ module Reporting.Exit.Help

18 where

14 where

21−import qualified Data.List as List

22import qualified Data.Text as Text

17import qualified Data.Text as Text

23import GHC.IO.Handle (hIsTerminalDevice)

18import GHC.IO.Handle (hIsTerminalDevice)

24import System.IO (Handle, hPutStr, stderr, stdout)

19import System.IO (Handle, hPutStr, stderr, stdout)

25−import qualified Text.PrettyPrint.ANSI.Leijen as P

26−import Text.PrettyPrint.ANSI.Leijen ((<>),(<+>))

28−import qualified Elm.Compiler as Compiler

29−import qualified Elm.Package as Pkg

30import qualified Json.Encode as Encode

21import qualified Json.Encode as Encode

22+import Reporting.Doc ((<+>))

23+import qualified Reporting.Doc as D

31import qualified Reporting.Exit.Compile as Compile

24import qualified Reporting.Exit.Compile as Compile

@@ -40,21 +33,21 @@ data Report

40 | Report

33 | Report

41 { _title :: String

34 { _title :: String

42 , _path :: Maybe FilePath

35 , _path :: Maybe FilePath

43− , _message :: P.Doc

36+ , _message :: D.Doc

44 }

37 }

47−report :: String -> Maybe FilePath -> String -> [P.Doc] -> Report

40+report :: String -> Maybe FilePath -> String -> [D.Doc] -> Report

48report title path startString others =

41report title path startString others =

49− Report title path $ stack (reflow startString:others)

42+ Report title path $ D.stack (D.reflow startString:others)

52−docReport :: String -> Maybe FilePath -> P.Doc -> [P.Doc] -> Report

45+docReport :: String -> Maybe FilePath -> D.Doc -> [D.Doc] -> Report

53docReport title path startDoc others =

46docReport title path startDoc others =

54− Report title path $ stack (startDoc:others)

47+ Report title path $ D.stack (startDoc:others)

57−jsonReport :: String -> Maybe FilePath -> P.Doc -> Report

50+jsonReport :: String -> Maybe FilePath -> D.Doc -> Report

58jsonReport =

51jsonReport =

59 Report

52 Report

@@ -68,7 +61,7 @@ compilerReport =

68-- TO DOC

61-- TO DOC

71−reportToDoc :: Report -> P.Doc

64+reportToDoc :: Report -> D.Doc

72reportToDoc report_ =

65reportToDoc report_ =

73 case report_ of

66 case report_ of

74 CompilerReport e es ->

67 CompilerReport e es ->

@@ -88,10 +81,10 @@ reportToDoc report_ =

88 makeDashes (5 + length title + length path) ++ " " ++ path

81 makeDashes (5 + length title + length path) ++ " " ++ path

90 errorBar =

83 errorBar =

91− P.dullcyan $

84+ D.dullcyan $

92− "--" <+> P.text title <+> P.text errorBarEnd

85+ "--" <+> D.fromString title <+> D.fromString errorBarEnd

93 in

86 in

94− stack [errorBar, message, ""]

87+ D.stack [errorBar, message, ""]

@@ -108,81 +101,36 @@ reportToJson report_ =

108 ]

101 ]

109

102

110 Report title maybePath message ->

103 Report title maybePath message ->

111− let

112− messageString =

113− P.displayS (P.renderPretty 1 80 message) ""

114− in

115 Encode.object

104 Encode.object

116 [ ("type", Encode.text "error")

105 [ ("type", Encode.text "error")

117 , ("path", maybe Encode.null (Encode.text . Text.pack) maybePath)

106 , ("path", maybe Encode.null (Encode.text . Text.pack) maybePath)

118 , ("title", Encode.text (Text.pack title))

107 , ("title", Encode.text (Text.pack title))

119− , ("message", Encode.text (Text.pack messageString))

108+ , ("message", D.encode message)

120 ]

109 ]

121

110

122

111

123

112

124−-- HINT LINKS

125−

126−

127−hintLink :: String -> String

128−hintLink hintName =

129− "<https://github.com/elm-lang/elm-compiler/blob/"

130− ++ Pkg.versionToString Compiler.version

131− ++ "/hints/" ++ hintName ++ ".md>"

132−

133−

134−

135−-- HELPERS

136−

137−

138−stack :: [P.Doc] -> P.Doc

139−stack allDocs =

140− case allDocs of

141− [] ->

142− error "Do not use `stack` on empty lists."

143−

144− doc : docs ->

145− List.foldl' verticalAppend doc docs

146−

147−

148−verticalAppend :: P.Doc -> P.Doc -> P.Doc

149−verticalAppend a b =

150− a <> P.hardline <> P.hardline <> b

151−

152−

153−reflow :: String -> P.Doc

154−reflow paragraph =

155− P.fillSep (map P.text (words paragraph))

156−

157−

158−note :: String -> P.Doc

159−note details =

160− P.fillSep $

161− (P.underline "Note" <> ":") : map P.text (words details)

162−

163−

164−

165-- OUTPUT

113-- OUTPUT

166

114

167

115

168−toString :: P.Doc -> String

116+toString :: D.Doc -> String

169−toString doc =

117+toString =

170− P.displayS (P.renderPretty 1 80 (P.plain doc)) ""

118+ D.toString

171

119

172

120

173−toStdout :: P.Doc -> IO ()

121+toStdout :: D.Doc -> IO ()

174toStdout doc =

122toStdout doc =

175 toHandle stdout doc

123 toHandle stdout doc

176

124

177

125

178−toStderr :: P.Doc -> IO ()

126+toStderr :: D.Doc -> IO ()

179toStderr doc =

127toStderr doc =

180 toHandle stderr doc

128 toHandle stderr doc

181

129

182

130

183−toHandle :: Handle -> P.Doc -> IO ()

131+toHandle :: Handle -> D.Doc -> IO ()

184toHandle handle doc =

132toHandle handle doc =

185 do isTerminal <- hIsTerminalDevice handle

133 do isTerminal <- hIsTerminalDevice handle

186 if isTerminal

134 if isTerminal

187− then P.displayIO handle (P.renderPretty 1 80 doc)

135+ then D.toAnsi handle doc

188 else hPutStr handle (toString doc)

136 else hPutStr handle (toString doc)

builder/src/Reporting/Exit/Http.hs+16−16

@@ -9,9 +9,9 @@ module Reporting.Exit.Http

11import qualified Data.Text as Text

12−import Text.PrettyPrint.ANSI.Leijen ((<>))

13−import qualified Text.PrettyPrint.ANSI.Leijen as P

13+import Reporting.Doc ((<>))

14+import qualified Reporting.Doc as D

15import qualified Reporting.Exit.Help as Help

@@ -21,7 +21,7 @@ import qualified Reporting.Exit.Help as Help

22data Exit

23 = Unknown String

24− | BadJson String P.Doc

24+ | BadJson String D.Doc

25 | BadZipData

26 | BadZipSha String String

@@ -34,15 +34,15 @@ toReport :: String -> Exit -> Help.Report

34toReport url exit =

35 let

36 urlDoc =

37− P.indent 4 $ P.dullyellow $ "<" <> P.text url <> ">"

37+ D.indent 4 $ D.dullyellow $ "<" <> D.fromString url <> ">"

38 in

39 case exit of

40 Unknown message ->

41 Help.report "HTTP PROBLEM" Nothing "The following HTTP request failed:"

42 [ urlDoc

43− , Help.stack

43+ , D.stack

44 [ "Here is the error message I was able to extract:"

45− , P.indent 4 $ Help.reflow message

45+ , D.indent 4 $ D.reflow message

46 ]

47 ]

@@ -52,7 +52,7 @@ toReport url exit =

52 BadZipData ->

53 Help.report "CORRUPT ZIP" Nothing "I could not unzip the file downloaded from:"

54 [ urlDoc

55− , Help.reflow $

55+ , D.reflow $

56 "If it is a transient issue, it should be fixed if you try this\

57 \ again. If it seems like an Elm problem, please report it though!"

58 ]

@@ -60,10 +60,10 @@ toReport url exit =

60 BadZipSha expectedHash actualHash ->

61 Help.report "CORRUPT ZIP" Nothing "I got an unexpected zip file from:"

62 [ urlDoc

63− , Help.reflow $

63+ , D.reflow $

64 "I was expecting the hash of content to be " ++ expectedHash

65 ++ ", but it is " ++ actualHash

66− , Help.reflow $

66+ , D.reflow $

67 "Most likely the package author may have moved the version\

68 \ tag, so report it to them and see if that is the issue."

69 ]

@@ -79,23 +79,23 @@ data BadJson

79 | BadAllVsn Text.Text

82−badJsonToDocs :: BadJson -> [P.Doc]

82+badJsonToDocs :: BadJson -> [D.Doc]

83badJsonToDocs badJson =

84 case badJson of

85 BadNewPkg txt ->

86− ["I","ran","into",P.red (P.text (show txt)) <> ","

86+ ["I","ran","into",D.red (D.fromString (show txt)) <> ","

87 ,"but","I","need","entries","like"

88− ,P.green "\"elm-lang/core@6.0.0\"" <> "."

88+ ,D.green "\"elm-lang/core@6.0.0\"" <> "."

89 ]

91 BadAllPkg txt suggestion ->

92− ["The",P.red (P.text (show txt)),"value","is","not","a","valid","package","name."

92+ ["The",D.red (D.fromString (show txt)),"value","is","not","a","valid","package","name."

93 ]

94− ++ map P.text (words suggestion)

94+ ++ map D.fromString (words suggestion)

96 BadAllVsn txt ->

97− ["You","provided",P.red (P.text (show txt))

97+ ["You","provided",D.red (D.fromString (show txt))

98 ,"which","is","not","a","valid","version.","I","need","something","like"

99− ,P.green "\"1.0.0\"","or",P.green "\"2.0.4\"" <> "."

99+ ,D.green "\"1.0.0\"","or",D.green "\"2.0.4\"" <> "."

100 ]

101

builder/src/Reporting/Exit/Publish.hs+45−46

@@ -6,11 +6,10 @@ module Reporting.Exit.Publish

6 where

9−import qualified Text.PrettyPrint.ANSI.Leijen as P

10−import Text.PrettyPrint.ANSI.Leijen ((<>))

11−

12import Deps.Diff (Magnitude, magnitudeToString)

9import Deps.Diff (Magnitude, magnitudeToString)

13import qualified Elm.Package as Pkg

10import qualified Elm.Package as Pkg

11+import Reporting.Doc ((<>))

12+import qualified Reporting.Doc as D

14import qualified Reporting.Exit.Help as Help

13import qualified Reporting.Exit.Help as Help

@@ -46,52 +45,52 @@ toReport exit =

47 NotInitialVersion vsn ->

46 NotInitialVersion vsn ->

48 Help.docReport "INVALID VERSION" Nothing

47 Help.docReport "INVALID VERSION" Nothing

49− ( P.fillSep

48+ ( D.fillSep

50 ["I","cannot","publish"

49 ["I","cannot","publish"

51− ,P.red (P.text (Pkg.versionToString vsn))

50+ ,D.red (D.fromString (Pkg.versionToString vsn))

52 ,"as","the","initial","version."

51 ,"as","the","initial","version."

53 ]

52 ]

54 )

53 )

55− [ P.fillSep

54+ [ D.fillSep

56− ["Change","it","to",P.green "1.0.0","which","is"

55+ ["Change","it","to",D.green "1.0.0","which","is"

57 ,"the","initial","version","for","all","Elm","packages."

56 ,"the","initial","version","for","all","Elm","packages."

58 ]

57 ]

59 ]

58 ]

61 AlreadyPublished vsn ->

60 AlreadyPublished vsn ->

62 Help.docReport "ALREADY PUBLISHED" Nothing

61 Help.docReport "ALREADY PUBLISHED" Nothing

63− ( P.vcat

62+ ( D.vcat

64− [ P.fillSep

63+ [ D.fillSep

65− [ "Version", P.green (P.text (Pkg.versionToString vsn))

64+ [ "Version", D.green (D.fromString (Pkg.versionToString vsn))

66 , "has", "already", "been", "published.", "You", "cannot"

65 , "has", "already", "been", "published.", "You", "cannot"

67 , "publish", "it", "again!"

66 , "publish", "it", "again!"

68 ]

67 ]

69 , "Try using the `bump` command:"

68 , "Try using the `bump` command:"

70 ]

69 ]

71 )

70 )

72− [ P.dullyellow $ P.indent 4 $ P.text "elm bump"

71+ [ D.dullyellow $ D.indent 4 "elm bump"

73− , Help.reflow $

72+ , D.reflow $

74 "It computes the version number based on API changes, ensuring\

73 "It computes the version number based on API changes, ensuring\

75 \ that no breaking changes end up in PATCH releases!"

74 \ that no breaking changes end up in PATCH releases!"

76 ]

75 ]

78 InvalidBump statedVersion latestVersion ->

77 InvalidBump statedVersion latestVersion ->

79 Help.docReport "INVALID VERSION" (Just "elm.json")

78 Help.docReport "INVALID VERSION" (Just "elm.json")

80− ( P.fillSep $

79+ ( D.fillSep $

81 ["Your","elm.json","says","the","next","version","should","be"

80 ["Your","elm.json","says","the","next","version","should","be"

82− ,P.red (P.text (Pkg.versionToString statedVersion)) <> ","

81+ ,D.red (D.fromString (Pkg.versionToString statedVersion)) <> ","

83 ,"but","that","is","not","valid","based","on","the","previously"

82 ,"but","that","is","not","valid","based","on","the","previously"

84 ,"published","versions."

83 ,"published","versions."

85 ]

84 ]

86 )

85 )

87− [ P.fillSep $

86+ [ D.fillSep $

88 ["Change","the","version","back","to"

87 ["Change","the","version","back","to"

89− ,P.green (P.text (Pkg.versionToString latestVersion))

88+ ,D.green (D.fromString (Pkg.versionToString latestVersion))

90 ,"which","is","the","most","recently","published","version."

89 ,"which","is","the","most","recently","published","version."

91 ,"From","there,","have","Elm","bump","the","version","by","running:"

90 ,"From","there,","have","Elm","bump","the","version","by","running:"

92 ]

91 ]

93− , P.indent 4 $ P.green "elm bump"

92+ , D.indent 4 $ D.green "elm bump"

94− , Help.reflow $

93+ , D.reflow $

95 "If you want more insight on the API changes Elm detects, you\

94 "If you want more insight on the API changes Elm detects, you\

96 \ can run `elm diff` at this point as well."

95 \ can run `elm diff` at this point as well."

97 ]

96 ]

@@ -99,51 +98,51 @@ toReport exit =

99 BadBump old new magnitude realNew realMagnitude ->

98 BadBump old new magnitude realNew realMagnitude ->

100 Help.docReport "INVALID VERSION" (Just "elm.json")

99 Help.docReport "INVALID VERSION" (Just "elm.json")

101 (

100 (

102− P.fillSep $

101+ D.fillSep $

103 ["Your","elm.json","says","the","next","version","should","be"

102 ["Your","elm.json","says","the","next","version","should","be"

104− ,P.red (P.text (Pkg.versionToString new)) <> ","

103+ ,D.red (D.fromString (Pkg.versionToString new)) <> ","

105− ,"indicating","a",P.text (magnitudeToString magnitude)

104+ ,"indicating","a",D.fromString (magnitudeToString magnitude)

106 ,"change","to","the","public","API."

105 ,"change","to","the","public","API."

107 ,"This","does","not","match","the","API","diff","given","by:"

106 ,"This","does","not","match","the","API","diff","given","by:"

108 ]

107 ]

109 )

108 )

110− [ P.indent 4 $ P.text $

109+ [ D.indent 4 $ D.fromString $

111 "elm diff " ++ Pkg.versionToString old

110 "elm diff " ++ Pkg.versionToString old

112

111

113− , P.fillSep $

112+ , D.fillSep $

114 ["This","command","says","this","is","a"

113 ["This","command","says","this","is","a"

115− ,P.text (magnitudeToString realMagnitude)

114+ ,D.fromString (magnitudeToString realMagnitude)

116 ,"change,","so","the","next","version","should","be"

115 ,"change,","so","the","next","version","should","be"

117− ,P.green (P.text (Pkg.versionToString realNew)) <> "."

116+ ,D.green (D.fromString (Pkg.versionToString realNew)) <> "."

118 ,"Double","check","everything","to","make","sure","you"

117 ,"Double","check","everything","to","make","sure","you"

119 ,"are","publishing","what","you","want!"

118 ,"are","publishing","what","you","want!"

120 ]

119 ]

121− , Help.reflow $

120+ , D.reflow $

122 "Also, next time use `elm bump` and I'll figure all this out for you!"

121 "Also, next time use `elm bump` and I'll figure all this out for you!"

123 ]

122 ]

124

123

125 NoSummary ->

124 NoSummary ->

126 Help.docReport "NO SUMMARY" (Just "elm.json")

125 Help.docReport "NO SUMMARY" (Just "elm.json")

127− ( P.fillSep $

126+ ( D.fillSep $

128 [ "To", "publish", "a", "package,", "your", "elm.json", "must"

127 [ "To", "publish", "a", "package,", "your", "elm.json", "must"

129− , "have", "a", P.dullyellow "\"summary\"", "field", "that", "gives"

128+ , "have", "a", D.dullyellow "\"summary\"", "field", "that", "gives"

130 , "a", "consice", "overview", "of", "your", "project."

129 , "a", "consice", "overview", "of", "your", "project."

131 ]

130 ]

132 )

131 )

133− [ Help.reflow $

132+ [ D.reflow $

134 "The summary must be less than 80 characters. It should describe\

133 "The summary must be less than 80 characters. It should describe\

135 \ the concrete use of your package as clearly and as plainly as possible."

134 \ the concrete use of your package as clearly and as plainly as possible."

136 ]

135 ]

137

136

138 NoExposed ->

137 NoExposed ->

139 Help.docReport "NO EXPOSED MODULES" (Just "elm.json")

138 Help.docReport "NO EXPOSED MODULES" (Just "elm.json")

140− ( P.fillSep $

139+ ( D.fillSep $

141 [ "To", "publish", "a", "package,", "the"

140 [ "To", "publish", "a", "package,", "the"

142− , P.dullyellow "\"exposed-modules\"", "field", "of", "your"

141+ , D.dullyellow "\"exposed-modules\"", "field", "of", "your"

143 , "elm.json", "must", "list", "at", "least", "one", "module."

142 , "elm.json", "must", "list", "at", "least", "one", "module."

144 ]

143 ]

145 )

144 )

146− [ Help.reflow $

145+ [ D.reflow $

147 "What is the point of a package that has no modules?!"

146 "What is the point of a package that has no modules?!"

148 ]

147 ]

149

148

@@ -162,7 +161,7 @@ toReport exit =

162 "By publishing a package you are inviting the Elm community to build\

161 "By publishing a package you are inviting the Elm community to build\

163 \ upon your work. But without knowing your license, we have no idea if\

162 \ upon your work. But without knowing your license, we have no idea if\

164 \ that is legal!"

163 \ that is legal!"

165− [ Help.reflow $

164+ [ D.reflow $

166 "Once you pick an OSI approved license from <https://spdx.org/licenses/>,\

165 "Once you pick an OSI approved license from <https://spdx.org/licenses/>,\

167 \ you must share that choice in two places. First, the license\

166 \ you must share that choice in two places. First, the license\

168 \ identifier must appear in your elm.json file. Second, the full\

167 \ identifier must appear in your elm.json file. Second, the full\

@@ -173,16 +172,16 @@ toReport exit =

173 MissingTag version ->

172 MissingTag version ->

174 let vsn = Pkg.versionToString version in

173 let vsn = Pkg.versionToString version in

175 Help.docReport "NO TAG" Nothing

174 Help.docReport "NO TAG" Nothing

176− ( P.fillSep $

175+ ( D.fillSep $

177 [ "Packages", "must", "be", "tagged", "in", "git,", "but", "I"

176 [ "Packages", "must", "be", "tagged", "in", "git,", "but", "I"

178− , "cannot", "find", "a", P.green (P.text vsn), "tag."

177+ , "cannot", "find", "a", D.green (D.fromString vsn), "tag."

179 ]

178 ]

180 )

179 )

181− [ P.vcat

180+ [ D.vcat

182 [ "These tags make it possible to find this specific version on GitHub."

181 [ "These tags make it possible to find this specific version on GitHub."

183 , "To tag the most recent commit and push it to GitHub, run this:"

182 , "To tag the most recent commit and push it to GitHub, run this:"

184 ]

183 ]

185− , P.indent 4 $ P.dullyellow $ P.vcat $ map P.text $

184+ , D.indent 4 $ D.dullyellow $ D.vcat $ map D.fromString $

186 [ "git tag -a alpha-" ++ vsn ++ " -m \"preparing for Elm 0.19\""

185 [ "git tag -a alpha-" ++ vsn ++ " -m \"preparing for Elm 0.19\""

187 , "git push origin alpha-" ++ vsn

186 , "git push origin alpha-" ++ vsn

188 ]

187 ]

@@ -193,27 +192,27 @@ toReport exit =

193 Help.report "NO GIT" Nothing

192 Help.report "NO GIT" Nothing

194 "I searched your PATH environment variable for `git` and could not\

193 "I searched your PATH environment variable for `git` and could not\

195 \ find it. Is it available through your PATH?"

194 \ find it. Is it available through your PATH?"

196− [ Help.reflow $

195+ [ D.reflow $

197 "Who cares about this? Well, I currently use `git` to check if there\

196 "Who cares about this? Well, I currently use `git` to check if there\

198 \ are any local changes in your code. Local changes are a good sign\

197 \ are any local changes in your code. Local changes are a good sign\

199 \ that some important improvements have gotten mistagged, so this\

198 \ that some important improvements have gotten mistagged, so this\

200 \ check can be extremely helpful for package authors!"

199 \ check can be extremely helpful for package authors!"

201− , Help.note $

200+ , D.toSimpleNote $

202 "We plan to do this without the `git` binary in a future release."

201 "We plan to do this without the `git` binary in a future release."

203 ]

202 ]

204

203

205 LocalChanges version ->

204 LocalChanges version ->

206 let vsn = Pkg.versionToString version in

205 let vsn = Pkg.versionToString version in

207 Help.docReport "LOCAL CHANGES" Nothing

206 Help.docReport "LOCAL CHANGES" Nothing

208− ( P.fillSep $

207+ ( D.fillSep $

209− [ "The", "code", "tagged", "as", P.green (P.text vsn), "in"

208+ [ "The", "code", "tagged", "as", D.green (D.fromString vsn), "in"

210 , "git", "does", "not", "match", "the", "code", "in", "your"

209 , "git", "does", "not", "match", "the", "code", "in", "your"

211 , "working", "directory.", "This", "means", "you", "have"

210 , "working", "directory.", "This", "means", "you", "have"

212 , "commits", "or", "local", "changes", "that", "are", "not"

211 , "commits", "or", "local", "changes", "that", "are", "not"

213 , "going", "to", "be", "published!"

212 , "going", "to", "be", "published!"

214 ]

213 ]

215 )

214 )

216− [ Help.note $

215+ [ D.toSimpleNote $

217 "If you are sure everything is in order, you can run `git checkout "

216 "If you are sure everything is in order, you can run `git checkout "

218 ++ vsn ++ "` and publish your code from there."

217 ++ vsn ++ "` and publish your code from there."

219 ]

218 ]

@@ -222,17 +221,17 @@ toReport exit =

222badReadmeReport :: String -> String -> Help.Report

221badReadmeReport :: String -> String -> Help.Report

223badReadmeReport title summary =

222badReadmeReport title summary =

224 Help.report title (Just "README.md") summary

223 Help.report title (Just "README.md") summary

225− [ Help.reflow $

224+ [ D.reflow $

226 "When people look at your README, they are wondering:"

225 "When people look at your README, they are wondering:"

227− , P.vcat

226+ , D.vcat

228 [ " - What does this package even do?"

227 [ " - What does this package even do?"

229 , " - Will it help me solve MY problems?"

228 , " - Will it help me solve MY problems?"

230 ]

229 ]

231− , Help.reflow $

230+ , D.reflow $

232 "So I recommend starting your README with a small example of the\

231 "So I recommend starting your README with a small example of the\

233 \ most common usage scenario. Show people what they can expect if\

232 \ most common usage scenario. Show people what they can expect if\

234 \ they learn more!"

233 \ they learn more!"

235− , Help.note $

234+ , D.toSimpleNote $

236 "By publishing your package, you are inviting people to invest time\

235 "By publishing your package, you are inviting people to invest time\

237 \ in understanding your work. Spending an hour to communicate your\

236 \ in understanding your work. Spending an hour to communicate your\

238 \ knowledge more clearly can save the community days or weeks of time\

237 \ knowledge more clearly can save the community days or weeks of time\

builder/src/Reporting/Progress/Terminal.hs+19−21

@@ -1,3 +1,4 @@

1+{-# LANGUAGE OverloadedStrings #-}

1module Reporting.Progress.Terminal

2module Reporting.Progress.Terminal

2 ( create

3 ( create

3 , newPackageOverview

4 , newPackageOverview

@@ -10,12 +11,12 @@ import Control.Concurrent.Chan (Chan, newChan, readChan)

10import Control.Concurrent.MVar (newEmptyMVar, putMVar)

11import Control.Concurrent.MVar (newEmptyMVar, putMVar)

11import qualified System.Info as System

12import qualified System.Info as System

12import System.IO (hFlush, hPutStr, stdout)

13import System.IO (hFlush, hPutStr, stdout)

13−import Text.PrettyPrint.ANSI.Leijen ((<>), (<+>))

14−import qualified Text.PrettyPrint.ANSI.Leijen as P

15import qualified Elm.Package as Pkg

14import qualified Elm.Package as Pkg

16import Elm.Package (Name, Version)

15import Elm.Package (Name, Version)

18import qualified Deps.Diff as Diff

17import qualified Deps.Diff as Diff

18+import Reporting.Doc ((<>), (<+>))

19+import qualified Reporting.Doc as D

19import qualified Reporting.Exit as Exit

20import qualified Reporting.Exit as Exit

20import qualified Reporting.Exit.Help as Help

21import qualified Reporting.Exit.Help as Help

21import Reporting.Progress (Msg(..), Progress(..), Outcome(..), PublishPhase(..), BumpPhase(..))

22import Reporting.Progress (Msg(..), Progress(..), Outcome(..), PublishPhase(..), BumpPhase(..))

@@ -185,7 +186,7 @@ loopHelp chan progress state@(State total good bad) =

185

186

186 UnableToLoadLatestPackages ->

187 UnableToLoadLatestPackages ->

187 do putStrLn ""

188 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+ Help.toStdout $ D.dullyellow "WARNING:" <+> "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 putStrLn "here, but my request failed. Are you offline? I will try to continue anyway.\n"

190 loop chan state

191 loop chan state

191

192

@@ -194,38 +195,35 @@ loopHelp chan progress state@(State total good bad) =

194-- BULLETS

195-- BULLETS

195

196

197

197−makeBullet :: Name -> Version -> Outcome -> P.Doc

198+makeBullet :: Name -> Version -> Outcome -> D.Doc

198makeBullet name version outcome =

199makeBullet name version outcome =

199 let

200 let

200− nm =

201+ nm = D.fromText (Pkg.toText name)

201− P.text (Pkg.toString name)

202+ vsn = D.fromText (Pkg.versionToText version)

202−

203− vsn =

204− P.text (Pkg.versionToString version)

205

203

206 bullet =

204 bullet =

207 case outcome of

205 case outcome of

208 Good -> goodMark

206 Good -> goodMark

209 Bad -> badMark

207 Bad -> badMark

210 in

208 in

211− P.indent 2 $ bullet <+> nm <+> vsn <> P.text "\n"

209+ D.indent 2 $ bullet <+> nm <+> vsn <> "\n"

212

210

213

211

214−goodMark :: P.Doc

212+goodMark :: D.Doc

215goodMark =

213goodMark =

216− P.green $ P.text $

214+ D.green $

217 if System.os == "mingw32" then "+" else "●"

215 if System.os == "mingw32" then "+" else "●"

218

216

219

217

220−badMark :: P.Doc

218+badMark :: D.Doc

221badMark =

219badMark =

222− P.red $ P.text $

220+ D.red $

223 if System.os == "mingw32" then "X" else "✗"

221 if System.os == "mingw32" then "X" else "✗"

224

222

225

223

226−waitingMark :: P.Doc

224+waitingMark :: D.Doc

227waitingMark =

225waitingMark =

228− P.dullyellow $ P.text $

226+ D.dullyellow $

229 if System.os == "mingw32" then "-" else "→"

227 if System.os == "mingw32" then "-" else "→"

230

228

231

229

@@ -257,7 +255,7 @@ newPackageOverview =

257-- CHECKLIST

255-- CHECKLIST

258

256

259

257

260−toChecklistDoc :: Maybe Outcome -> ChecklistMessages -> P.Doc

258+toChecklistDoc :: Maybe Outcome -> ChecklistMessages -> D.Doc

261toChecklistDoc status (ChecklistMessages waiting success failure) =

259toChecklistDoc status (ChecklistMessages waiting success failure) =

262 let

260 let

263 padded message =

261 padded message =

@@ -265,13 +263,13 @@ toChecklistDoc status (ChecklistMessages waiting success failure) =

265 in

263 in

266 case status of

264 case status of

267 Nothing ->

265 Nothing ->

268− P.text " " <> waitingMark <+> P.text waiting

266+ " " <> waitingMark <+> D.fromString waiting

269

267

270 Just Good ->

268 Just Good ->

271− P.text "\r " <> goodMark <+> P.text (padded success ++ "\n")

269+ "\r " <> goodMark <+> D.fromString (padded success ++ "\n")

272

270

273 Just Bad ->

271 Just Bad ->

274− P.text "\r " <> badMark <+> P.text (padded failure ++ "\n\n")

272+ "\r " <> badMark <+> D.fromString (padded failure ++ "\n\n")

275

273

276

274

277data ChecklistMessages =

275data ChecklistMessages =

@@ -326,7 +324,7 @@ toChecklistMessages phase =

326-- BUMP PHASE

324-- BUMP PHASE

327

325

328

326

329−bumpPhaseToChecklistDoc :: Pkg.Version -> BumpPhase -> P.Doc

327+bumpPhaseToChecklistDoc :: Pkg.Version -> BumpPhase -> D.Doc

330bumpPhaseToChecklistDoc version bumpPhase =

328bumpPhaseToChecklistDoc version bumpPhase =

331 let

329 let

332 mkMsgs success =

330 mkMsgs success =

compiler/src/Json/Decode/Error.hs+13−14

@@ -11,11 +11,10 @@ import qualified Data.Char as Char

11import qualified Data.List as List

12import qualified Data.Map as Map

13import qualified Data.Text as Text

14−import Text.PrettyPrint.ANSI.Leijen ((<+>), (<>))

15−import qualified Text.PrettyPrint.ANSI.Leijen as P

17import qualified Json.Decode.Internals as Json

15import qualified Json.Decode.Internals as Json

18import qualified Json.Encode as E

16import qualified Json.Encode as E

17+import Reporting.Doc ((<+>), (<>))

19import qualified Reporting.Doc as D

18import qualified Reporting.Doc as D

20import qualified Reporting.Error.Syntax as Syntax

19import qualified Reporting.Error.Syntax as Syntax

21import qualified Reporting.Render.Code as Code

20import qualified Reporting.Render.Code as Code

@@ -57,7 +56,7 @@ toDoc rootName source userErrorToDocs err =

57 flatErrors ->

56 flatErrors ->

58 let

57 let

59 toNumberedDoc index flatErr =

58 toNumberedDoc index flatErr =

60− P.dullcyan ("(" <> P.int index <> ")") <+> flatErrorToDoc rootName [] userErrorToDocs flatErr

59+ D.dullcyan ("(" <> D.fromInt index <> ")") <+> flatErrorToDoc rootName [] userErrorToDocs flatErr

61 in

60 in

62 D.stack $

61 D.stack $

63 [ D.reflow $

62 [ D.reflow $

@@ -116,7 +115,7 @@ flatErrorToDoc rootName starter userErrorToDocs (FlatError accesses json theory

116

115

117accessToDoc :: String -> [String] -> D.Doc

116accessToDoc :: String -> [String] -> D.Doc

118accessToDoc rootName accesses =

117accessToDoc rootName accesses =

119− P.dullyellow (P.text (rootName ++ concat accesses))

118+ D.dullyellow (D.fromString (rootName ++ concat accesses))

120

119

121

120

122actualThing :: E.Value -> [D.Doc]

121actualThing :: E.Value -> [D.Doc]

@@ -126,7 +125,7 @@ actualThing json =

126 E.Object _ -> [D.red "object"]

125 E.Object _ -> [D.red "object"]

127 E.String _ -> [D.red "string"]

126 E.String _ -> [D.red "string"]

128 E.Boolean b -> [D.red (if b then "true" else "false"),"value"]

127 E.Boolean b -> [D.red (if b then "true" else "false"),"value"]

129− E.Integer n -> ["number",D.red (D.fromString (show n))]

128+ E.Integer n -> ["number",D.red (D.fromInt n)]

130 E.Number _ -> [D.red "number"]

129 E.Number _ -> [D.red "number"]

131 E.Null -> [D.red "null","value"]

130 E.Null -> [D.red "null","value"]

132

131

@@ -134,16 +133,16 @@ actualThing json =

134anExpectedThing :: Json.Type -> [D.Doc]

133anExpectedThing :: Json.Type -> [D.Doc]

135anExpectedThing tipe =

134anExpectedThing tipe =

136 case tipe of

135 case tipe of

137− Json.TObject -> ["an", P.green "OBJECT" <> "."]

136+ Json.TObject -> ["an", D.green "OBJECT" <> "."]

138− Json.TArray -> ["an", P.green "ARRAY" <> "."]

137+ Json.TArray -> ["an", D.green "ARRAY" <> "."]

139− Json.TString -> ["a", P.green "STRING" <> "."]

138+ Json.TString -> ["a", D.green "STRING" <> "."]

140− Json.TBool -> ["a", P.green "BOOLEAN" <> "."]

139+ Json.TBool -> ["a", D.green "BOOLEAN" <> "."]

141− Json.TInt -> ["an", P.green "INT" <> "."]

140+ Json.TInt -> ["an", D.green "INT" <> "."]

142− Json.TObjectWith field -> ["an",P.green "OBJECT","with","a",P.green ("\"" <> P.text (Text.unpack field) <> "\""),"field."]

141+ Json.TObjectWith field -> ["an",D.green "OBJECT","with","a",D.green ("\"" <> D.fromString (Text.unpack field) <> "\""),"field."]

143 Json.TArrayWith i len ->

142 Json.TArrayWith i len ->

144− ["a",D.green "longer",P.green "ARRAY" <> "."

143+ ["a",D.green "longer",D.green "ARRAY" <> "."

145− ,"I","need","index",P.text (show i) <> ",","but","this","array"

144+ ,"I","need","index",D.fromInt i <> ",","but","this","array"

146− ,"only","has",P.text (show len),"elements."

145+ ,"only","has",D.fromInt len,"elements."

147 ]

146 ]

148

147

149

148

compiler/src/Reporting/Doc.hs+52−45

@@ -3,10 +3,12 @@

3module Reporting.Doc

4 ( P.Doc

5 , (P.<+>), (<>)

6+ , P.cat, P.empty, P.fill, P.fillSep, P.hang

6− , P.cat, P.empty, P.fillSep, P.hang, P.hcat, P.hsep, P.indent, P.sep, P.vcat

7+ , P.hcat, P.hsep, P.indent, P.sep, P.vcat

7− , P.black, P.blue, P.green, P.magenta, P.dullyellow, P.red, P.dullred

8+ , P.red, P.magenta, P.green, P.blue, P.black

9+ , P.dullred, P.dullcyan, P.dullyellow

9− , fromString, fromText, fromName

11+ , fromString, fromText, fromName, fromInt

10 , toAnsi, toString, toLine

12 , toAnsi, toString, toLine

11 , encode

13 , encode

@@ -54,6 +56,11 @@ fromName name =

54 P.text (N.toString name)

56 P.text (N.toString name)

59+fromInt :: Int -> P.Doc

60+fromInt n =

61+ P.text (show n)

62+

63+

58-- TO STRING

65-- TO STRING

@@ -65,12 +72,12 @@ toAnsi handle doc =

66toString :: P.Doc -> String

73toString :: P.Doc -> String

67toString doc =

74toString doc =

68− P.displayS (P.renderPretty 1 80 doc) ""

75+ P.displayS (P.renderPretty 1 80 (P.plain doc)) ""

71toLine :: P.Doc -> String

78toLine :: P.Doc -> String

72toLine doc =

79toLine doc =

73− P.displayS (P.renderPretty 1 (div maxBound 2) doc) ""

80+ P.displayS (P.renderPretty 1 (div maxBound 2) (P.plain doc)) ""

@@ -224,22 +231,22 @@ noStyle =

224

231

225

232

226data Color

233data Color

227− = D_Red

234+ = Red

228− | V_Red

235+ | RED

229− | D_Magenta

236+ | Magenta

230− | V_Magenta

237+ | MAGENTA

231− | D_Yellow

238+ | Yellow

232− | V_Yellow

239+ | YELLOW

233− | D_Green

240+ | Green

234− | V_Green

241+ | GREEN

235− | D_Cyan

242+ | Cyan

236− | V_Cyan

243+ | CYAN

237− | D_Blue

244+ | Blue

238− | V_Blue

245+ | BLUE

239− | D_Black

246+ | Black

240− | V_Black

247+ | BLACK

241− | D_White

248+ | White

242− | V_White

249+ | WHITE

243

250

244

251

245toJsonHelp :: Style -> [TB.Builder] -> P.SimpleDoc -> [E.Value]

252toJsonHelp :: Style -> [TB.Builder] -> P.SimpleDoc -> [E.Value]

@@ -322,14 +329,14 @@ toColor layer intensity color =

322 in

329 in

323 Just $

330 Just $

324 case color of

331 case color of

325− Ansi.Red -> pick D_Red V_Red

332+ Ansi.Red -> pick Red RED

326− Ansi.Magenta -> pick D_Magenta V_Magenta

333+ Ansi.Magenta -> pick Magenta MAGENTA

327− Ansi.Yellow -> pick D_Yellow V_Yellow

334+ Ansi.Yellow -> pick Yellow YELLOW

328− Ansi.Green -> pick D_Green V_Green

335+ Ansi.Green -> pick Green GREEN

329− Ansi.Cyan -> pick D_Cyan V_Cyan

336+ Ansi.Cyan -> pick Cyan CYAN

330− Ansi.Blue -> pick D_Blue V_Blue

337+ Ansi.Blue -> pick Blue BLUE

331− Ansi.White -> pick D_White V_White

338+ Ansi.White -> pick White WHITE

332− Ansi.Black -> pick D_Black V_Black

339+ Ansi.Black -> pick Black BLACK

333

340

334

341

335encodeChunks :: Style -> [TB.Builder] -> E.Value

342encodeChunks :: Style -> [TB.Builder] -> E.Value

@@ -361,19 +368,19 @@ encodeColor :: Color -> E.Value

361encodeColor color =

368encodeColor color =

362 E.text $

369 E.text $

363 case color of

370 case color of

364− D_Red -> "red"

371+ Red -> "red"

365− V_Red -> "RED"

372+ RED -> "RED"

366− D_Magenta -> "magenta"

373+ Magenta -> "magenta"

367− V_Magenta -> "MAGENTA"

374+ MAGENTA -> "MAGENTA"

368− D_Yellow -> "yellow"

375+ Yellow -> "yellow"

369− V_Yellow -> "YELLOW"

376+ YELLOW -> "YELLOW"

370− D_Green -> "green"

377+ Green -> "green"

371− V_Green -> "GREEN"

378+ GREEN -> "GREEN"

372− D_Cyan -> "cyan"

379+ Cyan -> "cyan"

373− V_Cyan -> "CYAN"

380+ CYAN -> "CYAN"

374− D_Blue -> "blue"

381+ Blue -> "blue"

375− V_Blue -> "BLUE"

382+ BLUE -> "BLUE"

376− D_Black -> "black"

383+ Black -> "black"

377− V_Black -> "BLACK"

384+ BLACK -> "BLACK"

378− D_White -> "white"

385+ White -> "white"

379− V_White -> "WHITE"

386+ WHITE -> "WHITE"

compiler/src/Reporting/Error/Pattern.hs+1−1

@@ -123,7 +123,7 @@ patternToDoc context pattern =

123 D.fromText ("\"" <> str <> "\"")

124

125 P.Int int ->

126− D.fromString (show int)

126+ D.fromInt int

127

128 NonList (P.Ctor _ "#0" []) ->

129 "()"

compiler/src/Reporting/Report.hs+34−31

@@ -8,8 +8,7 @@ module Reporting.Report

8 where

11−import Text.PrettyPrint.ANSI.Leijen (Doc, (<>), hardline, dullcyan, text)

11+import qualified Reporting.Doc as D

12−

13import qualified Reporting.Region as R

12import qualified Reporting.Region as R

14import qualified Reporting.Render.Code as Code

13import qualified Reporting.Render.Code as Code

@@ -23,25 +22,27 @@ data Report =

23 { _title :: String

22 { _title :: String

24 , _region :: R.Region

23 , _region :: R.Region

25 , _sgstns :: [String]

24 , _sgstns :: [String]

26− , _message :: Doc

25+ , _message :: D.Doc

27 }

26 }

30−toDoc :: FilePath -> Report -> Doc

29+toDoc :: FilePath -> Report -> D.Doc

31toDoc filePath (Report title _ _ message) =

30toDoc filePath (Report title _ _ message) =

31+ D.vcat

32− messageBar title filePath

32+ [ messageBar title filePath

33− <> hardline <> hardline <>

33+ , ""

34− message

34+ , message

35− <> hardline <> hardline

35+ , ""

36+ ]

38−messageBar :: String -> FilePath -> Doc

39+messageBar :: String -> FilePath -> D.Doc

39messageBar title filePath =

40messageBar title filePath =

40 let

41 let

41 usedSpace =

42 usedSpace =

42 4 + length title + 1 + length filePath

43 4 + length title + 1 + length filePath

43 in

44 in

44− dullcyan $ text $

45+ D.dullcyan $ D.fromString $

45 "-- " ++ title

46 "-- " ++ title

46 ++ " " ++ replicate (max 1 (80 - usedSpace)) '-'

47 ++ " " ++ replicate (max 1 (80 - usedSpace)) '-'

47 ++ " " ++ filePath

48 ++ " " ++ filePath

@@ -51,32 +52,34 @@ messageBar title filePath =

51-- CODE FORMATTING

52-- CODE FORMATTING

54−toCodeSnippet :: Code.Source -> R.Region -> Maybe R.Region -> (Doc, Doc) -> Doc

55+toCodeSnippet :: Code.Source -> R.Region -> Maybe R.Region -> (D.Doc, D.Doc) -> D.Doc

55toCodeSnippet source region highlight (preHint, postHint) =

56toCodeSnippet source region highlight (preHint, postHint) =

57+ D.vcat

56− preHint

58+ [ preHint

57− <> hardline <> hardline <>

59+ , ""

58− Code.render source region highlight

60+ , Code.render source region highlight

59− <> hardline <>

60− postHint

61+ , postHint

62+ ]

63−toCodePair :: Code.Source -> R.Region -> R.Region -> (Doc, Doc) -> (Doc, Doc, Doc) -> Doc

65+toCodePair :: Code.Source -> R.Region -> R.Region -> (D.Doc, D.Doc) -> (D.Doc, D.Doc, D.Doc) -> D.Doc

64toCodePair source r1 r2 (oneStart, oneEnd) (twoStart, twoMiddle, twoEnd) =

66toCodePair source r1 r2 (oneStart, oneEnd) (twoStart, twoMiddle, twoEnd) =

65 case Code.renderPair source r1 r2 of

67 case Code.renderPair source r1 r2 of

66 Code.OneLine codeDocs ->

68 Code.OneLine codeDocs ->

69+ D.vcat

67− oneStart

70+ [ oneStart

68− <> hardline <> hardline <>

71+ , ""

69− codeDocs

72+ , codeDocs

70− <> hardline <>

71− oneEnd

73+ , oneEnd

74+ ]

73 Code.TwoChunks code1 code2 ->

76 Code.TwoChunks code1 code2 ->

77+ D.vcat

74− twoStart

78+ [ twoStart

75− <> hardline <> hardline <>

79+ , ""

76− code1

80+ , code1

77− <> hardline <>

78− twoMiddle

81+ , twoMiddle

79− <> hardline <> hardline <>

82+ , ""

80− code2

83+ , code2

81− <> hardline <>

82− twoEnd

84+ , twoEnd

85+ ]