{-# OPTIONS_HADDOCK hide #-}

-- | Defines Typo data structure and related utilities. Typo data carries the 
-- information of a typo.
module Language.Hanspell.Typo 
    ( Typo(..)
    , fixTyposWithStyle
    , typoToStringWithStyle
    , rmdupTypos
    ) where

import Data.Ord
import Data.List
import Data.List.Split

-- | Carries the information of a typo.
data Typo = Typo { Typo -> String
errorType    ::  String
                 , Typo -> String
token        ::  String
                 , Typo -> [String]
suggestions  :: [String]
                 , Typo -> String
context      ::  String
                 , Typo -> String
info         ::  String
                 } deriving (Int -> Typo -> ShowS
[Typo] -> ShowS
Typo -> String
(Int -> Typo -> ShowS)
-> (Typo -> String) -> ([Typo] -> ShowS) -> Show Typo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Typo] -> ShowS
$cshowList :: [Typo] -> ShowS
show :: Typo -> String
$cshow :: Typo -> String
showsPrec :: Int -> Typo -> ShowS
$cshowsPrec :: Int -> Typo -> ShowS
Show, Typo -> Typo -> Bool
(Typo -> Typo -> Bool) -> (Typo -> Typo -> Bool) -> Eq Typo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Typo -> Typo -> Bool
$c/= :: Typo -> Typo -> Bool
== :: Typo -> Typo -> Bool
$c== :: Typo -> Typo -> Bool
Eq, Eq Typo
Eq Typo
-> (Typo -> Typo -> Ordering)
-> (Typo -> Typo -> Bool)
-> (Typo -> Typo -> Bool)
-> (Typo -> Typo -> Bool)
-> (Typo -> Typo -> Bool)
-> (Typo -> Typo -> Typo)
-> (Typo -> Typo -> Typo)
-> Ord Typo
Typo -> Typo -> Bool
Typo -> Typo -> Ordering
Typo -> Typo -> Typo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Typo -> Typo -> Typo
$cmin :: Typo -> Typo -> Typo
max :: Typo -> Typo -> Typo
$cmax :: Typo -> Typo -> Typo
>= :: Typo -> Typo -> Bool
$c>= :: Typo -> Typo -> Bool
> :: Typo -> Typo -> Bool
$c> :: Typo -> Typo -> Bool
<= :: Typo -> Typo -> Bool
$c<= :: Typo -> Typo -> Bool
< :: Typo -> Typo -> Bool
$c< :: Typo -> Typo -> Bool
compare :: Typo -> Typo -> Ordering
$ccompare :: Typo -> Typo -> Ordering
$cp1Ord :: Eq Typo
Ord)

-- If given @True@, makes console text style reversed.
reversed :: Bool -> String -> String
reversed :: Bool -> ShowS
reversed Bool
isTTY String
text = if Bool
isTTY 
                         then String
"\x1b[7m" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
text String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\x1b[0m" 
                         else String
text

-- If given @True@, makes console text style grey.
grey :: Bool -> String -> String
grey :: Bool -> ShowS
grey Bool
isTTY String
text = if Bool
isTTY 
                     then String
"\x1b[90m" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
text String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\x1b[0m" 
                     else String
text

-- | Fixes typos of given sentences. If given @True@, the colors of fixed 
-- words are inverted.
fixTyposWithStyle :: Bool -> String -> [Typo] -> String
fixTyposWithStyle :: Bool -> String -> [Typo] -> String
fixTyposWithStyle Bool
isTTY = (String -> Typo -> String) -> String -> [Typo] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Bool -> String -> Typo -> String
fixTypo Bool
isTTY)
  where
    replace :: [a] -> [a] -> [a] -> [a]
replace [a]
from [a]
to = [a] -> [[a]] -> [a]
forall a. [a] -> [[a]] -> [a]
intercalate [a]
to ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a] -> [[a]]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn [a]
from
    fixTypo :: Bool -> String -> Typo -> String
    fixTypo :: Bool -> String -> Typo -> String
fixTypo Bool
isTTY String
text Typo
aTypo = 
        let aSuggestion :: String
aSuggestion = [String] -> String
forall a. [a] -> a
head (Typo -> [String]
suggestions Typo
aTypo)
         in if String
aSuggestion String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Typo -> String
token Typo
aTypo
               then String
text
               else String -> String -> ShowS
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace (Typo -> String
token Typo
aTypo) (Bool -> ShowS
reversed Bool
isTTY String
aSuggestion) String
text

-- | Converts a 'Typo' to string. If given @True@, 'info' of the 'Typo' is 
-- greyed out.
typoToStringWithStyle :: Bool -> Typo -> String
typoToStringWithStyle :: Bool -> Typo -> String
typoToStringWithStyle Bool
isTTY Typo
typo = Typo -> String
token Typo
typo
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> ShowS
grey Bool
isTTY String
" -> "
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate (Bool -> ShowS
grey Bool
isTTY String
", ") (Typo -> [String]
suggestions Typo
typo)
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> ShowS
grey Bool
isTTY (Typo -> String
info Typo
typo)

-- | Removes the 'Typo's whose 'token's are duplicated. Order preserving and 
-- O(nlogn).
rmdupTypos :: [Typo] -> [Typo]
rmdupTypos :: [Typo] -> [Typo]
rmdupTypos = ((Integer, Typo) -> Typo) -> [(Integer, Typo)] -> [Typo]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, Typo) -> Typo
forall a b. (a, b) -> b
snd ([(Integer, Typo)] -> [Typo])
-> ([Typo] -> [(Integer, Typo)]) -> [Typo] -> [Typo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Integer, Typo) -> (Integer, Typo) -> Ordering)
-> [(Integer, Typo)] -> [(Integer, Typo)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Integer, Typo) -> (Integer, Typo) -> Ordering
forall a b b. Ord a => (a, b) -> (a, b) -> Ordering
compareOrder ([(Integer, Typo)] -> [(Integer, Typo)])
-> ([Typo] -> [(Integer, Typo)]) -> [Typo] -> [(Integer, Typo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Integer, Typo)] -> (Integer, Typo))
-> [[(Integer, Typo)]] -> [(Integer, Typo)]
forall a b. (a -> b) -> [a] -> [b]
map [(Integer, Typo)] -> (Integer, Typo)
forall a. [a] -> a
head ([[(Integer, Typo)]] -> [(Integer, Typo)])
-> ([Typo] -> [[(Integer, Typo)]]) -> [Typo] -> [(Integer, Typo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Integer, Typo) -> (Integer, Typo) -> Bool)
-> [(Integer, Typo)] -> [[(Integer, Typo)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Integer, Typo) -> (Integer, Typo) -> Bool
forall a a. (a, Typo) -> (a, Typo) -> Bool
sameToken 
           ([(Integer, Typo)] -> [[(Integer, Typo)]])
-> ([Typo] -> [(Integer, Typo)]) -> [Typo] -> [[(Integer, Typo)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Integer, Typo) -> (Integer, Typo) -> Ordering)
-> [(Integer, Typo)] -> [(Integer, Typo)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Integer, Typo) -> (Integer, Typo) -> Ordering
forall a a. (a, Typo) -> (a, Typo) -> Ordering
compareToken ([(Integer, Typo)] -> [(Integer, Typo)])
-> ([Typo] -> [(Integer, Typo)]) -> [Typo] -> [(Integer, Typo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> [Typo] -> [(Integer, Typo)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..]
  where
    sameToken :: (a, Typo) -> (a, Typo) -> Bool
sameToken (a
_, Typo
t) (a
_, Typo
t') = Typo -> String
token Typo
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Typo -> String
token Typo
t'
    compareToken :: (a, Typo) -> (a, Typo) -> Ordering
compareToken (a
_, Typo
t) (a
_, Typo
t') = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Typo -> String
token Typo
t) (Typo -> String
token Typo
t')
    compareOrder :: (a, b) -> (a, b) -> Ordering
compareOrder (a
n, b
_) (a
n', b
_) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
n a
n'