module Vgrep.Ansi.Type
( Formatted (..)
, AnsiFormatted
, emptyFormatted
, bare
, format
, cat
, mapText
, mapTextWithPos
, takeFormatted
, dropFormatted
, padFormatted
, fuse
) where
import Data.Foldable (foldl')
import Data.Text (Text)
import qualified Data.Text as T
import Graphics.Vty (Attr)
import Prelude hiding (length)
data Formatted attr
= Empty
| Text !Int Text
| Format !Int attr (Formatted attr)
| Cat !Int [Formatted attr]
deriving (Formatted attr -> Formatted attr -> Bool
(Formatted attr -> Formatted attr -> Bool)
-> (Formatted attr -> Formatted attr -> Bool)
-> Eq (Formatted attr)
forall attr. Eq attr => Formatted attr -> Formatted attr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Formatted attr -> Formatted attr -> Bool
$c/= :: forall attr. Eq attr => Formatted attr -> Formatted attr -> Bool
== :: Formatted attr -> Formatted attr -> Bool
$c== :: forall attr. Eq attr => Formatted attr -> Formatted attr -> Bool
Eq, Int -> Formatted attr -> ShowS
[Formatted attr] -> ShowS
Formatted attr -> String
(Int -> Formatted attr -> ShowS)
-> (Formatted attr -> String)
-> ([Formatted attr] -> ShowS)
-> Show (Formatted attr)
forall attr. Show attr => Int -> Formatted attr -> ShowS
forall attr. Show attr => [Formatted attr] -> ShowS
forall attr. Show attr => Formatted attr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Formatted attr] -> ShowS
$cshowList :: forall attr. Show attr => [Formatted attr] -> ShowS
show :: Formatted attr -> String
$cshow :: forall attr. Show attr => Formatted attr -> String
showsPrec :: Int -> Formatted attr -> ShowS
$cshowsPrec :: forall attr. Show attr => Int -> Formatted attr -> ShowS
Show)
instance Functor Formatted where
fmap :: (a -> b) -> Formatted a -> Formatted b
fmap a -> b
f = \case
Formatted a
Empty -> Formatted b
forall attr. Formatted attr
Empty
Text Int
l Text
t -> Int -> Text -> Formatted b
forall attr. Int -> Text -> Formatted attr
Text Int
l Text
t
Format Int
l a
a Formatted a
t -> Int -> b -> Formatted b -> Formatted b
forall attr. Int -> attr -> Formatted attr -> Formatted attr
Format Int
l (a -> b
f a
a) ((a -> b) -> Formatted a -> Formatted b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Formatted a
t)
Cat Int
l [Formatted a]
ts -> Int -> [Formatted b] -> Formatted b
forall attr. Int -> [Formatted attr] -> Formatted attr
Cat Int
l ((Formatted a -> Formatted b) -> [Formatted a] -> [Formatted b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Formatted a -> Formatted b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Formatted a]
ts)
instance (Eq attr, Semigroup attr) => Semigroup (Formatted attr) where
<> :: Formatted attr -> Formatted attr -> Formatted attr
(<>) = Formatted attr -> Formatted attr -> Formatted attr
forall attr.
(Eq attr, Semigroup attr) =>
Formatted attr -> Formatted attr -> Formatted attr
fuse
instance (Eq attr, Semigroup attr) => Monoid (Formatted attr) where
mempty :: Formatted attr
mempty = Formatted attr
forall attr. Formatted attr
Empty
type AnsiFormatted = Formatted Attr
emptyFormatted :: Formatted attr
emptyFormatted :: Formatted attr
emptyFormatted = Formatted attr
forall attr. Formatted attr
Empty
bare :: Text -> Formatted attr
bare :: Text -> Formatted attr
bare Text
t
| Text -> Bool
T.null Text
t = Formatted attr
forall attr. Formatted attr
emptyFormatted
| Bool
otherwise = Int -> Text -> Formatted attr
forall attr. Int -> Text -> Formatted attr
Text (Text -> Int
T.length Text
t) Text
t
format :: (Eq attr, Monoid attr) => attr -> Formatted attr -> Formatted attr
format :: attr -> Formatted attr -> Formatted attr
format attr
attr Formatted attr
formatted
| attr
attr attr -> attr -> Bool
forall a. Eq a => a -> a -> Bool
== attr
forall a. Monoid a => a
mempty = Formatted attr
formatted
| Format Int
l attr
attr' Formatted attr
formatted' <- Formatted attr
formatted
= Int -> attr -> Formatted attr -> Formatted attr
forall attr. Int -> attr -> Formatted attr -> Formatted attr
Format Int
l (attr
attr attr -> attr -> attr
forall a. Semigroup a => a -> a -> a
<> attr
attr') Formatted attr
formatted'
| Bool
otherwise = attr -> Formatted attr -> Formatted attr
forall attr. attr -> Formatted attr -> Formatted attr
format' attr
attr Formatted attr
formatted
format' :: attr -> Formatted attr -> Formatted attr
format' :: attr -> Formatted attr -> Formatted attr
format' attr
attr Formatted attr
formatted = Int -> attr -> Formatted attr -> Formatted attr
forall attr. Int -> attr -> Formatted attr -> Formatted attr
Format (Formatted attr -> Int
forall attr. Formatted attr -> Int
length Formatted attr
formatted) attr
attr Formatted attr
formatted
cat :: (Eq attr, Monoid attr) => [Formatted attr] -> Formatted attr
cat :: [Formatted attr] -> Formatted attr
cat = \case
[] -> Formatted attr
forall attr. Formatted attr
emptyFormatted
[Formatted attr
t] -> Formatted attr
t
[Formatted attr]
ts -> (Formatted attr -> Formatted attr -> Formatted attr)
-> Formatted attr -> [Formatted attr] -> Formatted attr
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Formatted attr -> Formatted attr -> Formatted attr
forall attr.
(Eq attr, Semigroup attr) =>
Formatted attr -> Formatted attr -> Formatted attr
fuse Formatted attr
forall attr. Formatted attr
emptyFormatted [Formatted attr]
ts
cat' :: [Formatted attr] -> Formatted attr
cat' :: [Formatted attr] -> Formatted attr
cat' = \case
[] -> Formatted attr
forall attr. Formatted attr
emptyFormatted
[Formatted attr
t] -> Formatted attr
t
[Formatted attr]
ts -> Int -> [Formatted attr] -> Formatted attr
forall attr. Int -> [Formatted attr] -> Formatted attr
Cat ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Formatted attr -> Int) -> [Formatted attr] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Formatted attr -> Int
forall attr. Formatted attr -> Int
length [Formatted attr]
ts)) [Formatted attr]
ts
fuse :: (Eq attr, Semigroup attr) => Formatted attr -> Formatted attr -> Formatted attr
fuse :: Formatted attr -> Formatted attr -> Formatted attr
fuse Formatted attr
left Formatted attr
right = case (Formatted attr
left, Formatted attr
right) of
(Formatted attr
Empty, Formatted attr
formatted) -> Formatted attr
formatted
(Formatted attr
formatted, Formatted attr
Empty) -> Formatted attr
formatted
(Text Int
l Text
t, Text Int
l' Text
t') -> Int -> Text -> Formatted attr
forall attr. Int -> Text -> Formatted attr
Text (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l') (Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t')
(Format Int
l attr
attr Formatted attr
t, Format Int
l' attr
attr' Formatted attr
t')
| attr
attr' attr -> attr -> Bool
forall a. Eq a => a -> a -> Bool
== attr
attr -> Int -> attr -> Formatted attr -> Formatted attr
forall attr. Int -> attr -> Formatted attr -> Formatted attr
Format (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l') attr
attr (Formatted attr
t Formatted attr -> Formatted attr -> Formatted attr
forall a. Semigroup a => a -> a -> a
<> Formatted attr
t')
(Cat Int
l [Formatted attr]
ts, Cat Int
l' [Formatted attr]
ts') -> Int -> [Formatted attr] -> Formatted attr
forall attr. Int -> [Formatted attr] -> Formatted attr
Cat (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l') ([Formatted attr]
ts [Formatted attr] -> [Formatted attr] -> [Formatted attr]
forall a. [a] -> [a] -> [a]
++ [Formatted attr]
ts')
(Cat Int
l [Formatted attr]
ts, Formatted attr
formatted) -> Int -> [Formatted attr] -> Formatted attr
forall attr. Int -> [Formatted attr] -> Formatted attr
Cat (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Formatted attr -> Int
forall attr. Formatted attr -> Int
length Formatted attr
formatted) ([Formatted attr]
ts [Formatted attr] -> [Formatted attr] -> [Formatted attr]
forall a. [a] -> [a] -> [a]
++ [Formatted attr
formatted])
(Formatted attr
formatted, Cat Int
_ (Formatted attr
t:[Formatted attr]
ts)) -> case Formatted attr
formatted Formatted attr -> Formatted attr -> Formatted attr
forall attr.
(Eq attr, Semigroup attr) =>
Formatted attr -> Formatted attr -> Formatted attr
`fuse` Formatted attr
t of
Cat Int
_ [Formatted attr]
ts' -> [Formatted attr] -> Formatted attr
forall attr. [Formatted attr] -> Formatted attr
cat' ([Formatted attr]
ts' [Formatted attr] -> [Formatted attr] -> [Formatted attr]
forall a. [a] -> [a] -> [a]
++ [Formatted attr]
ts)
Formatted attr
t' -> [Formatted attr] -> Formatted attr
forall attr. [Formatted attr] -> Formatted attr
cat' (Formatted attr
t' Formatted attr -> [Formatted attr] -> [Formatted attr]
forall a. a -> [a] -> [a]
: [Formatted attr]
ts)
(Formatted attr
formatted, Formatted attr
formatted') -> [Formatted attr] -> Formatted attr
forall attr. [Formatted attr] -> Formatted attr
cat' [Formatted attr
formatted, Formatted attr
formatted']
length :: Formatted attr -> Int
length :: Formatted attr -> Int
length = \case
Formatted attr
Empty -> Int
0
Text Int
l Text
_ -> Int
l
Format Int
l attr
_ Formatted attr
_ -> Int
l
Cat Int
l [Formatted attr]
_ -> Int
l
mapText :: (Text -> Text) -> Formatted a -> Formatted a
mapText :: (Text -> Text) -> Formatted a -> Formatted a
mapText Text -> Text
f = \case
Formatted a
Empty -> Formatted a
forall attr. Formatted attr
emptyFormatted
Text Int
_ Text
t -> Text -> Formatted a
forall attr. Text -> Formatted attr
bare (Text -> Text
f Text
t)
Format Int
_ a
attr Formatted a
t -> a -> Formatted a -> Formatted a
forall attr. attr -> Formatted attr -> Formatted attr
format' a
attr ((Text -> Text) -> Formatted a -> Formatted a
forall a. (Text -> Text) -> Formatted a -> Formatted a
mapText Text -> Text
f Formatted a
t)
Cat Int
_ [Formatted a]
ts -> [Formatted a] -> Formatted a
forall attr. [Formatted attr] -> Formatted attr
cat' ((Formatted a -> Formatted a) -> [Formatted a] -> [Formatted a]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text) -> Formatted a -> Formatted a
forall a. (Text -> Text) -> Formatted a -> Formatted a
mapText Text -> Text
f) [Formatted a]
ts)
mapTextWithPos :: (Int -> Text -> Text) -> Formatted a -> Formatted a
mapTextWithPos :: (Int -> Text -> Text) -> Formatted a -> Formatted a
mapTextWithPos Int -> Text -> Text
f = Int -> Formatted a -> Formatted a
forall attr. Int -> Formatted attr -> Formatted attr
go Int
0
where
go :: Int -> Formatted attr -> Formatted attr
go Int
pos = \case
Formatted attr
Empty -> Formatted attr
forall attr. Formatted attr
emptyFormatted
Text Int
_ Text
t -> Text -> Formatted attr
forall attr. Text -> Formatted attr
bare (Int -> Text -> Text
f Int
pos Text
t)
Format Int
_ attr
attr Formatted attr
t -> attr -> Formatted attr -> Formatted attr
forall attr. attr -> Formatted attr -> Formatted attr
format' attr
attr (Int -> Formatted attr -> Formatted attr
go Int
pos Formatted attr
t)
Cat Int
_ [Formatted attr]
ts -> [Formatted attr] -> Formatted attr
forall attr. [Formatted attr] -> Formatted attr
cat' (Int -> [Formatted attr] -> [Formatted attr]
go2 Int
pos [Formatted attr]
ts)
go2 :: Int -> [Formatted attr] -> [Formatted attr]
go2 Int
pos = \case
[] -> []
Formatted attr
t : [Formatted attr]
ts -> let t' :: Formatted attr
t' = Int -> Formatted attr -> Formatted attr
go Int
pos Formatted attr
t
l' :: Int
l' = Formatted attr -> Int
forall attr. Formatted attr -> Int
length Formatted attr
t'
ts' :: [Formatted attr]
ts' = Int -> [Formatted attr] -> [Formatted attr]
go2 (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l') [Formatted attr]
ts
in Formatted attr
t' Formatted attr -> [Formatted attr] -> [Formatted attr]
forall a. a -> [a] -> [a]
: [Formatted attr]
ts'
takeFormatted :: Int -> Formatted a -> Formatted a
takeFormatted :: Int -> Formatted a -> Formatted a
takeFormatted Int
w Formatted a
txt
| Formatted a -> Int
forall attr. Formatted attr -> Int
length Formatted a
txt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
w = (Int -> Text -> Text) -> Formatted a -> Formatted a
forall a. (Int -> Text -> Text) -> Formatted a -> Formatted a
mapTextWithPos Int -> Text -> Text
cropChunk Formatted a
txt
| Bool
otherwise = Formatted a
txt
where
cropChunk :: Int -> Text -> Text
cropChunk Int
pos
| Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
w = Text -> Text -> Text
forall a b. a -> b -> a
const Text
T.empty
| Bool
otherwise = Int -> Text -> Text
T.take (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos)
dropFormatted :: Int -> Formatted a -> Formatted a
dropFormatted :: Int -> Formatted a -> Formatted a
dropFormatted Int
amount Formatted a
txt
| Int
amount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Formatted a
txt
| Formatted a -> Int
forall attr. Formatted attr -> Int
length Formatted a
txt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
amount = Formatted a
forall attr. Formatted attr
emptyFormatted
| Bool
otherwise = case Formatted a
txt of
Formatted a
Empty -> Formatted a
forall attr. Formatted attr
emptyFormatted
Text Int
_ Text
t -> Text -> Formatted a
forall attr. Text -> Formatted attr
bare (Int -> Text -> Text
T.drop Int
amount Text
t)
Format Int
_ a
attr Formatted a
t -> a -> Formatted a -> Formatted a
forall attr. attr -> Formatted attr -> Formatted attr
format' a
attr (Int -> Formatted a -> Formatted a
forall attr. Int -> Formatted attr -> Formatted attr
dropFormatted Int
amount Formatted a
t)
Cat Int
_ [Formatted a]
ts -> [Formatted a] -> Formatted a
forall attr. [Formatted attr] -> Formatted attr
cat' (Int -> [Formatted a] -> [Formatted a]
forall attr. Int -> [Formatted attr] -> [Formatted attr]
dropChunks Int
amount [Formatted a]
ts)
where
dropChunks :: Int -> [Formatted attr] -> [Formatted attr]
dropChunks Int
n = \case
[] -> []
Formatted attr
t:[Formatted attr]
ts -> Int -> Formatted attr -> Formatted attr
forall attr. Int -> Formatted attr -> Formatted attr
dropFormatted Int
n Formatted attr
t Formatted attr -> [Formatted attr] -> [Formatted attr]
forall a. a -> [a] -> [a]
: Int -> [Formatted attr] -> [Formatted attr]
dropChunks (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Formatted attr -> Int
forall attr. Formatted attr -> Int
length Formatted attr
t) [Formatted attr]
ts
padFormatted :: Int -> Char -> Formatted a -> Formatted a
padFormatted :: Int -> Char -> Formatted a -> Formatted a
padFormatted Int
w Char
c Formatted a
txt
| Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Formatted a -> Int
forall attr. Formatted attr -> Int
length Formatted a
txt = [Formatted a] -> Formatted a
forall attr. [Formatted attr] -> Formatted attr
cat' [Formatted a
txt, Int -> Formatted a
forall attr. Int -> Formatted attr
padding (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Formatted a -> Int
forall attr. Formatted attr -> Int
length Formatted a
txt)]
| Bool
otherwise = Formatted a
txt
where
padding :: Int -> Formatted attr
padding Int
l = Text -> Formatted attr
forall attr. Text -> Formatted attr
bare (Int -> Text -> Text
T.replicate Int
l (Char -> Text
T.singleton Char
c))