git.iko.soy/elk
on 17618de help sign in
elk/src/Reporting/Error/Helpers.hs
203 lines 4.2 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Reporting.Error.Helpers
3 ( (|>)
4 , functionName, hintLink, stack, reflowParagraph
5 , commaSep, capitalize, ordinalize, drawCycle
6 , findPotentialTypos, vetTypos
7 , nearbyNames, distance, maybeYouWant
8 )
9 where
11import Data.Function (on)
12import qualified Data.Char as Char
13import qualified Data.List as List
14import qualified Data.Map as Map
15import qualified Data.Set as Set
16import qualified Text.EditDistance as Dist
17import Text.PrettyPrint.ANSI.Leijen
18 ( Doc, (<>), dullyellow, fillSep, hardline, text, vcat )
20import qualified AST.Helpers as Help
21import qualified Elm.Compiler.Version as Compiler
22import qualified Elm.Package as Pkg
26-- PIPES
29(|>) :: a -> (a -> b) -> b
30(|>) x f =
31 f x
34infixl 0 |>
38-- DOC HELPERS
41functionName :: String -> String
42functionName opName =
43 if Help.isOp opName then
44 "(" ++ opName ++ ")"
46 else
47 "`" ++ opName ++ "`"
50hintLink :: String -> String
51hintLink fileName =
52 "<https://github.com/elm-lang/elm-compiler/blob/"
53 ++ Pkg.versionToString Compiler.version
54 ++ "/hints/" ++ fileName ++ ".md>"
57stack :: [Doc] -> Doc
58stack list =
59 case list of
60 [] ->
61 error "function `stack` requires a non-empty list of docs"
63 doc : docs ->
64 List.foldl' (\a b -> a <> hardline <> hardline <> b) doc docs
67reflowParagraph :: String -> Doc
68reflowParagraph paragraph =
69 fillSep (map text (words paragraph))
72commaSep :: [String] -> String
73commaSep tokens =
74 case tokens of
75 [token] ->
76 " " ++ token
78 [token1,token2] ->
79 " " ++ token1 ++ " and " ++ token2
81 _ ->
82 " " ++ List.intercalate ", " (init tokens) ++ ", and " ++ last tokens
85capitalize :: String -> String
86capitalize string =
87 case string of
88 [] -> []
89 c : cs ->
90 Char.toUpper c : cs
93ordinalize :: Int -> String
94ordinalize number =
95 let
96 remainder10 =
97 number `mod` 10
99 remainder100 =
100 number `mod` 100
102 ending
103 | remainder100 `elem` [11..13] = "th"
104 | remainder10 == 1 = "st"
105 | remainder10 == 2 = "nd"
106 | remainder10 == 3 = "rd"
107 | otherwise = "th"
108 in
109 show number ++ ending
113drawCycle :: [String] -> Doc
114drawCycle strings =
115 let
116 topLine =
117 [ text "┌─────┐"
118 , text "│ V"
119 ]
121 line str =
122 [ text "│ " <> dullyellow (text str)
123 ]
125 midLine =
126 [ text "│ │"
127 , text "│ V"
128 ]
130 bottomLine =
131 text "└─────┘"
132 in
133 vcat (topLine ++ List.intercalate midLine (map line strings) ++ [ bottomLine ])
137-- FIND TYPOS
140findPotentialTypos :: [String] -> [String] -> [(String, String)]
141findPotentialTypos leftOnly rightOnly =
142 let
143 veryNear leftName =
144 map ((,) leftName) (filter ((==1) . distance leftName) rightOnly)
145 in
146 concatMap veryNear leftOnly
149vetTypos :: [(String, String)] -> Maybe (Set.Set String, Set.Set String)
150vetTypos potentialTypos =
151 let
152 tallyNames (ln, rn) (lc, rc) =
153 ( Map.insertWith (+) ln 1 lc
154 , Map.insertWith (+) rn 1 rc
155 )
157 (leftCounts, rightCounts) =
158 foldr tallyNames (Map.empty, Map.empty) potentialTypos
160 acceptable :: Map.Map String Int -> Bool
161 acceptable counts =
162 not (Map.null counts)
163 &&
164 Map.foldr (\n unique -> n < 2 && unique) True counts
165 in
166 if acceptable leftCounts && acceptable rightCounts then
167 Just (Map.keysSet leftCounts, Map.keysSet rightCounts)
169 else
170 Nothing
174-- NEARBY NAMES
177nearbyNames :: (a -> String) -> a -> [a] -> [a]
178nearbyNames format name names =
179 let editDistance =
180 if length (format name) < 3 then 1 else 2
181 in
182 names
183 |> map (\x -> (distance (format name) (format x), x))
184 |> List.sortBy (compare `on` fst)
185 |> filter ( (<= editDistance) . abs . fst )
186 |> map snd
189distance :: String -> String -> Int
190distance x y =
191 Dist.restrictedDamerauLevenshteinDistance Dist.defaultEditCosts x y
194maybeYouWant :: [String] -> String
195maybeYouWant suggestions =
196 case suggestions of
197 [] ->
198 ""
200 _:_ ->
201 "Maybe you want one of the following?\n"
202 ++ concatMap ("\n "++) (take 4 suggestions)