Take the following program:
{-# LANGUAGE
TemplateHaskell,
TypeFamilies,
OverloadedStrings,
ScopedTypeVariables
#-}
import Data.SafeCopy
import Data.Acid
newtype X = X String
data Foo = Foo X X
deriveSafeCopy 0 'base ''X
deriveSafeCopy 0 'base ''Foo
makeAcidic ''Foo []
main = do
db :: AcidState Foo <- openLocalStateFrom "acid-hs/" (Foo (X "a") (X "b"))
putStrLn "loaded the database successfully"
createCheckpoint db
putStrLn "created checkpoint"
closeAcidState db
putStrLn "closed db"
Introduce a type Y and try to go from Foo X X to Foo X Y:
{-# LANGUAGE
TemplateHaskell,
TypeFamilies,
OverloadedStrings,
ScopedTypeVariables
#-}
import Data.SafeCopy
import Data.Acid
newtype X = X String
newtype Y = Y String -- new
data Foo = Foo X Y -- was Foo X X
deriveSafeCopy 0 'base ''X
deriveSafeCopy 1 'extension ''Y
deriveSafeCopy 0 'base ''Foo
instance Migrate Y where -- migration from X to Y
type MigrateFrom Y = X
migrate (X a) = Y a
makeAcidic ''Foo []
main = do
db :: AcidState Foo <- openLocalStateFrom "acid-hs/" undefined
putStrLn "loaded the database successfully"
createCheckpoint db
putStrLn "created checkpoint"
closeAcidState db
putStrLn "closed db"
Try to run the 1st version and then load the checkpoint in the 2nd version:
$ runghc acid1.hs
loaded the database successfully
created checkpoint
closed db
$ runghc acid2.hs
acid2.hs: Could not parse saved checkpoint due to the following error:
Failed reading: safecopy: Char: Cannot find getter associated with this version number:
Version {unVersion = 1627389952}
From: Main.Foo:
Main.X:
Ouch.
I think the reason it happens is that for Foo X X we generate the following safePut:
putCopy (Foo arg_a9dA arg_a9dB)
= contain
(do { safePut_X_a9dC <- getSafePut;
safePut_X_a9dC arg_a9dA;
safePut_X_a9dC arg_a9dB;
return () })
It will write the version tag for X only once (since writing the tag is done in getSafePut). However, when reading Foo X Y we will try to read the version tag twice:
getCopy
= contain
(Data.Serialize.Get.label
"Main.Foo:"
(do { safeGet_X_a9fJ <- getSafeGet;
safeGet_Y_a9fK <- getSafeGet;
(((return Foo) <*> safeGet_X_a9fJ) <*> safeGet_Y_a9fK) }))
Ouch.
(My actual usecase, by the way, involves migrating from something like Foo X X to Foo (X Int) (X Bool), where Int and Bool are phantom (i.e. X is defined as newtype X a = X Text).)
Take the following program:
{-# LANGUAGE TemplateHaskell, TypeFamilies, OverloadedStrings, ScopedTypeVariables #-} import Data.SafeCopy import Data.Acid newtype X = X String data Foo = Foo X X deriveSafeCopy 0 'base ''X deriveSafeCopy 0 'base ''Foo makeAcidic ''Foo [] main = do db :: AcidState Foo <- openLocalStateFrom "acid-hs/" (Foo (X "a") (X "b")) putStrLn "loaded the database successfully" createCheckpoint db putStrLn "created checkpoint" closeAcidState db putStrLn "closed db"Introduce a type
Yand try to go fromFoo X XtoFoo X Y:{-# LANGUAGE TemplateHaskell, TypeFamilies, OverloadedStrings, ScopedTypeVariables #-} import Data.SafeCopy import Data.Acid newtype X = X String newtype Y = Y String -- new data Foo = Foo X Y -- was Foo X X deriveSafeCopy 0 'base ''X deriveSafeCopy 1 'extension ''Y deriveSafeCopy 0 'base ''Foo instance Migrate Y where -- migration from X to Y type MigrateFrom Y = X migrate (X a) = Y a makeAcidic ''Foo [] main = do db :: AcidState Foo <- openLocalStateFrom "acid-hs/" undefined putStrLn "loaded the database successfully" createCheckpoint db putStrLn "created checkpoint" closeAcidState db putStrLn "closed db"Try to run the 1st version and then load the checkpoint in the 2nd version:
Ouch.
I think the reason it happens is that for
Foo X Xwe generate the followingsafePut:It will write the version tag for
Xonly once (since writing the tag is done ingetSafePut). However, when readingFoo X Ywe will try to read the version tag twice:getCopy = contain (Data.Serialize.Get.label "Main.Foo:" (do { safeGet_X_a9fJ <- getSafeGet; safeGet_Y_a9fK <- getSafeGet; (((return Foo) <*> safeGet_X_a9fJ) <*> safeGet_Y_a9fK) }))Ouch.
(My actual usecase, by the way, involves migrating from something like
Foo X XtoFoo (X Int) (X Bool), whereIntandBoolare phantom (i.e.Xis defined asnewtype X a = X Text).)