-- | Some kind of dynamic string, or dequeue string, if you like, that
-- supports efficient concatenation on both sides if you don't make your
-- chunks too weird.
module DString (
    DString,
    pack, unpack, singleton, length, take, drop, null, head, concat, hPutStr
) where

import Prelude hiding (length, take, drop, null, head, concat)

import Data.Foldable (toList)
import qualified Data.Sequence as S
import Data.Sequence (ViewL((:<)))
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.IO as T
import System.IO (Handle)


newtype DString = DString (S.Seq T.Text)
  deriving (Show)

instance Eq DString where
    DString s == DString s' = T.concat (toList s) == T.concat (toList s')

pack :: String -> DString
pack s = DString (S.singleton (T.pack s))

unpack :: DString -> String
unpack (DString s) = T.unpack (T.concat (toList s))

singleton :: Char -> DString
singleton c = DString (S.singleton (T.singleton c))

length :: DString -> Int
length (DString s) = fromIntegral (sum (map T.length (toList s)))

take :: Int -> DString -> DString
take n (DString s) =
    let n' = fromIntegral n
        lens = S.scanl (\acc t -> acc + T.length t) 0 s
        ndigits = S.length (S.takeWhileL (< n') lens) + 1
        text = T.take n' (T.concat (toList (S.take ndigits s)))
    in DString (S.singleton text)

drop :: Int -> DString -> DString
drop n (DString s)
    | n <= 0 = DString s
    | otherwise =
        let n' = fromIntegral n
            lens = S.scanl (\acc text -> acc + T.length text) 0 s
            ndigits = S.length (S.takeWhileL (< n') lens) - 1
            s' = S.drop ndigits s
            remain = n' - (lens `S.index` ndigits)
            s'' = case S.viewl s' of
                      S.EmptyL -> S.empty
                      text :< rest -> T.drop remain text S.<| rest
        in DString s''

null :: DString -> Bool
null (DString s) = sum (map T.length (toList s)) == 0

head :: DString -> Char
head (DString s) = case S.viewl s of
                       S.EmptyL -> error "Empty DString in DString.head"
                       text :< rest -> if T.length text > 0 then T.head text else DString.head (DString rest)

concat :: [DString] -> DString
concat strs = DString (mconcat [s | DString s <- strs])

hPutStr :: Handle -> DString -> IO ()
hPutStr h (DString s) = mapM_ (T.hPutStr h) (toList s)