Instances.hs

module Data.SafeCopy.Instances where

import Data.SafeCopy.Types

import Data.Word
import Data.Int
import Data.Maybe
import Data.Binary
import Data.Binary.Put
import Data.Binary.Get
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import qualified Data.Set as Set

import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.ByteString.Char8 as B

import Control.Monad



instance SafeCopy a => SafeCopy [a] where
    mode = Primitive
    getCopy = contain $
              do n <- get
                 getSafeGet >>= replicateM n
    putCopy lst
        = contain $
          do put (length lst)
             getSafePut >>= forM_ lst

instance SafeCopy a => SafeCopy (Maybe a) where
    mode = Primitive
    getCopy = contain $ do n <- get
                           if n then liftM Just safeGet
                                else return Nothing
    putCopy (Just a) = contain $ put True >> safePut a
    putCopy Nothing = contain $ put False

instance (SafeCopy a, Ord a) => SafeCopy (Set.Set a) where
    getCopy = contain $ fmap Set.fromList safeGet
    putCopy = contain . safePut . Set.toList

instance (SafeCopy a,SafeCopy b, Ord a) => SafeCopy (Map.Map a b) where
    getCopy = contain $ fmap Map.fromList safeGet
    putCopy = contain . safePut . Map.toList

instance (SafeCopy a) => SafeCopy (IntMap.IntMap a) where
    getCopy = contain $ fmap IntMap.fromList safeGet
    putCopy = contain . safePut . IntMap.toList


instance (SafeCopy a, SafeCopy b) => SafeCopy (a,b) where
    mode = Primitive
    getCopy = contain $ liftM2 (,) safeGet safeGet
    putCopy (a,b) = contain $ safePut a >> safePut b
instance (SafeCopy a, SafeCopy b, SafeCopy c) => SafeCopy (a,b,c) where
    mode = Primitive
    getCopy = contain $ liftM3 (,,) safeGet safeGet safeGet
    putCopy (a,b,c) = contain $ safePut a >> safePut b >> safePut c
instance (SafeCopy a, SafeCopy b, SafeCopy c, SafeCopy d) => SafeCopy (a,b,c,d) where
    mode = Primitive
    getCopy = contain $ liftM4 (,,,) safeGet safeGet safeGet safeGet
    putCopy (a,b,c,d) = contain $ safePut a >> safePut b >> safePut c >> safePut d

instance SafeCopy Int where
    mode = Primitive; getCopy = contain $ get; putCopy = contain . put
instance SafeCopy Integer where
    mode = Primitive; getCopy = contain $ get; putCopy = contain . put
instance SafeCopy Float where
    mode = Primitive; getCopy = contain $ get; putCopy = contain . put
instance SafeCopy Double where
    mode = Primitive; getCopy = contain $ get; putCopy = contain . put
instance SafeCopy L.ByteString where
    mode = Primitive; getCopy = contain $ get; putCopy = contain . put
instance SafeCopy B.ByteString where
    mode = Primitive; getCopy = contain $ get; putCopy = contain . put
instance SafeCopy Char where
    mode = Primitive; getCopy = contain $ get; putCopy = contain . put
instance SafeCopy Word8 where
    mode = Primitive; getCopy = contain $ get; putCopy = contain . put
instance SafeCopy Word16 where
    mode = Primitive; getCopy = contain $ get; putCopy = contain . put
instance SafeCopy Word32 where
    mode = Primitive; getCopy = contain $ get; putCopy = contain . put
instance SafeCopy Word64 where
    mode = Primitive; getCopy = contain $ get; putCopy = contain . put
instance SafeCopy Ordering where
    mode = Primitive; getCopy = contain $ get; putCopy = contain . put
instance SafeCopy Int8 where
    mode = Primitive; getCopy = contain $ get; putCopy = contain . put
instance SafeCopy Int16 where
    mode = Primitive; getCopy = contain $ get; putCopy = contain . put
instance SafeCopy Int32 where
    mode = Primitive; getCopy = contain $ get; putCopy = contain . put
instance SafeCopy Int64 where
    mode = Primitive; getCopy = contain $ get; putCopy = contain . put
instance SafeCopy () where
    mode = Primitive; getCopy = contain $ get; putCopy = contain . put
instance SafeCopy Bool where
    mode = Primitive; getCopy = contain $ get; putCopy = contain . put
instance (SafeCopy a, SafeCopy b) => SafeCopy (Either a b) where
    mode = Primitive
    getCopy = contain $ do n <- get
                           if n then liftM Right safeGet
                                else liftM Left safeGet
    putCopy (Right a) = contain $ put True >> safePut a
    putCopy (Left a) = contain $ put False >> safePut a


data Test1 = Test1 deriving (Read,Show)
data Test2 = Test2 [Int] deriving (Read,Show)
data Test3 = Test3 [Integer] deriving (Read,Show)
data Test4 = Test4 [Sub2] deriving (Read,Show)
data Sub1 = Sub1 Integer deriving (Read,Show)
data Sub2 = Sub2 Int deriving (Read,Show)
instance SafeCopy Test1 where getCopy = contain $ return Test1; putCopy _ = contain $ return ()
instance SafeCopy Test2 where
    version = 2
    mode    = Extension (mkPrevious (Proxy :: Proxy Test1))
    getCopy = contain $ fmap Test2 get
    putCopy (Test2 lst) = contain $ put lst
instance Migrate Test1 Test2 where
    migrate Test1 = Test2 []

instance SafeCopy Test3 where
    version = 3
    mode    = Extension (mkPrevious (Proxy :: Proxy Test2))
    getCopy = contain $ fmap Test3 get
    putCopy (Test3 lst) = contain $ put lst
instance Migrate Test2 Test3 where
    migrate (Test2 lst) = Test3 (map fromIntegral lst)

instance SafeCopy Test4 where
    version = 4
    mode    = Extension (mkPrevious (Proxy :: Proxy Test3))
    getCopy = contain $ fmap Test4 safeGet
    putCopy (Test4 lst) = contain $ safePut lst
instance Migrate Test3 Test4 where
    migrate (Test3 lst) = Test4 (map Sub2 $ map fromIntegral lst)

instance SafeCopy Sub1 where
    getCopy = contain $ fmap Sub1 get
    putCopy (Sub1 n) = contain $ put n

instance Migrate Sub1 Sub2 where
    migrate (Sub1 n) = Sub2 (fromIntegral n)
instance SafeCopy Sub2 where
    version = 2
    mode    = Extension (mkPrevious (Proxy :: Proxy Sub1))
    getCopy = contain $ fmap Sub2 get
    putCopy (Sub2 n) = contain $ put n