@@ -1,21 +1,22 @@
11{-# OPTIONS_GHC -Wall #-}
22{-# LANGUAGE OverloadedStrings #-}
33module Reporting.Helpers
4− ( (|>)
5− -- re-exports
6− , Doc, (<+>), (<>), cat, dullyellow, fillSep, green, hang
7− , hsep, indent, parens, sep, text, underline, vcat
8− -- custom helpers
9− , i2t
10− , functionName, args, moreArgs
11− , toSimpleHint, toFancyHint, hintLink
12− , stack, reflowParagraph
4+ ( textToDoc
5+ , nameToDoc
6+ , args, moreArgs
7+ , toSimpleNote, toSimpleHint, toFancyHint
8+ , link, reflowLink
9+ , stack, reflow
1310 , commaSep, capitalize, ordinalize, drawCycle
1411 , findPotentialTypos, findTypoPairs, vetTypos
1512 , nearbyNames, distance, maybeYouWant, maybeYouWant'
13+ -- re-exports
14+ , Doc, (<+>), (<>), black, cat, dullyellow, fillSep, green, hang, hardline
15+ , hcat, hsep, indent, magenta, parens, sep, text, underline, vcat
1616 )
1717 where
1818
19+
1920import Data.Function (on)
2021import qualified Data.Char as Char
2122import qualified Data.List as List
@@ -24,67 +25,51 @@ import Data.Monoid ((<>))
2425import qualified Data.Set as Set
2526import qualified Data.Text as Text
2627import Data.Text (Text)
28+import qualified Elm.Name as N
2729import qualified Text.EditDistance as Dist
2830import qualified Text.PrettyPrint.ANSI.Leijen as P
29−import Text.PrettyPrint.ANSI.Leijen hiding ((<>), text)
31+import Text.PrettyPrint.ANSI.Leijen hiding ((<>))
3032
31−import qualified AST.Helpers as Help
3233import qualified Elm.Compiler.Version as Compiler
3334import qualified Elm.Package as Pkg
3435
3536
3637
37−-- PIPES
38−
39−
40−(|>) :: a -> (a -> b) -> b
41−(|>) x f =
42− f x
43−
44−
45−infixl 0 |>
46−
47−
48−
4938-- DOC HELPERS
5039
5140
52−text :: Text -> Doc
53−text msg =
54− P.text (Text.unpack msg)
41+textToDoc :: Text -> Doc
42+textToDoc msg =
43+ text (Text.unpack msg)
5544
5645
57−i2t :: Int -> Text
58−i2t n =
59− Text.pack (show n)
46+nameToDoc :: N.Name -> Doc
47+nameToDoc name =
48+ text (N.toString name)
6049
6150
62−functionName :: Text -> Text
63−functionName opName =
64− if Help.isOp opName then
65− "(" <> opName <> ")"
66−
67− else
68− "`" <> opName <> "`"
69−
70−
71−args :: Int -> Text
51+args :: Int -> String
7252args n =
73− i2t n <> if n == 1 then " argument" else " arguments"
53+ show n <> if n == 1 then " argument" else " arguments"
7454
7555
76−moreArgs :: Int -> Text
56+moreArgs :: Int -> String
7757moreArgs n =
78− i2t n <> " more" <> if n == 1 then " argument" else " arguments"
58+ show n <> " more" <> if n == 1 then " argument" else " arguments"
7959
8060
8161
8262-- HINTS
8363
8464
85−toSimpleHint :: Text -> Doc
86−toSimpleHint txt =
87− toFancyHint (map text (Text.words txt))
65+toSimpleNote :: String -> Doc
66+toSimpleNote message =
67+ fillSep ((underline (text "Note") <> ":") : map text (words message))
68+
69+
70+toSimpleHint :: String -> Doc
71+toSimpleHint message =
72+ toFancyHint (map text (words message))
8873
8974
9075toFancyHint :: [Doc] -> Doc
@@ -92,11 +77,26 @@ toFancyHint chunks =
9277 fillSep (underline (text "Hint") <> ":" : chunks)
9378
9479
95−hintLink :: Text -> Text
96−hintLink fileName =
97− "<https://github.com/elm-lang/elm-compiler/blob/"
98− <> Text.pack (Pkg.versionToString Compiler.version)
99− <> "/hints/" <> fileName <> ".md>"
80+link :: Doc -> String -> String -> String -> Doc
81+link word before fileName after =
82+ fillSep $
83+ (underline word <> ":")
84+ : map text (words before)
85+ ++ P.text (makeLink fileName)
86+ : map text (words after)
87+
88+
89+makeLink :: String -> String
90+makeLink fileName =
91+ "<http://elm-lang.org/hints/" <> Pkg.versionToString Compiler.version <> "/" <> fileName <> ".md>"
92+
93+
94+reflowLink :: String -> String -> String -> Doc
95+reflowLink before fileName after =
96+ fillSep $
97+ map text (words before)
98+ ++ P.text (makeLink fileName)
99+ : map text (words after)
100100
101101
102102stack :: [Doc] -> Doc
@@ -109,22 +109,26 @@ stack chunks =
109109 List.foldl' (\a b -> a <> hardline <> hardline <> b) doc docs
110110
111111
112−reflowParagraph :: Text -> Doc
113−reflowParagraph paragraph =
114− fillSep (map text (Text.words paragraph))
112+reflow :: String -> Doc
113+reflow paragraph =
114+ fillSep (map text (words paragraph))
115115
116116
117−commaSep :: [Text] -> Text
118−commaSep tokens =
119− case tokens of
120− [token] ->
121− " " <> token
117+commaSep :: Doc -> (Doc -> Doc) -> [Doc] -> [Doc]
118+commaSep conjunction addStyle names =
119+ case names of
120+ [name] ->
121+ [ addStyle name ]
122122
123− [token1,token2] ->
124− " " <> token1 <> " and " <> token2
123+ [name1,name2] ->
124+ [ addStyle name1, conjunction, addStyle name2 ]
125125
126126 _ ->
127− " " <> Text.intercalate ", " (init tokens) <> ", and " <> last tokens
127+ map (\name -> addStyle name <> ",") (init names)
128+ ++
129+ [ conjunction
130+ , addStyle (last names)
131+ ]
128132
129133
130134capitalize :: Text -> Text
@@ -137,7 +141,7 @@ capitalize txt =
137141 Text.cons (Char.toUpper c) rest
138142
139143
140−ordinalize :: Int -> Text
144+ordinalize :: Int -> String
141145ordinalize number =
142146 let
143147 remainder10 =
@@ -153,24 +157,24 @@ ordinalize number =
153157 | remainder10 == 3 = "rd"
154158 | otherwise = "th"
155159 in
156− i2t number <> ending
160+ show number <> ending
157161
158162
159163
160−drawCycle :: [Text] -> Doc
164+drawCycle :: [N.Name] -> Doc
161165drawCycle names =
162166 let
163167 topLine =
164− text "┌─────┐"
168+ "┌─────┐"
165169
166170 nameLine name =
167− text "│ " <> dullyellow (text name)
171+ "│ " <> dullyellow (textToDoc name)
168172
169173 midLine =
170− text "│ ↓"
174+ "│ ↓"
171175
172176 bottomLine =
173− text "└─────┘"
177+ "└─────┘"
174178 in
175179 vcat (topLine : List.intersperse midLine (map nameLine names) ++ [ bottomLine ])
176180
@@ -179,12 +183,12 @@ drawCycle names =
179183-- FIND TYPOS
180184
181185
182−findPotentialTypos :: [Text] -> Text -> [Text]
186+findPotentialTypos :: [String] -> String -> [String]
183187findPotentialTypos knownNames badName =
184188 filter ((==1) . distance badName) knownNames
185189
186190
187−findTypoPairs :: [Text] -> [Text] -> [(Text, Text)]
191+findTypoPairs :: [String] -> [String] -> [(String, String)]
188192findTypoPairs leftOnly rightOnly =
189193 let
190194 veryNear leftName =
@@ -193,7 +197,7 @@ findTypoPairs leftOnly rightOnly =
193197 concatMap veryNear leftOnly
194198
195199
196−vetTypos :: [(Text, Text)] -> Maybe (Set.Set Text, Set.Set Text)
200+vetTypos :: [(String, String)] -> Maybe (Set.Set String, Set.Set String)
197201vetTypos potentialTypos =
198202 let
199203 tallyNames (ln, rn) (lc, rc) =
@@ -204,7 +208,7 @@ vetTypos potentialTypos =
204208 (leftCounts, rightCounts) =
205209 foldr tallyNames (Map.empty, Map.empty) potentialTypos
206210
207− acceptable :: Map.Map Text Int -> Bool
211+ acceptable :: Map.Map String Int -> Bool
208212 acceptable counts =
209213 not (Map.null counts)
210214 &&
@@ -221,32 +225,28 @@ vetTypos potentialTypos =
221225-- NEARBY NAMES
222226
223227
224−nearbyNames :: (a -> Text) -> a -> [a] -> [a]
228+nearbyNames :: (a -> String) -> a -> [a] -> [a]
225229nearbyNames format name names =
226230 let editDistance =
227− if Text.length (format name) < 3 then 1 else 2
231+ if length (format name) < 3 then 1 else 2
228232 in
229− names
230− |> map (\x -> (distance (format name) (format x), x))
231− |> List.sortBy (compare `on` fst)
232− |> filter ( (<= editDistance) . abs . fst )
233− |> map snd
233+ map snd $
234+ filter ( (<= editDistance) . abs . fst ) $
235+ List.sortBy (compare `on` fst) $
236+ map (\x -> (distance (format name) (format x), x)) names
234237
235238
236−distance :: Text -> Text -> Int
239+distance :: String -> String -> Int
237240distance x y =
238− Dist.restrictedDamerauLevenshteinDistance
239− Dist.defaultEditCosts
240− (Text.unpack x)
241− (Text.unpack y)
241+ Dist.restrictedDamerauLevenshteinDistance Dist.defaultEditCosts x y
242242
243243
244−maybeYouWant :: Maybe Doc -> [Text] -> Doc
244+maybeYouWant :: Maybe Doc -> [N.Name] -> Doc
245245maybeYouWant maybeStarter suggestions =
246246 maybe P.empty id (maybeYouWant' maybeStarter suggestions)
247247
248248
249−maybeYouWant' :: Maybe Doc -> [Text] -> Maybe Doc
249+maybeYouWant' :: Maybe Doc -> [N.Name] -> Maybe Doc
250250maybeYouWant' maybeStarter suggestions =
251251 case suggestions of
252252 [] ->
@@ -255,5 +255,5 @@ maybeYouWant' maybeStarter suggestions =
255255 _:_ ->
256256 Just $ stack $
257257 [ maybe id (<+>) maybeStarter "Maybe you want one of the following?"
258− , P.indent 4 $ P.vcat $ map (P.dullyellow . text) (take 4 suggestions)
258+ , P.indent 4 $ P.vcat $ map (P.dullyellow . nameToDoc) (take 4 suggestions)
259259 ]