{-# OPTIONS_HADDOCK hide #-}
module Language.Hanspell.Typo
( Typo(..)
, fixTyposWithStyle
, typoToStringWithStyle
, rmdupTypos
) where
import Data.Ord
import Data.List
import Data.List.Split
data Typo = Typo { errorType :: String
, token :: String
, suggestions :: [String]
, context :: String
, info :: String
} deriving (Show, Eq, Ord)
reversed :: Bool -> String -> String
reversed isTTY text = if isTTY
then "\x1b[7m" ++ text ++ "\x1b[0m"
else text
grey :: Bool -> String -> String
grey isTTY text = if isTTY
then "\x1b[90m" ++ text ++ "\x1b[0m"
else text
fixTyposWithStyle :: Bool -> String -> [Typo] -> String
fixTyposWithStyle isTTY = foldl' (fixTypo isTTY)
where
replace from to = intercalate to . splitOn from
fixTypo :: Bool -> String -> Typo -> String
fixTypo isTTY text aTypo =
let aSuggestion = head (suggestions aTypo)
in if aSuggestion == token aTypo
then text
else replace (token aTypo) (reversed isTTY aSuggestion) text
typoToStringWithStyle :: Bool -> Typo -> String
typoToStringWithStyle isTTY typo = token typo
++ grey isTTY " -> "
++ intercalate (grey isTTY ", ") (suggestions typo)
++ "\n"
++ grey isTTY (info typo)
rmdupTypos :: [Typo] -> [Typo]
rmdupTypos =
map snd . sortBy compareOrder . rmdup . sortBy compareToken . zip [1..]
where
compareToken (n, t) (n', t') = compare (token t) (token t')
compareOrder (n, t) (n', t') = compare n n'
rmdup (a:b:typos) = if compareToken a b == EQ
then rmdup (a:typos)
else a:rmdup (b:typos)
rmdup typos = typos