add Seq2 Blessings Text split2HEADmaster

1 files changed, 78 insertions, 0 deletions

diff --git a/src/Blessings/Seq2.hs b/src/Blessings/Seq2.hs
new file mode 100644
index 0000000..69e41ae
--- /dev/null
+++ b/src/Blessings/Seq2.hs
@@ -0,0 +1,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
+           )