-- | This module provides data types and functions to display
--   the difference between 2 strings according to the number of edit operations
--   necessary to go from one to the other
module Data.Text.Difference where

import Data.Text qualified as T
import Data.Text.Color
import Data.Text.EditOperation
import Data.Text.Shorten
import Data.Text.Token
import Protolude

-- | Separators are used to highlight a difference between 2 pieces of text
--   for example
data Separators = Separators
  { Separators -> Text
startSeparator :: Text,
    Separators -> Text
endSeparator :: Text
  }
  deriving (Separators -> Separators -> Bool
(Separators -> Separators -> Bool)
-> (Separators -> Separators -> Bool) -> Eq Separators
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Separators -> Separators -> Bool
$c/= :: Separators -> Separators -> Bool
== :: Separators -> Separators -> Bool
$c== :: Separators -> Separators -> Bool
Eq, Int -> Separators -> ShowS
[Separators] -> ShowS
Separators -> String
(Int -> Separators -> ShowS)
-> (Separators -> String)
-> ([Separators] -> ShowS)
-> Show Separators
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Separators] -> ShowS
$cshowList :: [Separators] -> ShowS
show :: Separators -> String
$cshow :: Separators -> String
showsPrec :: Int -> Separators -> ShowS
$cshowsPrec :: Int -> Separators -> ShowS
Show)

-- | Make parens separators
parensSeparators :: Separators
parensSeparators :: Separators
parensSeparators = Char -> Char -> Separators
makeCharSeparators Char
'(' Char
')'

-- | Make brackets separators
bracketsSeparators :: Separators
bracketsSeparators :: Separators
bracketsSeparators = Char -> Char -> Separators
makeCharSeparators Char
'[' Char
']'

-- | Make separators with simple Chars
makeCharSeparators :: Char -> Char -> Separators
makeCharSeparators :: Char -> Char -> Separators
makeCharSeparators Char
c1 Char
c2 = Text -> Text -> Separators
Separators (Char -> Text
T.singleton Char
c1) (Char -> Text
T.singleton Char
c2)

-- | Options to use for displaying differences
data DisplayOptions = DisplayOptions
  { DisplayOptions -> Separators
_separators :: Separators,
    DisplayOptions -> ShortenOptions
_shortenOptions :: ShortenOptions,
    DisplayOptions -> EditOperation Char -> Text
_displayEditOperation :: EditOperation Char -> Text
  }

-- | Default display options
defaultDisplayOptions :: DisplayOptions
defaultDisplayOptions :: DisplayOptions
defaultDisplayOptions = Separators
-> ShortenOptions -> (EditOperation Char -> Text) -> DisplayOptions
DisplayOptions Separators
bracketsSeparators (Int -> Text -> ShortenOptions
ShortenOptions Int
20 Text
"...") EditOperation Char -> Text
defaultDisplayEditOperations

-- | Display an edit operation by prepending a symbol showing which operation is used
defaultDisplayEditOperations :: EditOperation Char -> Text
defaultDisplayEditOperations :: EditOperation Char -> Text
defaultDisplayEditOperations (Insert Char
c) = Text
"+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c
defaultDisplayEditOperations (Delete Char
c) = Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c
defaultDisplayEditOperations (Substitute Char
c1 Char
c2) = Text
"~" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
c2
defaultDisplayEditOperations (Keep Char
c) = Char -> Text
T.singleton Char
c

-- | Display an edit operation using ascii colors: green = added, red = removed, blue = substituted
coloredDisplayEditOperation :: EditOperation Char -> Text
coloredDisplayEditOperation :: EditOperation Char -> Text
coloredDisplayEditOperation (Insert Char
c) = Color -> Text -> Text
colorAs Color
Green (Char -> Text
T.singleton Char
c)
coloredDisplayEditOperation (Delete Char
c) = Color -> Text -> Text
colorAs Color
Red (Char -> Text
T.singleton Char
c)
coloredDisplayEditOperation (Substitute Char
c Char
_) = Color -> Text -> Text
colorAs Color
Cyan (Char -> Text
T.singleton Char
c)
coloredDisplayEditOperation (Keep Char
c) = Char -> Text
T.singleton Char
c

-- | Show the differences by enclosing them in separators
--   Additionally shorten the text outside the separators if it is too long
displayDiffs :: DisplayOptions -> [EditOperation Char] -> Text
displayDiffs :: DisplayOptions -> [EditOperation Char] -> Text
displayDiffs (DisplayOptions (Separators Text
start Text
end) ShortenOptions
shortenOptions EditOperation Char -> Text
displayEditOperation) [EditOperation Char]
operations = do
  let (Bool
isDifferent, [Token]
result) =
        ((Bool, [Token]) -> EditOperation Char -> (Bool, [Token]))
-> (Bool, [Token]) -> [EditOperation Char] -> (Bool, [Token])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
          ( \(Bool
different, [Token]
res) EditOperation Char
operation ->
              --  different keeps track of the fact that we entered a section of the text having some differences
              --  this allows us to open a 'start' delimiter
              --  then when we go back to keeping the same character, we can close with an 'end' delimiter
              case EditOperation Char
operation of
                Insert {} -> (Bool
True, [Token]
res [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> [Text -> Token
Delimiter Text
start | Bool -> Bool
not Bool
different] [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> [Text -> Token
Kept (Text -> Token) -> Text -> Token
forall a b. (a -> b) -> a -> b
$ EditOperation Char -> Text
displayEditOperation EditOperation Char
operation])
                Delete {} -> (Bool
True, [Token]
res [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> [Text -> Token
Delimiter Text
start | Bool -> Bool
not Bool
different] [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> [Text -> Token
Kept (Text -> Token) -> Text -> Token
forall a b. (a -> b) -> a -> b
$ EditOperation Char -> Text
displayEditOperation EditOperation Char
operation])
                Substitute {} -> (Bool
True, [Token]
res [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> [Text -> Token
Delimiter Text
start | Bool -> Bool
not Bool
different] [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> [Text -> Token
Kept (Text -> Token) -> Text -> Token
forall a b. (a -> b) -> a -> b
$ EditOperation Char -> Text
displayEditOperation EditOperation Char
operation])
                Keep {} -> (Bool
False, [Token]
res [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> [Text -> Token
Delimiter Text
end | Bool
different] [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> [Text -> Token
Kept (Text -> Token) -> Text -> Token
forall a b. (a -> b) -> a -> b
$ EditOperation Char -> Text
displayEditOperation EditOperation Char
operation])
          )
          (Bool
False, [])
          [EditOperation Char]
operations

  let fullResult :: [Token]
fullResult = if Bool
isDifferent then [Token]
result [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> [Text -> Token
Delimiter Text
end] else [Token]
result
  [Text] -> Text
T.concat (Token -> Text
showToken (Token -> Text) -> [Token] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShortenOptions -> Token -> Token -> [Token] -> [Token]
shortenTokens ShortenOptions
shortenOptions (Text -> Token
Delimiter Text
start) (Text -> Token
Delimiter Text
end) [Token]
fullResult)