git.iko.soy/elk
on fbff9ce help sign in
elk/src/Reporting/Helpers.hs
257 lines 5.4 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Helpers
4 ( (|>)
5 -- re-exports
6 , Doc, (<+>), (<>), cat, dullyellow, fillSep, hang
7 , hsep, indent, parens, sep, text, underline, vcat
8 -- custom helpers
9 , i2t
10 , functionName, args, moreArgs
11 , toHint, hintLink, stack, reflowParagraph
12 , commaSep, capitalize, ordinalize, drawCycle
13 , findPotentialTypos, findTypoPairs, vetTypos
14 , nearbyNames, distance, maybeYouWant, maybeYouWant'
15 )
16 where
18import Data.Function (on)
19import qualified Data.Char as Char
20import qualified Data.List as List
21import qualified Data.Map as Map
22import Data.Monoid ((<>))
23import qualified Data.Set as Set
24import qualified Data.Text as Text
25import Data.Text (Text)
26import qualified Text.EditDistance as Dist
27import qualified Text.PrettyPrint.ANSI.Leijen as P
28import Text.PrettyPrint.ANSI.Leijen hiding ((<>), text)
30import qualified AST.Helpers as Help
31import qualified Elm.Compiler.Version as Compiler
32import qualified Elm.Package as Pkg
36-- PIPES
39(|>) :: a -> (a -> b) -> b
40(|>) x f =
41 f x
44infixl 0 |>
48-- DOC HELPERS
51text :: Text -> Doc
52text msg =
53 P.text (Text.unpack msg)
56i2t :: Int -> Text
57i2t n =
58 Text.pack (show n)
61functionName :: Text -> Text
62functionName opName =
63 if Help.isOp opName then
64 "(" <> opName <> ")"
66 else
67 "`" <> opName <> "`"
70args :: Int -> Text
71args n =
72 i2t n <> if n == 1 then " argument" else " arguments"
75moreArgs :: Int -> Text
76moreArgs n =
77 i2t n <> " more" <> if n == 1 then " argument" else " arguments"
81-- HINTS
84toHint :: Text -> Doc
85toHint txt =
86 let
87 hint =
88 underline (text "Hint") <> ":"
89 in
90 fillSep (hint : map text (Text.words txt))
93hintLink :: Text -> Text
94hintLink fileName =
95 "<https://github.com/elm-lang/elm-compiler/blob/"
96 <> Text.pack (Pkg.versionToString Compiler.version)
97 <> "/hints/" <> fileName <> ".md>"
100stack :: [Doc] -> Doc
101stack chunks =
102 case chunks of
103 [] ->
104 error "function `stack` requires a non-empty list of docs"
106 doc : docs ->
107 List.foldl' (\a b -> a <> hardline <> hardline <> b) doc docs
110reflowParagraph :: Text -> Doc
111reflowParagraph paragraph =
112 fillSep (map text (Text.words paragraph))
115commaSep :: [Text] -> Text
116commaSep tokens =
117 case tokens of
118 [token] ->
119 " " <> token
121 [token1,token2] ->
122 " " <> token1 <> " and " <> token2
124 _ ->
125 " " <> Text.intercalate ", " (init tokens) <> ", and " <> last tokens
128capitalize :: Text -> Text
129capitalize txt =
130 case Text.uncons txt of
131 Nothing ->
132 txt
134 Just (c, rest) ->
135 Text.cons (Char.toUpper c) rest
138ordinalize :: Int -> Text
139ordinalize number =
140 let
141 remainder10 =
142 number `mod` 10
144 remainder100 =
145 number `mod` 100
147 ending
148 | remainder100 `elem` [11..13] = "th"
149 | remainder10 == 1 = "st"
150 | remainder10 == 2 = "nd"
151 | remainder10 == 3 = "rd"
152 | otherwise = "th"
153 in
154 i2t number <> ending
158drawCycle :: [Text] -> Doc
159drawCycle names =
160 let
161 topLine =
162 text "┌─────┐"
164 nameLine name =
165 text "│ " <> dullyellow (text name)
167 midLine =
168 text "│ ↓"
170 bottomLine =
171 text "└─────┘"
172 in
173 vcat (topLine : List.intersperse midLine (map nameLine names) ++ [ bottomLine ])
177-- FIND TYPOS
180findPotentialTypos :: [Text] -> Text -> [Text]
181findPotentialTypos knownNames badName =
182 filter ((==1) . distance badName) knownNames
185findTypoPairs :: [Text] -> [Text] -> [(Text, Text)]
186findTypoPairs leftOnly rightOnly =
187 let
188 veryNear leftName =
189 map ((,) leftName) (findPotentialTypos rightOnly leftName)
190 in
191 concatMap veryNear leftOnly
194vetTypos :: [(Text, Text)] -> Maybe (Set.Set Text, Set.Set Text)
195vetTypos potentialTypos =
196 let
197 tallyNames (ln, rn) (lc, rc) =
198 ( Map.insertWith (+) ln 1 lc
199 , Map.insertWith (+) rn 1 rc
200 )
202 (leftCounts, rightCounts) =
203 foldr tallyNames (Map.empty, Map.empty) potentialTypos
205 acceptable :: Map.Map Text Int -> Bool
206 acceptable counts =
207 not (Map.null counts)
208 &&
209 Map.foldr (\n unique -> n < 2 && unique) True counts
210 in
211 if acceptable leftCounts && acceptable rightCounts then
212 Just (Map.keysSet leftCounts, Map.keysSet rightCounts)
214 else
215 Nothing
219-- NEARBY NAMES
222nearbyNames :: (a -> Text) -> a -> [a] -> [a]
223nearbyNames format name names =
224 let editDistance =
225 if Text.length (format name) < 3 then 1 else 2
226 in
227 names
228 |> map (\x -> (distance (format name) (format x), x))
229 |> List.sortBy (compare `on` fst)
230 |> filter ( (<= editDistance) . abs . fst )
231 |> map snd
234distance :: Text -> Text -> Int
235distance x y =
236 Dist.restrictedDamerauLevenshteinDistance
237 Dist.defaultEditCosts
238 (Text.unpack x)
239 (Text.unpack y)
242maybeYouWant :: Maybe Doc -> [Text] -> Doc
243maybeYouWant maybeStarter suggestions =
244 maybe P.empty id (maybeYouWant' maybeStarter suggestions)
247maybeYouWant' :: Maybe Doc -> [Text] -> Maybe Doc
248maybeYouWant' maybeStarter suggestions =
249 case suggestions of
250 [] ->
251 maybeStarter
253 _:_ ->
254 Just $ stack $
255 [ maybe id (<+>) maybeStarter "Maybe you want one of the following?"
256 , P.indent 4 $ P.vcat $ map (P.dullyellow . text) (take 4 suggestions)
257 ]