git.iko.soy/elk
on 00a3069 help sign in
elk/src/Reporting/Helpers.hs
259 lines 5.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Helpers
4 ( textToDoc
5 , nameToDoc
6 , args, moreArgs
7 , toSimpleNote, toSimpleHint, toFancyHint
8 , link, reflowLink
9 , stack, reflow
10 , commaSep, capitalize, ordinalize, drawCycle
11 , findPotentialTypos, findTypoPairs, vetTypos
12 , nearbyNames, distance, maybeYouWant, maybeYouWant'
13 -- re-exports
14 , Doc, (<+>), (<>), black, cat, dullyellow, fillSep, green, hang, hardline
15 , hcat, hsep, indent, magenta, parens, sep, text, underline, vcat
16 )
17 where
20import Data.Function (on)
21import qualified Data.Char as Char
22import qualified Data.List as List
23import qualified Data.Map as Map
24import Data.Monoid ((<>))
25import qualified Data.Set as Set
26import qualified Data.Text as Text
27import Data.Text (Text)
28import qualified Elm.Name as N
29import qualified Text.EditDistance as Dist
30import qualified Text.PrettyPrint.ANSI.Leijen as P
31import Text.PrettyPrint.ANSI.Leijen hiding ((<>))
33import qualified Elm.Compiler.Version as Compiler
34import qualified Elm.Package as Pkg
38-- DOC HELPERS
41textToDoc :: Text -> Doc
42textToDoc msg =
43 text (Text.unpack msg)
46nameToDoc :: N.Name -> Doc
47nameToDoc name =
48 text (N.toString name)
51args :: Int -> String
52args n =
53 show n <> if n == 1 then " argument" else " arguments"
56moreArgs :: Int -> String
57moreArgs n =
58 show n <> " more" <> if n == 1 then " argument" else " arguments"
62-- HINTS
65toSimpleNote :: String -> Doc
66toSimpleNote message =
67 fillSep ((underline (text "Note") <> ":") : map text (words message))
70toSimpleHint :: String -> Doc
71toSimpleHint message =
72 toFancyHint (map text (words message))
75toFancyHint :: [Doc] -> Doc
76toFancyHint chunks =
77 fillSep (underline (text "Hint") <> ":" : chunks)
80link :: Doc -> String -> String -> String -> Doc
81link word before fileName after =
82 fillSep $
83 (underline word <> ":")
84 : map text (words before)
85 ++ P.text (makeLink fileName)
86 : map text (words after)
89makeLink :: String -> String
90makeLink fileName =
91 "<http://elm-lang.org/hints/" <> Pkg.versionToString Compiler.version <> "/" <> fileName <> ".md>"
94reflowLink :: String -> String -> String -> Doc
95reflowLink before fileName after =
96 fillSep $
97 map text (words before)
98 ++ P.text (makeLink fileName)
99 : map text (words after)
102stack :: [Doc] -> Doc
103stack chunks =
104 case chunks of
105 [] ->
106 error "function `stack` requires a non-empty list of docs"
108 doc : docs ->
109 List.foldl' (\a b -> a <> hardline <> hardline <> b) doc docs
112reflow :: String -> Doc
113reflow paragraph =
114 fillSep (map text (words paragraph))
117commaSep :: Doc -> (Doc -> Doc) -> [Doc] -> [Doc]
118commaSep conjunction addStyle names =
119 case names of
120 [name] ->
121 [ addStyle name ]
123 [name1,name2] ->
124 [ addStyle name1, conjunction, addStyle name2 ]
126 _ ->
127 map (\name -> addStyle name <> ",") (init names)
128 ++
129 [ conjunction
130 , addStyle (last names)
131 ]
134capitalize :: Text -> Text
135capitalize txt =
136 case Text.uncons txt of
137 Nothing ->
138 txt
140 Just (c, rest) ->
141 Text.cons (Char.toUpper c) rest
144ordinalize :: Int -> String
145ordinalize number =
146 let
147 remainder10 =
148 number `mod` 10
150 remainder100 =
151 number `mod` 100
153 ending
154 | remainder100 `elem` [11..13] = "th"
155 | remainder10 == 1 = "st"
156 | remainder10 == 2 = "nd"
157 | remainder10 == 3 = "rd"
158 | otherwise = "th"
159 in
160 show number <> ending
164drawCycle :: [N.Name] -> Doc
165drawCycle names =
166 let
167 topLine =
168 "┌─────┐"
170 nameLine name =
171 "│ " <> dullyellow (textToDoc name)
173 midLine =
174 "│ ↓"
176 bottomLine =
177 "└─────┘"
178 in
179 vcat (topLine : List.intersperse midLine (map nameLine names) ++ [ bottomLine ])
183-- FIND TYPOS
186findPotentialTypos :: [String] -> String -> [String]
187findPotentialTypos knownNames badName =
188 filter ((==1) . distance badName) knownNames
191findTypoPairs :: [String] -> [String] -> [(String, String)]
192findTypoPairs leftOnly rightOnly =
193 let
194 veryNear leftName =
195 map ((,) leftName) (findPotentialTypos rightOnly leftName)
196 in
197 concatMap veryNear leftOnly
200vetTypos :: [(String, String)] -> Maybe (Set.Set String, Set.Set String)
201vetTypos potentialTypos =
202 let
203 tallyNames (ln, rn) (lc, rc) =
204 ( Map.insertWith (+) ln 1 lc
205 , Map.insertWith (+) rn 1 rc
206 )
208 (leftCounts, rightCounts) =
209 foldr tallyNames (Map.empty, Map.empty) potentialTypos
211 acceptable :: Map.Map String Int -> Bool
212 acceptable counts =
213 not (Map.null counts)
214 &&
215 Map.foldr (\n unique -> n < 2 && unique) True counts
216 in
217 if acceptable leftCounts && acceptable rightCounts then
218 Just (Map.keysSet leftCounts, Map.keysSet rightCounts)
220 else
221 Nothing
225-- NEARBY NAMES
228nearbyNames :: (a -> String) -> a -> [a] -> [a]
229nearbyNames format name names =
230 let editDistance =
231 if length (format name) < 3 then 1 else 2
232 in
233 map snd $
234 filter ( (<= editDistance) . abs . fst ) $
235 List.sortBy (compare `on` fst) $
236 map (\x -> (distance (format name) (format x), x)) names
239distance :: String -> String -> Int
240distance x y =
241 Dist.restrictedDamerauLevenshteinDistance Dist.defaultEditCosts x y
244maybeYouWant :: Maybe Doc -> [N.Name] -> Doc
245maybeYouWant maybeStarter suggestions =
246 maybe P.empty id (maybeYouWant' maybeStarter suggestions)
249maybeYouWant' :: Maybe Doc -> [N.Name] -> Maybe Doc
250maybeYouWant' maybeStarter suggestions =
251 case suggestions of
252 [] ->
253 maybeStarter
255 _:_ ->
256 Just $ stack $
257 [ maybe id (<+>) maybeStarter "Maybe you want one of the following?"
258 , P.indent 4 $ P.vcat $ map (P.dullyellow . nameToDoc) (take 4 suggestions)
259 ]