module Data.Containers.Sequence (
  Sequence(..),Stream(..),take,drop,

  -- * Strict and lazy slices (bytestrings on arbitrary Storable types)
  Slice,Slices,slice,slices,_Slices,breadth,

  V.unsafeWith
  ) where

import Algebra hiding (splitAt,take,drop)
import qualified Data.List as L
import qualified Data.ByteString.Lazy as Bytes
import qualified Data.ByteString.Char8 as Char8
import qualified Data.Vector.Storable as V

class Monoid t => Sequence t where
  splitAt :: Int -> t -> (t,t)

take :: Sequence t => Int -> t -> t
take = map2 fst splitAt
drop :: Sequence t => Int -> t -> t
drop = map2 snd splitAt

instance V.Storable a => Semigroup (V.Vector a) where (+) = (V.++)
instance V.Storable a => Monoid (V.Vector a) where zero = V.empty
  
instance Sequence [a] where
  splitAt = L.splitAt
instance Sequence Bytes where
  splitAt = Bytes.splitAt . fromIntegral
instance V.Storable a => Sequence (V.Vector a) where
  splitAt = V.splitAt

class Stream c s | s -> c where
  uncons :: s -> Maybe (c,s)
  cons :: c -> s -> s
instance Stream a [a] where
  uncons [] = Nothing
  uncons (x:xs) = Just (x,xs)
  cons = (:)
instance Stream Char Chunk where
  uncons = Char8.uncons
  cons = Char8.cons

type Slice a = V.Vector a
newtype Slices a = Slices [Slice a]
                    deriving (Semigroup,Monoid)
_Slices :: Iso (Slices a) (Slices b) [Slice a] [Slice b]
_Slices = iso Slices (\(Slices cs) -> cs)
instance V.Storable a => Sequence (Slices a) where
  splitAt _ (Slices []) = zero
  splitAt n (Slices (h:t))
    | l>n = let (vh,vt) = splitAt n h in (Slices [vh],Slices (vt:t))
    | l==n = (Slices [h],Slices t)
    | otherwise = let ~(c1,c2) = splitAt (n-l) (Slices t) in (c1 & _Slices %%~ (h:),c2)
      where l = V.length h
slice :: (V.Storable a,V.Storable b) => Iso (Slice a) (Slice b) [a] [b]
slice = iso (V.unfoldr uncons) (V.foldr (:) [])

slices :: (V.Storable a,V.Storable b) => Iso (Slices a) (Slices b) (Slice a) (Slice b)
slices = iso pure V.concat . _Slices

breadth :: V.Storable a => Slices a -> Int
breadth s = s^.._Slices & foldMap V.length