{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} -------------------------------------------------------------------- -- | -- Module : Data.Vector.Cereal -- Copyright : (c) Don Stewart 2010 -- License : BSD3 -- -- Maintainer: Don Stewart -- Stability : provisional -- Portability: GHC only -- -- Instances for Serialize 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. -- -------------------------------------------------------------------- module Data.Vector.Cereal () where import Data.Serialize 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, Serialize a) => Serialize (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 {- get = do n <- get xs <- getMany n return (G.fromList xs) -- | 'getMany n' get 'n' elements in order, without blowing the stack. getMany :: Serialize 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 #-} -}