{-# 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
           )