git.iko.soy/elk
on fcf5cef help sign in
elk/src/Reporting/Error/Helpers.hs
209 lines 4.4 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Reporting.Error.Helpers
3 ( (|>)
4 , functionName, args
5 , hintLink, stack, reflowParagraph
6 , commaSep, capitalize, ordinalize, drawCycle
7 , findPotentialTypos, findTypoPairs, vetTypos
8 , nearbyNames, distance, maybeYouWant
9 )
10 where
12import Data.Function (on)
13import qualified Data.Char as Char
14import qualified Data.List as List
15import qualified Data.Map as Map
16import qualified Data.Set as Set
17import qualified Text.EditDistance as Dist
18import Text.PrettyPrint.ANSI.Leijen
19 ( Doc, (<>), dullyellow, fillSep, hardline, text, vcat )
21import qualified AST.Helpers as Help
22import qualified Elm.Compiler.Version as Compiler
23import qualified Elm.Package as Pkg
27-- PIPES
30(|>) :: a -> (a -> b) -> b
31(|>) x f =
32 f x
35infixl 0 |>
39-- DOC HELPERS
42functionName :: String -> String
43functionName opName =
44 if Help.isOp opName then
45 "(" ++ opName ++ ")"
47 else
48 "`" ++ opName ++ "`"
51args :: Int -> String
52args n =
53 show n ++ if n == 1 then " argument" else " arguments"
56hintLink :: String -> String
57hintLink fileName =
58 "<https://github.com/elm-lang/elm-compiler/blob/"
59 ++ Pkg.versionToString Compiler.version
60 ++ "/hints/" ++ fileName ++ ".md>"
63stack :: [Doc] -> Doc
64stack list =
65 case list of
66 [] ->
67 error "function `stack` requires a non-empty list of docs"
69 doc : docs ->
70 List.foldl' (\a b -> a <> hardline <> hardline <> b) doc docs
73reflowParagraph :: String -> Doc
74reflowParagraph paragraph =
75 fillSep (map text (words paragraph))
78commaSep :: [String] -> String
79commaSep tokens =
80 case tokens of
81 [token] ->
82 " " ++ token
84 [token1,token2] ->
85 " " ++ token1 ++ " and " ++ token2
87 _ ->
88 " " ++ List.intercalate ", " (init tokens) ++ ", and " ++ last tokens
91capitalize :: String -> String
92capitalize string =
93 case string of
94 [] -> []
95 c : cs ->
96 Char.toUpper c : cs
99ordinalize :: Int -> String
100ordinalize number =
101 let
102 remainder10 =
103 number `mod` 10
105 remainder100 =
106 number `mod` 100
108 ending
109 | remainder100 `elem` [11..13] = "th"
110 | remainder10 == 1 = "st"
111 | remainder10 == 2 = "nd"
112 | remainder10 == 3 = "rd"
113 | otherwise = "th"
114 in
115 show number ++ ending
119drawCycle :: [String] -> Doc
120drawCycle strings =
121 let
122 topLine =
123 text "┌─────┐"
125 line str =
126 text "│ " <> dullyellow (text str)
128 midLine =
129 text "│ ↓"
131 bottomLine =
132 text "└─────┘"
133 in
134 vcat (topLine : List.intersperse midLine (map line strings) ++ [ bottomLine ])
138-- FIND TYPOS
141findPotentialTypos :: [String] -> String -> [String]
142findPotentialTypos knownNames badName =
143 filter ((==1) . distance badName) knownNames
146findTypoPairs :: [String] -> [String] -> [(String, String)]
147findTypoPairs leftOnly rightOnly =
148 let
149 veryNear leftName =
150 map ((,) leftName) (findPotentialTypos rightOnly leftName)
151 in
152 concatMap veryNear leftOnly
155vetTypos :: [(String, String)] -> Maybe (Set.Set String, Set.Set String)
156vetTypos potentialTypos =
157 let
158 tallyNames (ln, rn) (lc, rc) =
159 ( Map.insertWith (+) ln 1 lc
160 , Map.insertWith (+) rn 1 rc
161 )
163 (leftCounts, rightCounts) =
164 foldr tallyNames (Map.empty, Map.empty) potentialTypos
166 acceptable :: Map.Map String Int -> Bool
167 acceptable counts =
168 not (Map.null counts)
169 &&
170 Map.foldr (\n unique -> n < 2 && unique) True counts
171 in
172 if acceptable leftCounts && acceptable rightCounts then
173 Just (Map.keysSet leftCounts, Map.keysSet rightCounts)
175 else
176 Nothing
180-- NEARBY NAMES
183nearbyNames :: (a -> String) -> a -> [a] -> [a]
184nearbyNames format name names =
185 let editDistance =
186 if length (format name) < 3 then 1 else 2
187 in
188 names
189 |> map (\x -> (distance (format name) (format x), x))
190 |> List.sortBy (compare `on` fst)
191 |> filter ( (<= editDistance) . abs . fst )
192 |> map snd
195distance :: String -> String -> Int
196distance x y =
197 Dist.restrictedDamerauLevenshteinDistance Dist.defaultEditCosts x y
200maybeYouWant :: [String] -> String
201maybeYouWant suggestions =
202 case suggestions of
203 [] ->
204 ""
206 _:_ ->
207 "Maybe you want one of the following?\n"
208 ++ concatMap ("\n "++) (take 4 suggestions)