safecopy 0.3 → 0.4
raw patch · 7 files changed
+397/−272 lines, 7 filesdep −mtldep ~basesetup-changed
Dependencies removed: mtl
Dependency ranges changed: base
Files
- LICENSE +0/−35
- Setup.hs +1/−1
- safecopy.cabal +56/−13
- src/Data/SafeCopy.hs +86/−4
- src/Data/SafeCopy/Instances.hs +25/−69
- src/Data/SafeCopy/SafeCopy.hs +229/−0
- src/Data/SafeCopy/Types.hs +0/−150
− LICENSE
@@ -1,35 +0,0 @@-Copyright (c) 2007, David Himmelstrup-All rights reserved.--Redistribution and use in source and binary forms,-with or without modification, are permitted provided-that the following conditions are met:-- * Redistributions of source code must retain- the above copyright notice, this list of- conditions and the following disclaimer.- * Redistributions in binary form must reproduce- the above copyright notice, this list of- conditions and the following disclaimer in the- documentation and/or other materials provided- with the distribution.- * Neither the name of David Himmelstrup nor the- names of other contributors may be used to- endorse or promote products derived from this- software without specific prior written permission.---THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND-CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,-INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES-OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE-ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER-OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,-BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS-INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,-WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING-NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE-USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY-OF SUCH DAMAGE.
Setup.hs view
@@ -1,2 +1,2 @@ import Distribution.Simple-main = defaultMainWithHooks defaultUserHooks+main = defaultMain
safecopy.cabal view
@@ -1,17 +1,60 @@+-- safecopy.cabal auto-generated by cabal init. For additional+-- options, see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package. Name: safecopy-Version: 0.3++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version: 0.4++-- A short (one-line) description of the package. Synopsis: Binary serialization with version control.++-- A longer description of the package. Description: An extension to Data.Binary with built-in version control.-Category: Data, Parsing-License: BSD3-License-file: LICENSE++-- URL for the project homepage or repository.+Homepage: http://acid-state.seize.it/safecopy++-- The license under which the package is released.+License: PublicDomain++-- The package author(s). Author: David Himmelstrup-Maintainer: lemmih@gmail.com-Build-Depends: base, mtl, bytestring, containers, binary-Build-Type: Simple-ghc-options: -O -fglasgow-exts-Hs-Source-Dirs: src-Exposed-Modules:- Data.SafeCopy- Data.SafeCopy.Types- Data.SafeCopy.Instances++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer: Lemmih <lemmih@gmail.com>++-- A copyright notice.+-- Copyright: ++Category: Data, Parsing++Build-type: Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files: ++-- Constraint on the version of Cabal needed to build this package.+Cabal-version: >=1.6+++Library+ -- Modules exported by the library.+ Exposed-modules: Data.SafeCopy++ Hs-Source-Dirs: src/+ + -- Packages needed in order to build this package.+ Build-depends: base >=4 && <5, binary, bytestring, containers+ + -- Modules not exported by this package.+ Other-modules: Data.SafeCopy.Instances, Data.SafeCopy.SafeCopy+ + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+ -- Build-tools: +
src/Data/SafeCopy.hs view
@@ -1,8 +1,90 @@+-----------------------------------------------------------------------------+-- |+-- Module : Data.SafeCopy+-- Copyright : PublicDomain+--+-- Maintainer : lemmih@gmail.com+-- Portability : non-portable (uses GHC extensions)+--+-- SafeCopy extends the parsing and serialization capabilities of Data.Binary+-- to include nested version control. Nested version control means that you+-- can change the defintion and binary format of a type nested deep within+-- other types without problems.+--+-- Consider this scenario. You want to store your contact list on disk+-- and so write the following code:+--+-- @+--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+-- @+--+-- At this point, everything is fine. You get the awesome speed of Data.Binary+-- together with Haskell's easy of use. However, things quickly takes a turn for the worse+-- when you realize that you want to keep phone numbers as well as names and+-- addresses. Being the experienced coder that you are, you see that using a 3-tuple+-- isn't very pretty and you'd rather use a record. At first you fear that this+-- change in structure will invalidate all your old data. Those fears are quickly quelled,+-- though, when you remember how nifty SafeCopy is. With renewed enthusiasm,+-- you set out and write the following code:+--+-- @+--type Name = String+--type Address = String+--type Phone = String+--+--{- We rename our old Contacts structure -}+--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+--+--{- Here the magic happens: -}+--instance Migrate Contacts where+-- type MigrateFrom Contacts = Contacts_v0+-- migrate (Contacts_v0 contacts) = Contacts [ Contact{ name = name+-- , address = address+-- , phone = \"\" }+-- | (name, address) <- contacts ]+-- @+--+-- With this, you reflect on your code and you are happy. You feel confident in the safety of+-- your data and you know you can remove @Contacts_v0@ once you no longer wish to support+-- that legacy format. module Data.SafeCopy- ( module Data.SafeCopy.Types- , module Data.SafeCopy.Instances+ ( + safeGet+ , safePut+ , SafeCopy(..)+ , Migrate(..)+ , Kind+ , extension+ , Contained+ , contain+ , Version+ -- * Rarely used functions+ , getSafeGet+ , getSafePut+ , primitive ) where -import Data.SafeCopy.Types import Data.SafeCopy.Instances-+import Data.SafeCopy.SafeCopy
src/Data/SafeCopy/Instances.hs view
@@ -1,6 +1,6 @@ module Data.SafeCopy.Instances where -import Data.SafeCopy.Types+import Data.SafeCopy.SafeCopy import Data.Word import Data.Int@@ -20,7 +20,7 @@ instance SafeCopy a => SafeCopy [a] where- mode = Primitive+ kind = primitive getCopy = contain $ do n <- get getSafeGet >>= replicateM n@@ -30,7 +30,7 @@ getSafePut >>= forM_ lst instance SafeCopy a => SafeCopy (Maybe a) where- mode = Primitive+ kind = primitive getCopy = contain $ do n <- get if n then liftM Just safeGet else return Nothing@@ -51,104 +51,60 @@ instance (SafeCopy a, SafeCopy b) => SafeCopy (a,b) where- mode = Primitive+ kind = 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+ kind = 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+ kind = 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+ kind = Primitive; getCopy = contain $ get; putCopy = contain . put instance SafeCopy Integer where- mode = Primitive; getCopy = contain $ get; putCopy = contain . put+ kind = Primitive; getCopy = contain $ get; putCopy = contain . put instance SafeCopy Float where- mode = Primitive; getCopy = contain $ get; putCopy = contain . put+ kind = primitive; getCopy = contain $ get; putCopy = contain . put instance SafeCopy Double where- mode = Primitive; getCopy = contain $ get; putCopy = contain . put+ kind = primitive; getCopy = contain $ get; putCopy = contain . put instance SafeCopy L.ByteString where- mode = Primitive; getCopy = contain $ get; putCopy = contain . put+ kind = primitive; getCopy = contain $ get; putCopy = contain . put instance SafeCopy B.ByteString where- mode = Primitive; getCopy = contain $ get; putCopy = contain . put+ kind = primitive; getCopy = contain $ get; putCopy = contain . put instance SafeCopy Char where- mode = Primitive; getCopy = contain $ get; putCopy = contain . put+ kind = primitive; getCopy = contain $ get; putCopy = contain . put instance SafeCopy Word8 where- mode = Primitive; getCopy = contain $ get; putCopy = contain . put+ kind = primitive; getCopy = contain $ get; putCopy = contain . put instance SafeCopy Word16 where- mode = Primitive; getCopy = contain $ get; putCopy = contain . put+ kind = primitive; getCopy = contain $ get; putCopy = contain . put instance SafeCopy Word32 where- mode = Primitive; getCopy = contain $ get; putCopy = contain . put+ kind = primitive; getCopy = contain $ get; putCopy = contain . put instance SafeCopy Word64 where- mode = Primitive; getCopy = contain $ get; putCopy = contain . put+ kind = primitive; getCopy = contain $ get; putCopy = contain . put instance SafeCopy Ordering where- mode = Primitive; getCopy = contain $ get; putCopy = contain . put+ kind = primitive; getCopy = contain $ get; putCopy = contain . put instance SafeCopy Int8 where- mode = Primitive; getCopy = contain $ get; putCopy = contain . put+ kind = primitive; getCopy = contain $ get; putCopy = contain . put instance SafeCopy Int16 where- mode = Primitive; getCopy = contain $ get; putCopy = contain . put+ kind = primitive; getCopy = contain $ get; putCopy = contain . put instance SafeCopy Int32 where- mode = Primitive; getCopy = contain $ get; putCopy = contain . put+ kind = primitive; getCopy = contain $ get; putCopy = contain . put instance SafeCopy Int64 where- mode = Primitive; getCopy = contain $ get; putCopy = contain . put+ kind = primitive; getCopy = contain $ get; putCopy = contain . put instance SafeCopy () where- mode = Primitive; getCopy = contain $ get; putCopy = contain . put+ kind = primitive; getCopy = contain $ get; putCopy = contain . put instance SafeCopy Bool where- mode = Primitive; getCopy = contain $ get; putCopy = contain . put+ kind = primitive; getCopy = contain $ get; putCopy = contain . put instance (SafeCopy a, SafeCopy b) => SafeCopy (Either a b) where- mode = Primitive+ kind = 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
+ src/Data/SafeCopy/SafeCopy.hs view
@@ -0,0 +1,229 @@+{-# LANGUAGE GADTs, TypeFamilies, FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module : Data.SafeCopy.SafeCopy+-- Copyright : PublicDomain+--+-- Maintainer : lemmih@gmail.com+-- Portability : non-portable (uses GHC extensions)+--+-- SafeCopy extends the parsing and serialization capabilities of Data.Binary+-- to include nested version control. Nested version control means that you+-- can change the defintion and binary format of a type nested deep within+-- other types without problems.+--+module Data.SafeCopy.SafeCopy where++import Data.Binary as B+import Data.Binary.Put as B+import Data.Binary.Get as B+import qualified Data.ByteString.Lazy.Char8 as L+import Control.Monad+import Control.Applicative+import Data.List+++-- | The central mechanism for dealing with version control.+--+-- This type class specifies what data migrations can happen+-- and how they happen.+class SafeCopy (MigrateFrom a) => Migrate a where+ -- | This is the type we're extending. Each type capable of migration can+ -- only extend one other type.+ type MigrateFrom a++ -- | This method specifies how to migrate from the older type to the newer+ -- one. It will never be necessary to use this function manually as it+ -- all taken care of internally in the library.+ migrate :: MigrateFrom a -> a++-- | The kind of a data type determines how it is tagged (if at all).+--+-- Primitives kinds (see 'primitive') are not tagged with a version+-- id and hence cannot be extended later.+--+-- Extensions (see 'extension') tells the system that there exists+-- a previous version of the data type which should be migrated if+-- needed.+--+-- There is also a default kind which is neither primitive nor is+-- an extension of a previous type.+data Kind a where+ Primitive :: Kind a+ Base :: Kind a+ Extends :: (Migrate a) => Proxy (MigrateFrom a) -> Kind a++-- | The centerpiece of this library. Defines a version for a data type+-- together with how it should be serialized/parsed.+--+-- Users should define instances of 'SafeCopy' for their types+-- even through 'getCopy' and 'putCopy' can't be used directly.+-- To serialize/parse a data type using 'SafeCopy', see 'safeGet'+-- and 'safePut'.+class SafeCopy a where+ -- | The version of the type.+ --+ -- Only used as a key so it must be unique (this is checked at run-time)+ -- but doesn't have to be sequential or continuous.+ --+ -- The default version is '0'.+ version :: Version a+ version = Version 0++ -- | The kind specifies how versions are dealt with. By default,+ -- values are tagged with their version id and don't have any+ -- previous versions. See 'extension' and the much less used+ -- 'primitive'.+ kind :: Kind a+ kind = Base++ -- | This method defines how a value should be parsed without also worrying+ -- about writing out the version tag. This function cannot be used directly.+ -- One should use 'safeGet', instead.+ getCopy :: Contained (Get a)++ -- | This method defines how a value should be parsed without worrying about+ -- previous versions or migrations. This function cannot be used directly.+ -- One should use 'safeGet', instead.+ putCopy :: a -> Contained Put+++constructGetterFromVersion :: SafeCopy a => Version a -> Proxy a -> Get a+constructGetterFromVersion diskVersion a_proxy+ | version == diskVersion = unsafeUnPack getCopy+ | otherwise = case kindFromProxy a_proxy of+ Primitive -> fail $ "Cannot migrate from primitive types."+ Base -> fail $ "Cannot find getter associated with this version number: " ++ show diskVersion+ Extends b_proxy+ -> fmap migrate (constructGetterFromVersion (castVersion diskVersion) b_proxy)++-------------------------------------------------+-- The public interface. These functions are used+-- to parse/serialize and to create new parsers &+-- serialisers.++-- | Parse a version tagged data type and then migrate it to the desired type.+-- Any serialized value has been extended by the return type can be parsed.+safeGet :: SafeCopy a => Get a+safeGet+ = join getSafeGet++-- | Parse a version tag and return the corresponding migrated parser. This is+-- useful when you can prove that multiple values have the same version.+-- See 'getSafePut'.+getSafeGet :: SafeCopy a => Get (Get a)+getSafeGet+ = checkInvariants proxy $+ case kindFromProxy proxy of+ Primitive -> return $ unsafeUnPack getCopy+ _ -> do v <- get+ return $ constructGetterFromVersion v proxy+ where proxy = Proxy++-- | Serialize a data type by first writing out its version tag. This is much+-- simpler than the corresponding 'safeGet' since previous versions don't+-- come into play.+safePut :: SafeCopy a => a -> Put+safePut a+ = do putter <- getSafePut+ putter a++-- | Serialize the version tag and return the associated putter. This is useful+-- when serializing multiple values with the same version. See 'getSafeGet'.+getSafePut :: SafeCopy a => PutM (a -> Put)+getSafePut+ = checkInvariants proxy $+ case kindFromProxy proxy of+ Primitive -> return $ \a -> unsafeUnPack (putCopy $ asProxyType a proxy)+ _ -> do put (versionFromProxy proxy)+ return $ \a -> unsafeUnPack (putCopy $ asProxyType a proxy)+ where proxy = Proxy++-- | The extension kind lets the system know that there is+-- at least one previous version of this type. A given data type+-- can only extend a single other data type. However, it is +-- perfectly fine to build chains of extensions. The migrations+-- between each step is handled automatically.+extension :: (SafeCopy a, Migrate a) => Kind a+extension = Extends Proxy++-- | Primitive kinds aren't version tagged. This kind is used for small or built-in+-- types that won't change such as 'Int' or 'Bool'.+primitive :: Kind a+primitive = Primitive++-------------------------------------------------+-- Data type versions. Essentially just a unique+-- identifier used to lookup the corresponding+-- parser function.++-- | A simple numeric version id.+newtype Version a = Version {unVersion :: Int} deriving (Read,Show,Eq)++castVersion :: Version a -> Version b+castVersion (Version a) = Version a++instance Num (Version a) where+ Version a + Version b = Version (a+b)+ Version a - Version b = Version (a-b)+ Version a * Version b = Version (a*b)+ negate (Version a) = Version (negate a)+ abs (Version a) = Version (abs a)+ signum (Version a) = Version (signum a)+ fromInteger i = Version (fromInteger i)++instance Binary (Version a) where+ get = liftM Version get+ put = put . unVersion++-------------------------------------------------+-- Container type to control the access to the+-- parsers/putters.++-- | To ensure that no-one reads or writes values without handling versions+-- correct, it is necessary to restrict access to 'getCopy' and 'putCopy'.+-- This is where 'Contained' enters the picture. It allows you to put+-- values in to a container but not to take them out again.+data Contained a = Contained {unsafeUnPack :: a}++-- | Place a value in an unbreakable container.+contain :: a -> Contained a+contain = Contained++-------------------------------------------------+-- Consistency checking++availableVersions :: SafeCopy a => Proxy a -> [Int]+availableVersions a_proxy+ = case kindFromProxy a_proxy of+ Primitive -> []+ Base -> [unVersion (versionFromProxy a_proxy)]+ Extends b_proxy ->unVersion (versionFromProxy a_proxy) : availableVersions b_proxy++checkInvariants :: (SafeCopy a, Monad m) => Proxy a -> m b -> m b+checkInvariants proxy ks+ = if versions == nub versions+ then ks+ else fail $ "Duplicate version tags: " ++ show versions+ where versions = availableVersions proxy++-------------------------------------------------+-- Small utility functions that mean we don't+-- have to depend on ScopedTypeVariables.++versionFromProxy :: SafeCopy a => Proxy a -> Version a+versionFromProxy _ = version++kindFromProxy :: SafeCopy a => Proxy a -> Kind a+kindFromProxy _ = kind++-------------------------------------------------+-- Type proxies++data Proxy a = Proxy++mkProxy :: a -> Proxy a+mkProxy _ = Proxy++asProxyType :: a -> Proxy a -> a+asProxyType a _ = a
− src/Data/SafeCopy/Types.hs
@@ -1,150 +0,0 @@-{-# OPTIONS -fglasgow-exts #-}-module Data.SafeCopy.Types- ( SafeCopy(..)- , Migrate(..)- , Mode(..)- , Contained- , contain- , Proxy(..)- , mkProxy- , Previous- , mkPrevious--- , version- , getSafeGet- , getSafePut- , safePut- , safeGet- , safeGetVersioned- ) where--import Data.Binary as B-import Data.Binary.Put as B-import Data.Binary.Get as B-import qualified Data.ByteString.Lazy.Char8 as L-import Control.Monad--data Contained a = Contained {unsafeUnPack :: a}--contain :: a -> Contained a-contain = Contained--data Proxy a = Proxy--mkProxy :: a -> Proxy a-mkProxy _ = Proxy--asProxyType :: a -> Proxy a -> a-asProxyType a _ = a--class Migrate a b where- migrate :: a -> b--data Previous a = forall b. (SafeCopy b, Migrate b a) => Previous (Proxy b)--mkPrevious :: forall a b. (SafeCopy b, Migrate b a) => Proxy b -> Previous a-mkPrevious Proxy = Previous (Proxy :: Proxy b)--newtype Version a = Version {unVersion :: Int} deriving (Num,Read,Show,Eq)--data Mode a = Primitive- | Base- | Extension (Previous a)--class SafeCopy a where- version :: Version a- version = 0- mode :: Mode a- mode = Base- getCopy :: Contained (Get a)- putCopy :: a -> Contained Put--instance Binary (Version a) where- get = liftM Version get- put = put . unVersion--getSafeGet :: forall a. SafeCopy a => Get (Get a)-getSafeGet = case mode :: Mode a of- Primitive -> return (unsafeUnPack getCopy)- _ -> - do v <- get- return (safeGetVersioned v)--getSafePut :: forall a. SafeCopy a => PutM (a -> Put)-getSafePut = case mode :: Mode a of- Primitive -> return (unsafeUnPack . putCopy)- _ -> do B.put (version :: Version a)- return (unsafeUnPack . putCopy)---safePut :: forall a. SafeCopy a => a -> Put-safePut val = do fn <- getSafePut- fn val--safeGet :: forall a. SafeCopy a => Get a-safeGet = join getSafeGet--safeGetVersioned :: forall a b. SafeCopy b => Version a -> B.Get b-safeGetVersioned v = case compareVersions v (version :: Version b) of- GT -> error $ "Version tag too large: " ++ show v- EQ -> unsafeUnPack getCopy- LT -> case mode of- Extension (Previous (_ :: Proxy f) :: Previous b)- -> do old <- safeGetVersioned v :: B.Get f- return $ migrate old- _ -> error $ "No previous version"--compareVersions :: Version a -> Version b -> Ordering-compareVersions v1 v2 = compare (unVersion v1) (unVersion v2)----{---class Versioned a where- typeVersion :: a -> Int--data Test1 a = Test1 a-data Test2 a = Test2 a--data Sub1 = Sub1 Int; instance Versioned Sub1 where typeVersion _ = 1-data Sub2 = Sub2 String; instance Versioned Sub2 where typeVersion _ = 2--showVersion (Test1 s) = typeVersion s--}-{--class HotSwap a where- hotVersion :: Version a- hotVersion = 0- destruct :: a -> (Int,ArgList)- construct :: (Int,ArgList) -> a--data Test = Test Sub1 Sub2-data Sub1 = Sub1-data Sub2 = Sub2--data ArgList = Nil | forall a. HotSwap a => a :+: ArgList--infixr 5 :+:--instance HotSwap Test where- destruct (Test a b) = (1, a :+: b :+: Nil)- construct (1, a :+: b :+: Nil) = Test (fromHot a) (fromHot b)--instance HotSwap Sub1 where- destruct Sub1 = (1,Nil)- construct (1,Nil) = Sub1-instance HotSwap Sub2 where- destruct Sub2= (1,Nil)- construct (1,Nil) = Sub2--fromHot :: (HotSwap a, HotSwap b) => a -> b-fromHot = undefined--{--hotSwap :: forall a b. (HotSwap a, HotSwap b) => a -> b-hotSwap inp- = let inpVersion = hotVersion :: Version a- outVersion = hotVersion :: Version b- in --}--}