module Data.StorableVector.Lazy.Stream (
   from, fromList,
   to, toList,
   ) where

import qualified Data.StorableVector.Lazy as SV
import qualified Data.StorableVector.Stream as SVG
import Foreign.Storable (Storable, )

import qualified Data.Stream as G

from :: Storable a =>
   SV.ChunkSize -> G.Stream a -> SV.Vector a
from size (G.Stream f s) =
   SV.unfoldr size
      (let go s0 =
             case f s0 of
                G.Yield a s1 -> Just (a, s1)
                G.Skip s1 -> go s1
                G.Done -> Nothing
       in  go)
      s

{-# INLINE fromList #-}
fromList :: Storable a =>
   SV.ChunkSize -> [a] -> SV.Vector a
fromList size =
   from size . G.stream



to :: Storable a =>
   SV.Vector a -> G.Stream a
to =
   concatS . map SVG.to . SV.chunks

{-# INLINE toList #-}
toList :: Storable a =>
   SV.Vector a -> [a]
toList = G.unstream . to



concatS :: [G.Stream a] -> G.Stream a
concatS =
   foldr G.append empty

empty :: G.Stream a
empty =
   G.stream []
--   G.Stream (\_ -> G.Done) G.None