on 267f708 help sign in
elk/src/Reporting/Error/Helpers.hs
198 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 "┌─────┐"
119 line str =
120 text "│ " <> dullyellow (text str)
122 midLine =
123 text "│ ↓"
125 bottomLine =
126 text "└─────┘"
127 in
128 vcat (topLine : List.intersperse midLine (map line strings) ++ [ bottomLine ])
132-- FIND TYPOS
135findPotentialTypos :: [String] -> [String] -> [(String, String)]
136findPotentialTypos leftOnly rightOnly =
137 let
138 veryNear leftName =
139 map ((,) leftName) (filter ((==1) . distance leftName) rightOnly)
140 in
141 concatMap veryNear leftOnly
144vetTypos :: [(String, String)] -> Maybe (Set.Set String, Set.Set String)
145vetTypos potentialTypos =
146 let
147 tallyNames (ln, rn) (lc, rc) =
148 ( Map.insertWith (+) ln 1 lc
149 , Map.insertWith (+) rn 1 rc
150 )
152 (leftCounts, rightCounts) =
153 foldr tallyNames (Map.empty, Map.empty) potentialTypos
155 acceptable :: Map.Map String Int -> Bool
156 acceptable counts =
157 not (Map.null counts)
158 &&
159 Map.foldr (\n unique -> n < 2 && unique) True counts
160 in
161 if acceptable leftCounts && acceptable rightCounts then
162 Just (Map.keysSet leftCounts, Map.keysSet rightCounts)
164 else
165 Nothing
169-- NEARBY NAMES
172nearbyNames :: (a -> String) -> a -> [a] -> [a]
173nearbyNames format name names =
174 let editDistance =
175 if length (format name) < 3 then 1 else 2
176 in
177 names
178 |> map (\x -> (distance (format name) (format x), x))
179 |> List.sortBy (compare `on` fst)
180 |> filter ( (<= editDistance) . abs . fst )
181 |> map snd
184distance :: String -> String -> Int
185distance x y =
186 Dist.restrictedDamerauLevenshteinDistance Dist.defaultEditCosts x y
189maybeYouWant :: [String] -> String
190maybeYouWant suggestions =
191 case suggestions of
192 [] ->
193 ""
195 _:_ ->
196 "Maybe you want one of the following?\n"
197 ++ concatMap ("\n "++) (take 4 suggestions)