git.iko.soy/elk
on 445ea07 help sign in
elk/src/Reporting/Helpers.hs
234 lines 4.8 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
11 , hintLink, stack, reflowParagraph
12 , commaSep, capitalize, ordinalize, drawCycle
13 , findPotentialTypos, findTypoPairs, vetTypos
14 , nearbyNames, distance, 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"
75hintLink :: Text -> Text
76hintLink fileName =
77 "<https://github.com/elm-lang/elm-compiler/blob/"
78 <> Text.pack (Pkg.versionToString Compiler.version)
79 <> "/hints/" <> fileName <> ".md>"
82stack :: [Doc] -> Doc
83stack chunks =
84 case chunks of
85 [] ->
86 error "function `stack` requires a non-empty list of docs"
88 doc : docs ->
89 List.foldl' (\a b -> a <> hardline <> hardline <> b) doc docs
92reflowParagraph :: Text -> Doc
93reflowParagraph paragraph =
94 fillSep (map text (Text.words paragraph))
97commaSep :: [Text] -> Text
98commaSep tokens =
99 case tokens of
100 [token] ->
101 " " <> token
103 [token1,token2] ->
104 " " <> token1 <> " and " <> token2
106 _ ->
107 " " <> Text.intercalate ", " (init tokens) <> ", and " <> last tokens
110capitalize :: Text -> Text
111capitalize txt =
112 case Text.uncons txt of
113 Nothing ->
114 txt
116 Just (c, rest) ->
117 Text.cons (Char.toUpper c) rest
120ordinalize :: Int -> Text
121ordinalize number =
122 let
123 remainder10 =
124 number `mod` 10
126 remainder100 =
127 number `mod` 100
129 ending
130 | remainder100 `elem` [11..13] = "th"
131 | remainder10 == 1 = "st"
132 | remainder10 == 2 = "nd"
133 | remainder10 == 3 = "rd"
134 | otherwise = "th"
135 in
136 i2t number <> ending
140drawCycle :: [Text] -> Doc
141drawCycle names =
142 let
143 topLine =
144 text "┌─────┐"
146 nameLine name =
147 text "│ " <> dullyellow (text name)
149 midLine =
150 text "│ ↓"
152 bottomLine =
153 text "└─────┘"
154 in
155 vcat (topLine : List.intersperse midLine (map nameLine names) ++ [ bottomLine ])
159-- FIND TYPOS
162findPotentialTypos :: [Text] -> Text -> [Text]
163findPotentialTypos knownNames badName =
164 filter ((==1) . distance badName) knownNames
167findTypoPairs :: [Text] -> [Text] -> [(Text, Text)]
168findTypoPairs leftOnly rightOnly =
169 let
170 veryNear leftName =
171 map ((,) leftName) (findPotentialTypos rightOnly leftName)
172 in
173 concatMap veryNear leftOnly
176vetTypos :: [(Text, Text)] -> Maybe (Set.Set Text, Set.Set Text)
177vetTypos potentialTypos =
178 let
179 tallyNames (ln, rn) (lc, rc) =
180 ( Map.insertWith (+) ln 1 lc
181 , Map.insertWith (+) rn 1 rc
182 )
184 (leftCounts, rightCounts) =
185 foldr tallyNames (Map.empty, Map.empty) potentialTypos
187 acceptable :: Map.Map Text Int -> Bool
188 acceptable counts =
189 not (Map.null counts)
190 &&
191 Map.foldr (\n unique -> n < 2 && unique) True counts
192 in
193 if acceptable leftCounts && acceptable rightCounts then
194 Just (Map.keysSet leftCounts, Map.keysSet rightCounts)
196 else
197 Nothing
201-- NEARBY NAMES
204nearbyNames :: (a -> Text) -> a -> [a] -> [a]
205nearbyNames format name names =
206 let editDistance =
207 if Text.length (format name) < 3 then 1 else 2
208 in
209 names
210 |> map (\x -> (distance (format name) (format x), x))
211 |> List.sortBy (compare `on` fst)
212 |> filter ( (<= editDistance) . abs . fst )
213 |> map snd
216distance :: Text -> Text -> Int
217distance x y =
218 Dist.restrictedDamerauLevenshteinDistance
219 Dist.defaultEditCosts
220 (Text.unpack x)
221 (Text.unpack y)
224maybeYouWant :: [Text] -> Text
225maybeYouWant suggestions =
226 case suggestions of
227 [] ->
228 ""
230 _:_ ->
231 "Maybe you want one of the following?\n"
232 <>
233 Text.concat (map ("\n " <>) (take 4 suggestions))