1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE TypeFamilies #-}
module Blessings.Seq2 where
import Blessings
import Data.DList qualified as D
import Data.Seq2
import Data.Text (Text)
import Data.Text qualified as T
instance Seq2 Blessings Text where
type Element Text = Char
split2 = split2By (not . T.null) T.split
split2By :: (Monoid a) => (a -> Bool) -> (t -> a -> [a]) -> t -> Blessings a -> [Blessings a]
split2By isNonEmpty split p = finalize . cataBlessings algPlain algSGR algAppend
where
------------------------------------------------------------------
-- Accumulator:
--
-- Nothing = no chunks
-- Just (open, front, last) = front ++ [last]
--
-- front :: DList (Blessings Text) = all chunks except the last
-- last :: Blessings Text = last chunk
------------------------------------------------------------------
finalize Nothing = []
finalize (Just (_, f, l)) = D.toList f ++ [l]
algPlain t =
case split p t of
-- [] -> undefined -- Data.Text.split returned []
[x] ->
Just ( isNonEmpty x
, D.empty
, Plain x
)
xs ->
Just ( isNonEmpty (last xs)
, D.fromList (map Plain (init xs))
, Plain (last xs)
)
algSGR _ Nothing = Nothing
algSGR s (Just (o, f, l)) =
Just ( o
, D.map (SGR s) f
, SGR s l
)
algAppend Nothing r = r
algAppend l Nothing = l
algAppend (Just (ox, fx, lx)) (Just (oy, fy, ly))
| ox && oy = mergeOpen fx lx fy ly oy
| otherwise = noMerge fx lx fy ly oy
mergeOpen fx lx fy ly oy =
case fy of
D.Nil ->
Just (oy, fx, Append lx ly)
D.Cons f fs ->
Just ( oy
, fx `D.snoc` Append lx f `D.append` D.fromList fs
, ly
)
_ -> undefined -- impossible since all DList are constructed safely
noMerge fx lx fy ly oy =
Just ( oy
, fx `D.snoc` lx `D.append` fy
, ly
)
|
