-- | This module provides functions to shorten a piece of text
--   where parts of the text are delimited to highlight the difference with another piece of text
--   Then only the parts outside the difference are being shortened
module Data.Text.Shorten where

import Data.Coerce
import Data.Text qualified as T
import Data.Text.Token
import Protolude

-- | Size used to decide if a piece of text needs to be shortened
data ShortenOptions = ShortenOptions
  { ShortenOptions -> Int
_shortenSize :: Int,
    ShortenOptions -> Text
_shortenText :: Text
  }
  deriving (ShortenOptions -> ShortenOptions -> Bool
(ShortenOptions -> ShortenOptions -> Bool)
-> (ShortenOptions -> ShortenOptions -> Bool) -> Eq ShortenOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShortenOptions -> ShortenOptions -> Bool
$c/= :: ShortenOptions -> ShortenOptions -> Bool
== :: ShortenOptions -> ShortenOptions -> Bool
$c== :: ShortenOptions -> ShortenOptions -> Bool
Eq, Int -> ShortenOptions -> ShowS
[ShortenOptions] -> ShowS
ShortenOptions -> String
(Int -> ShortenOptions -> ShowS)
-> (ShortenOptions -> String)
-> ([ShortenOptions] -> ShowS)
-> Show ShortenOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShortenOptions] -> ShowS
$cshowList :: [ShortenOptions] -> ShowS
show :: ShortenOptions -> String
$cshow :: ShortenOptions -> String
showsPrec :: Int -> ShortenOptions -> ShowS
$cshowsPrec :: Int -> ShortenOptions -> ShowS
Show)

-- | Cut the shorten size in 2
half :: ShortenOptions -> ShortenOptions
half :: ShortenOptions -> ShortenOptions
half (ShortenOptions Int
ss Text
t) = Int -> Text -> ShortenOptions
ShortenOptions (Int -> Int
coerce Int
ss Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Text
t

-- | Shorten a piece of text that has already been tokenized
shortenTokens :: ShortenOptions -> Token -> Token -> [Token] -> [Token]
shortenTokens :: ShortenOptions -> Token -> Token -> [Token] -> [Token]
shortenTokens ShortenOptions
shortenOptions Token
startDelimiter Token
endDelimiter [Token]
tokens = do
  ([Token] -> [Token] -> [Token]) -> [Token] -> [[Token]] -> [Token]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
    ( \[Token]
res [Token]
cur ->
        -- [abcdefgh] -> [abcdefgh]
        if [Token] -> Maybe Token
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head [Token]
cur Maybe Token -> Maybe Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token -> Maybe Token
forall a. a -> Maybe a
Just Token
startDelimiter Bool -> Bool -> Bool
&& [Token] -> Maybe Token
forall a. [a] -> Maybe a
lastMay [Token]
cur Maybe Token -> Maybe Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token -> Maybe Token
forall a. a -> Maybe a
Just Token
endDelimiter
          then [Token]
res [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> [Token]
cur
          else -- <start>abcdefgh -> ...defgh

            if [Token] -> Maybe Token
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head [Token]
cur Maybe Token -> Maybe Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token -> Maybe Token
forall a. a -> Maybe a
Just Token
Start
              then [Token]
res [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> ShortenOptions -> [Token] -> [Token]
shortenLeft ShortenOptions
shortenOptions [Token]
cur
              else -- abcdefgh<end> -> abcd...

                if [Token] -> Maybe Token
forall a. [a] -> Maybe a
lastMay [Token]
cur Maybe Token -> Maybe Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token -> Maybe Token
forall a. a -> Maybe a
Just Token
End
                  then [Token]
res [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ ShortenOptions -> [Token] -> [Token]
shortenRight ShortenOptions
shortenOptions [Token]
cur
                  else -- abcdefgh -> abc...fgh
                    [Token]
res [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> ShortenOptions -> [Token] -> [Token]
shortenCenter ShortenOptions
shortenOptions [Token]
cur
    )
    []
    [[Token]]
delimitedTokens
  where
    delimitedTokens :: [[Token]]
delimitedTokens = Token -> Token -> [Token] -> [[Token]]
splitOnDelimiters Token
startDelimiter Token
endDelimiter (Token
Start Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: ([Token]
tokens [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> [Token
End]))

-- | Split a list of tokens into several lists when a delimiter is found
--   abcd[efgh]ijkl[mnop]qrst -> [abcd, [efgh], ijkl, [mnop], qrst]
splitOnDelimiters :: Token -> Token -> [Token] -> [[Token]]
splitOnDelimiters :: Token -> Token -> [Token] -> [[Token]]
splitOnDelimiters Token
start Token
end =
  ([[Token]] -> Token -> [[Token]])
-> [[Token]] -> [Token] -> [[Token]]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
    ( \[[Token]]
res Token
cur ->
        if Token
cur Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
start
          then [[Token]]
res [[Token]] -> [[Token]] -> [[Token]]
forall a. Semigroup a => a -> a -> a
<> [[Token
start]]
          else
            if Token
cur Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
end
              then [[Token]] -> ([Token] -> [Token]) -> [[Token]]
forall a. [a] -> (a -> a) -> [a]
updateLast [[Token]]
res ([Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> [Token
end])
              else case [[Token]] -> Maybe [Token]
forall a. [a] -> Maybe a
lastMay [[Token]]
res of
                Just [Token]
ts ->
                  if [Token] -> Maybe Token
forall a. [a] -> Maybe a
lastMay [Token]
ts Maybe Token -> Maybe Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token -> Maybe Token
forall a. a -> Maybe a
Just Token
end
                    then [[Token]]
res [[Token]] -> [[Token]] -> [[Token]]
forall a. Semigroup a => a -> a -> a
<> [[Token
cur]]
                    else [[Token]] -> ([Token] -> [Token]) -> [[Token]]
forall a. [a] -> (a -> a) -> [a]
updateLast [[Token]]
res ([Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> [Token
cur])
                Maybe [Token]
_ ->
                  [[Token
cur]]
    )
    ([] :: [[Token]])

-- | Shorten some token on the left: ...tokens
shortenLeft :: ShortenOptions -> [Token] -> [Token]
shortenLeft :: ShortenOptions -> [Token] -> [Token]
shortenLeft ShortenOptions
so [Token]
ts = ShortenOptions -> [Token] -> [Token] -> [Token]
whenTooLong ShortenOptions
so [Token]
ts ([Token] -> [Token]) -> [Token] -> [Token]
forall a b. (a -> b) -> a -> b
$ Text -> Token
Kept (ShortenOptions -> Text
_shortenText ShortenOptions
so) Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: Int -> [Token] -> [Token]
forall a. Int -> [a] -> [a]
drop ([Token] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Token]
ts Int -> Int -> Int
forall a. Num a => a -> a -> a
- ShortenOptions -> Int
_shortenSize ShortenOptions
so) [Token]
ts

-- | Shorten some token on the right: tokens...
shortenRight :: ShortenOptions -> [Token] -> [Token]
shortenRight :: ShortenOptions -> [Token] -> [Token]
shortenRight ShortenOptions
so [Token]
ts = ShortenOptions -> [Token] -> [Token] -> [Token]
whenTooLong ShortenOptions
so [Token]
ts ([Token] -> [Token]) -> [Token] -> [Token]
forall a b. (a -> b) -> a -> b
$ Int -> [Token] -> [Token]
forall a. Int -> [a] -> [a]
take (ShortenOptions -> Int
_shortenSize ShortenOptions
so) [Token]
ts [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> [Text -> Token
Kept (Text -> Token) -> Text -> Token
forall a b. (a -> b) -> a -> b
$ ShortenOptions -> Text
_shortenText ShortenOptions
so]

-- | Shorten some token in the center: ...tokens...
shortenCenter :: ShortenOptions -> [Token] -> [Token]
shortenCenter :: ShortenOptions -> [Token] -> [Token]
shortenCenter ShortenOptions
so [Token]
ts = ShortenOptions -> [Token] -> [Token] -> [Token]
whenTooLong ShortenOptions
so [Token]
ts ([Token] -> [Token]) -> [Token] -> [Token]
forall a b. (a -> b) -> a -> b
$ Int -> [Token] -> [Token]
forall a. Int -> [a] -> [a]
take (ShortenOptions -> Int
_shortenSize (ShortenOptions -> Int) -> ShortenOptions -> Int
forall a b. (a -> b) -> a -> b
$ ShortenOptions -> ShortenOptions
half ShortenOptions
so) [Token]
ts [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> [Text -> Token
Kept (Text -> Token) -> Text -> Token
forall a b. (a -> b) -> a -> b
$ ShortenOptions -> Text
_shortenText ShortenOptions
so] [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> Int -> [Token] -> [Token]
forall a. Int -> [a] -> [a]
drop ([Token] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Token]
ts Int -> Int -> Int
forall a. Num a => a -> a -> a
- ShortenOptions -> Int
_shortenSize ShortenOptions
so Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [Token]
ts

-- | Depending on the shorten option and the original list of tokens used a shorter version
whenTooLong :: ShortenOptions -> [Token] -> [Token] -> [Token]
whenTooLong :: ShortenOptions -> [Token] -> [Token] -> [Token]
whenTooLong ShortenOptions
so [Token]
original [Token]
shortened =
  if [Token] -> Int
tokenSize [Token]
original Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ShortenOptions -> Int
_shortenSize ShortenOptions
so then [Token]
shortened else [Token]
original
  where
    tokenSize :: [Token] -> Int
    tokenSize :: [Token] -> Int
tokenSize = [Int] -> Int
forall (f :: * -> *) a. (Foldable f, Num a) => f a -> a
sum ([Int] -> Int) -> ([Token] -> [Int]) -> [Token] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token -> Int) -> [Token] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\case Kept Text
value -> Text -> Int
T.length Text
value; Token
_ -> Int
0)

-- * Helpers

-- | Update the last element of a list
updateLast :: [a] -> (a -> a) -> [a]
updateLast :: forall a. [a] -> (a -> a) -> [a]
updateLast [] a -> a
_ = []
updateLast [a
a] a -> a
f = [a -> a
f a
a]
updateLast (a
a : [a]
as) a -> a
f = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> (a -> a) -> [a]
forall a. [a] -> (a -> a) -> [a]
updateLast [a]
as a -> a
f