{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------
-- |
-- Module    : Data.Vector.Binary
-- Copyright : (c) Don Stewart 2010

-- License   : BSD3
--
-- Maintainer: Don Stewart <dons@galois.com>
-- Stability : provisional
-- Portability: GHC only

-- Instances for Binary for the types defined in the vector package,
-- making it easy to serialize vectors to and from disk. We use the
-- generic interface to vectors, so all vector types are supported.
--
-- To serialize a vector:
--
-- > *Data.Vector.Binary> let v = Data.Vector.fromList [1..10]
-- > *Data.Vector.Binary> v
-- > fromList [1,2,3,4,5,6,7,8,9,10] :: Data.Vector.Vector
-- > *Data.Vector.Binary> encode v
-- > Chunk "\NUL\NUL\NUL\NUL\NUL...\NUL\NUL\NUL\t\NUL\NUL\NUL\NUL\n" Empty
--
-- Which you can in turn compress before writing to disk:
--
-- > compress . encode $ v
-- > Chunk "\US\139\b\NUL\NUL\N...\229\240,\254:\NUL\NUL\NUL" Empty
--
--------------------------------------------------------------------

module Data.Vector.Binary () where

import Data.Binary
import qualified Data.Vector.Generic as G
import Control.Monad

import System.IO.Unsafe
import qualified Data.Vector.Generic.Mutable as M

instance (G.Vector v a, Binary a) => Binary (v a) where
    put v = do
        put (G.length v)
        mapM_ put (G.toList v)

    -- this is morally sound, if very awkward.
    -- all effects are contained, and can't escape the unsafeFreeze
    {-# INLINE get #-}
    get = do
        n  <- get

        -- new unitinialized array
        mv <- lift $ M.new n

        let fill i
                | i < n = do
                    x <- get
                    (unsafePerformIO $ M.unsafeWrite mv i x) `seq` return ()
                    fill (i+1)

                | otherwise = return ()

        fill 0

        lift $ G.unsafeFreeze mv

lift = return .unsafePerformIO

{-
    -- Uses too much space going via lists.
    -- XXX todo: fill directly from a stream. 
    get = do
        n  <- get
        xs <- getMany n
        return (G.fromList xs)


-- | 'getMany n' get 'n' elements in order, without blowing the stack.
getMany :: Binary a => Int -> Get [a]
getMany n = go [] n
 where
    go xs 0 = return $! reverse xs
    go xs i = do x <- get
                 -- we must seq x to avoid stack overflows due to laziness in
                 -- (>>=)
                 x `seq` go (x:xs) (i-1)
{-# INLINE getMany #-}

-}