git.iko.soy/elk
on e00a3f3 help sign in
elk/src/Reporting/Helpers.hs
235 lines 4.9 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Helpers
4 ( (|>)
5 -- re-exports
6 , Doc, (<+>), (<>), cat, colon, comma, dullyellow, equals, fillSep, hang
7 , hsep, indent, lbrace, lparen, parens, rbrace, rparen, sep, text, underline
8 , vcat
9 -- custom helpers
10 , i2t
11 , functionName, args
12 , hintLink, stack, reflowParagraph
13 , commaSep, capitalize, ordinalize, drawCycle
14 , findPotentialTypos, findTypoPairs, vetTypos
15 , nearbyNames, distance, 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"
76hintLink :: Text -> Text
77hintLink fileName =
78 "<https://github.com/elm-lang/elm-compiler/blob/"
79 <> Text.pack (Pkg.versionToString Compiler.version)
80 <> "/hints/" <> fileName <> ".md>"
83stack :: [Doc] -> Doc
84stack chunks =
85 case chunks of
86 [] ->
87 error "function `stack` requires a non-empty list of docs"
89 doc : docs ->
90 List.foldl' (\a b -> a <> hardline <> hardline <> b) doc docs
93reflowParagraph :: Text -> Doc
94reflowParagraph paragraph =
95 fillSep (map text (Text.words paragraph))
98commaSep :: [Text] -> Text
99commaSep tokens =
100 case tokens of
101 [token] ->
102 " " <> token
104 [token1,token2] ->
105 " " <> token1 <> " and " <> token2
107 _ ->
108 " " <> Text.intercalate ", " (init tokens) <> ", and " <> last tokens
111capitalize :: Text -> Text
112capitalize txt =
113 case Text.uncons txt of
114 Nothing ->
115 txt
117 Just (c, rest) ->
118 Text.cons (Char.toUpper c) rest
121ordinalize :: Int -> Text
122ordinalize number =
123 let
124 remainder10 =
125 number `mod` 10
127 remainder100 =
128 number `mod` 100
130 ending
131 | remainder100 `elem` [11..13] = "th"
132 | remainder10 == 1 = "st"
133 | remainder10 == 2 = "nd"
134 | remainder10 == 3 = "rd"
135 | otherwise = "th"
136 in
137 i2t number <> ending
141drawCycle :: [Text] -> Doc
142drawCycle names =
143 let
144 topLine =
145 text "┌─────┐"
147 nameLine name =
148 text "│ " <> dullyellow (text name)
150 midLine =
151 text "│ ↓"
153 bottomLine =
154 text "└─────┘"
155 in
156 vcat (topLine : List.intersperse midLine (map nameLine names) ++ [ bottomLine ])
160-- FIND TYPOS
163findPotentialTypos :: [Text] -> Text -> [Text]
164findPotentialTypos knownNames badName =
165 filter ((==1) . distance badName) knownNames
168findTypoPairs :: [Text] -> [Text] -> [(Text, Text)]
169findTypoPairs leftOnly rightOnly =
170 let
171 veryNear leftName =
172 map ((,) leftName) (findPotentialTypos rightOnly leftName)
173 in
174 concatMap veryNear leftOnly
177vetTypos :: [(Text, Text)] -> Maybe (Set.Set Text, Set.Set Text)
178vetTypos potentialTypos =
179 let
180 tallyNames (ln, rn) (lc, rc) =
181 ( Map.insertWith (+) ln 1 lc
182 , Map.insertWith (+) rn 1 rc
183 )
185 (leftCounts, rightCounts) =
186 foldr tallyNames (Map.empty, Map.empty) potentialTypos
188 acceptable :: Map.Map Text Int -> Bool
189 acceptable counts =
190 not (Map.null counts)
191 &&
192 Map.foldr (\n unique -> n < 2 && unique) True counts
193 in
194 if acceptable leftCounts && acceptable rightCounts then
195 Just (Map.keysSet leftCounts, Map.keysSet rightCounts)
197 else
198 Nothing
202-- NEARBY NAMES
205nearbyNames :: (a -> Text) -> a -> [a] -> [a]
206nearbyNames format name names =
207 let editDistance =
208 if Text.length (format name) < 3 then 1 else 2
209 in
210 names
211 |> map (\x -> (distance (format name) (format x), x))
212 |> List.sortBy (compare `on` fst)
213 |> filter ( (<= editDistance) . abs . fst )
214 |> map snd
217distance :: Text -> Text -> Int
218distance x y =
219 Dist.restrictedDamerauLevenshteinDistance
220 Dist.defaultEditCosts
221 (Text.unpack x)
222 (Text.unpack y)
225maybeYouWant :: [Text] -> Text
226maybeYouWant suggestions =
227 case suggestions of
228 [] ->
229 ""
231 _:_ ->
232 "Maybe you want one of the following?\n"
233 <>
234 Text.concat (map ("\n " <>) (take 4 suggestions))