haskell - haskell 安全复制示例

Question

（源http://hackage.haskell.org/packages/archive/safecopy/0.6.1/doc/html/Data-SafeCopy.html）

如果将联系人数据类型重命名为数据 Contacts_v0

type Name     = String
type Address  = String
data Contacts = Contacts [(Name, Address)]
instance SafeCopy Contacts where
     putCopy (Contacts list) = contain $ safePut list
     getCopy = contain $ Contacts <$> safeGet

假设如何将 Contacts_v0 分配给旧的现有数据？

type Name = String
type Address = String
type Phone = String

data Contacts_v0 = Contacts_v0 [(Name, Address)]
instance SafeCopy Contacts_v0 where
     putCopy (Contacts_v0 list) = contain $ safePut list
     getCopy = contain $ Contacts_v0 <$> safeGet

data Contact = Contact { name    :: Name
                        , address :: Address
                        , phone   :: Phone }
instance SafeCopy Contact where
    putCopy Contact{..} = contain $ do safePut name; safePut address; safePut phone
    getCopy = contain $ Contact <$> safeGet <*> safeGet <*> safeGet

data Contacts = Contacts [Contact]
instance SafeCopy Contacts where
     version = 2
     kind = extension
     putCopy (Contacts contacts) = contain $ safePut contacts
     getCopy = contain $ Contacts <$> safeGet

instance Migrate Contacts where
     type MigrateFrom Contacts = Contacts_v0
     migrate (Contacts_v0 contacts) = Contacts [ Contact{ name    = name
                                                        , address = address
                                                        , phone   = "" }
                                               | (name, address) <- contacts ]

从上面的库文档中，我正在尝试这样做。

{-# LANGUAGE RecordWildCards, TypeFamilies #-}
import Control.Applicative
import Data.SafeCopy

type Name = String
type Address = String
type Phone = String

data Contacts = Contacts [(Name, Address)] deriving (Show)
instance SafeCopy Contacts where
     putCopy (Contacts list) = contain $ safePut list
     getCopy = contain $ Contacts <$> safeGet

data Contacts_v0 = Contacts_v0 [(Name, Address)] deriving (Show)
instance SafeCopy Contacts_v0 where
     putCopy (Contacts_v0 list) = contain $ safePut list
     getCopy = contain $ Contacts_v0 <$> safeGet

data Contact = Contact { name :: Name, address :: Address, phone :: Phone } deriving (Show)
instance SafeCopy Contact where
    putCopy Contact{..} = contain $ do safePut name; safePut address; safePut phone
    getCopy = contain $ Contact <$> safeGet <*> safeGet <*> safeGet

{-
data Contacts = Contacts [Contact]
instance SafeCopy Contacts where
     version = 2
     kind = extension
     putCopy (Contacts contacts) = contain $ safePut contacts
     getCopy = contain $ Contacts <$> safeGet

instance Migrate Contacts where
     type MigrateFrom Contacts = Contacts_v0
     migrate (Contacts_v0 contacts) = Contacts [ Contact{ name    = name, address = address, phone   = "" }
                                               | (name, address) <- contacts ]
-}

main :: IO ()
main = do
    let test = Contacts [("gert","home")]
    print test
    --let testNew = how do you migrate test using migrate?
    --print testNew

请注意，如果他们将新的重命名为 Contacts_v2 而不是重命名旧的，对我来说会更有意义。

也许我应该改写这个问题，safecopy 什么时候有用？

Answer 1

{-# LANGUAGE RecordWildCards, TypeFamilies#-}
import Control.Applicative
import Data.SafeCopy
import Data.Binary
import Data.Serialize.Get
import Data.Serialize.Put

type Name = String
type Address = String
type Phone = String

data Contact = Contact { name :: Name, address :: Address, phone :: Phone } deriving (Show)
instance Binary Contact where
    put Contact{..} = do put name; put address; put phone
    get = do name <- get; address <- get; phone <- get; return Contact{..}
instance SafeCopy Contact where
    putCopy Contact{..} = contain $ do safePut name; safePut address; safePut phone
    getCopy = contain $ Contact <$> safeGet <*> safeGet <*> safeGet

data Contacts = Contacts [Contact] deriving (Show)
instance Binary Contacts where
    put (Contacts set) = put set
    get = fmap Contacts get
instance SafeCopy Contacts where
     version = 2
     kind = extension
     putCopy (Contacts contacts) = contain $ safePut contacts
     getCopy = contain $ Contacts <$> safeGet
instance Migrate Contacts where
     type MigrateFrom Contacts = Contacts_v0
     migrate (Contacts_v0 contacts) = Contacts[Contact{name=name,address=address,phone=""}|(name,address)<-contacts]

data Contacts_v0 = Contacts_v0 [(Name, Address)] deriving (Show)
instance Binary Contacts_v0 where
    put (Contacts_v0 set) = put set
    get = fmap Contacts_v0 get
instance SafeCopy Contacts_v0 where
    putCopy (Contacts_v0 list) = contain $ safePut list
    getCopy = contain $ Contacts_v0 <$> safeGet

main :: IO ()
main = do
    -- 
    -- instance Binary 
    --
    let c' = Contacts[Contact{name="gert",address="home",phone="test"},Contact{name="gert2",address="home2",phone="test2"}]
    let e' = encode c'
    print e'
    let d' = decode e'
    print (d':: Contacts)

    let c = Contacts_v0 [("gert_v0","home_v0"),("gert2_v0","home2_v0")]
    let e = encode c
    print e
    let d = decode e
    print (d:: Contacts_v0)
    --can not do print (d:: Contacts) meaning you are screwed

    --
    -- instance SafeCopy
    --
    let c'' = Contacts_v0 [("gert_v0","home_v0"),("gert2_v0","home2_v0")]
    let e'' = runPut (safePut c'')
    print e''
    let d'' = runGet safeGet e''
    case d'' of
        Left _ -> print "error"
        Right d'' -> print (d'':: Contacts)
    --can do print (d:: Contacts) or print (d:: Contacts_v0) meaning you are safed