module Data.Text.Shorten where
import Data.Coerce
import Data.Text qualified as T
import Data.Text.Token
import Protolude
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)
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
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 ->
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
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
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
[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]))
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]])
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
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]
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
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)
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