git.iko.soy/elk
on c19392f help sign in
elk/src/Reporting/Helpers.hs
259 lines 5.5 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module 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
13 , commaSep, capitalize, ordinalize, drawCycle
14 , findPotentialTypos, findTypoPairs, vetTypos
15 , nearbyNames, distance, maybeYouWant, maybeYouWant'
16 )
17 where
19import Data.Function (on)
20import qualified Data.Char as Char
21import qualified Data.List as List
22import qualified Data.Map as Map
23import Data.Monoid ((<>))
24import qualified Data.Set as Set
25import qualified Data.Text as Text
26import Data.Text (Text)
27import qualified Text.EditDistance as Dist
28import qualified Text.PrettyPrint.ANSI.Leijen as P
29import Text.PrettyPrint.ANSI.Leijen hiding ((<>), text)
31import qualified AST.Helpers as Help
32import qualified Elm.Compiler.Version as Compiler
33import qualified Elm.Package as Pkg
37-- PIPES
40(|>) :: a -> (a -> b) -> b
41(|>) x f =
42 f x
45infixl 0 |>
49-- DOC HELPERS
52text :: Text -> Doc
53text msg =
54 P.text (Text.unpack msg)
57i2t :: Int -> Text
58i2t n =
59 Text.pack (show n)
62functionName :: Text -> Text
63functionName opName =
64 if Help.isOp opName then
65 "(" <> opName <> ")"
67 else
68 "`" <> opName <> "`"
71args :: Int -> Text
72args n =
73 i2t n <> if n == 1 then " argument" else " arguments"
76moreArgs :: Int -> Text
77moreArgs n =
78 i2t n <> " more" <> if n == 1 then " argument" else " arguments"
82-- HINTS
85toSimpleHint :: Text -> Doc
86toSimpleHint txt =
87 toFancyHint (map text (Text.words txt))
90toFancyHint :: [Doc] -> Doc
91toFancyHint chunks =
92 fillSep (underline (text "Hint") <> ":" : chunks)
95hintLink :: Text -> Text
96hintLink fileName =
97 "<https://github.com/elm-lang/elm-compiler/blob/"
98 <> Text.pack (Pkg.versionToString Compiler.version)
99 <> "/hints/" <> fileName <> ".md>"
102stack :: [Doc] -> Doc
103stack chunks =
104 case chunks of
105 [] ->
106 error "function `stack` requires a non-empty list of docs"
108 doc : docs ->
109 List.foldl' (\a b -> a <> hardline <> hardline <> b) doc docs
112reflowParagraph :: Text -> Doc
113reflowParagraph paragraph =
114 fillSep (map text (Text.words paragraph))
117commaSep :: [Text] -> Text
118commaSep tokens =
119 case tokens of
120 [token] ->
121 " " <> token
123 [token1,token2] ->
124 " " <> token1 <> " and " <> token2
126 _ ->
127 " " <> Text.intercalate ", " (init tokens) <> ", and " <> last tokens
130capitalize :: Text -> Text
131capitalize txt =
132 case Text.uncons txt of
133 Nothing ->
134 txt
136 Just (c, rest) ->
137 Text.cons (Char.toUpper c) rest
140ordinalize :: Int -> Text
141ordinalize number =
142 let
143 remainder10 =
144 number `mod` 10
146 remainder100 =
147 number `mod` 100
149 ending
150 | remainder100 `elem` [11..13] = "th"
151 | remainder10 == 1 = "st"
152 | remainder10 == 2 = "nd"
153 | remainder10 == 3 = "rd"
154 | otherwise = "th"
155 in
156 i2t number <> ending
160drawCycle :: [Text] -> Doc
161drawCycle names =
162 let
163 topLine =
164 text "┌─────┐"
166 nameLine name =
167 text "│ " <> dullyellow (text name)
169 midLine =
170 text "│ ↓"
172 bottomLine =
173 text "└─────┘"
174 in
175 vcat (topLine : List.intersperse midLine (map nameLine names) ++ [ bottomLine ])
179-- FIND TYPOS
182findPotentialTypos :: [Text] -> Text -> [Text]
183findPotentialTypos knownNames badName =
184 filter ((==1) . distance badName) knownNames
187findTypoPairs :: [Text] -> [Text] -> [(Text, Text)]
188findTypoPairs leftOnly rightOnly =
189 let
190 veryNear leftName =
191 map ((,) leftName) (findPotentialTypos rightOnly leftName)
192 in
193 concatMap veryNear leftOnly
196vetTypos :: [(Text, Text)] -> Maybe (Set.Set Text, Set.Set Text)
197vetTypos potentialTypos =
198 let
199 tallyNames (ln, rn) (lc, rc) =
200 ( Map.insertWith (+) ln 1 lc
201 , Map.insertWith (+) rn 1 rc
202 )
204 (leftCounts, rightCounts) =
205 foldr tallyNames (Map.empty, Map.empty) potentialTypos
207 acceptable :: Map.Map Text Int -> Bool
208 acceptable counts =
209 not (Map.null counts)
210 &&
211 Map.foldr (\n unique -> n < 2 && unique) True counts
212 in
213 if acceptable leftCounts && acceptable rightCounts then
214 Just (Map.keysSet leftCounts, Map.keysSet rightCounts)
216 else
217 Nothing
221-- NEARBY NAMES
224nearbyNames :: (a -> Text) -> a -> [a] -> [a]
225nearbyNames format name names =
226 let editDistance =
227 if Text.length (format name) < 3 then 1 else 2
228 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
236distance :: Text -> Text -> Int
237distance x y =
238 Dist.restrictedDamerauLevenshteinDistance
239 Dist.defaultEditCosts
240 (Text.unpack x)
241 (Text.unpack y)
244maybeYouWant :: Maybe Doc -> [Text] -> Doc
245maybeYouWant maybeStarter suggestions =
246 maybe P.empty id (maybeYouWant' maybeStarter suggestions)
249maybeYouWant' :: Maybe Doc -> [Text] -> Maybe Doc
250maybeYouWant' maybeStarter suggestions =
251 case suggestions of
252 [] ->
253 maybeStarter
255 _:_ ->
256 Just $ stack $
257 [ maybe id (<+>) maybeStarter "Maybe you want one of the following?"
258 , P.indent 4 $ P.vcat $ map (P.dullyellow . text) (take 4 suggestions)
259 ]