safecopy 0.6.0 → 0.6.1
raw patch · 4 files changed
+83/−23 lines, 4 filesdep ~basedep ~template-haskellPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, template-haskell
API changes (from Hackage documentation)
Files
- safecopy.cabal +5/−1
- src/Data/SafeCopy/Derive.hs +2/−0
- src/Data/SafeCopy/Instances.hs +56/−20
- src/Data/SafeCopy/SafeCopy.hs +20/−2
safecopy.cabal view
@@ -7,7 +7,7 @@ -- 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.6.0+Version: 0.6.1 -- A short (one-line) description of the package. Synopsis: Binary serialization with version control.@@ -41,6 +41,10 @@ -- Constraint on the version of Cabal needed to build this package. Cabal-version: >=1.6++Source-repository head+ type: darcs+ location: http://mirror.seize.it/safecopy/ Library
src/Data/SafeCopy/Derive.hs view
@@ -13,6 +13,7 @@ import Control.Applicative import Control.Monad import Data.Maybe (fromMaybe)+import Data.Typeable (Typeable, typeOf) import Data.Word (Word8) -- Haddock -- | Derive an instance of 'SafeCopy'.@@ -227,6 +228,7 @@ , mkGetCopy deriveType tyName cons , valD (varP 'version) (normalB $ litE $ integerL $ fromIntegral $ unVersion versionId) [] , valD (varP 'kind) (normalB (varE kindName)) []+ , funD 'errorTypeName [clause [wildP] (normalB $ litE $ StringL (show tyName)) []] ] mkPutCopy :: DeriveType -> [(Integer, Con)] -> DecQ
src/Data/SafeCopy/Instances.hs view
@@ -31,6 +31,7 @@ import Data.Time.Clock.TAI (AbsoluteTime, taiEpoch, addAbsoluteTime, diffAbsoluteTime) import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..), TimeZone(..), ZonedTime(..)) import qualified Data.Tree as Tree+import Data.Typeable import Data.Word import System.Time (ClockTime(..), TimeDiff(..), CalendarTime(..), Month(..)) import qualified System.Time as OT@@ -52,37 +53,45 @@ do put (length lst) getSafePut >>= forM_ lst + errorTypeName = typeName1+ instance SafeCopy a => SafeCopy (Maybe a) where 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+ errorTypeName = typeName1 instance (SafeCopy a, Ord a) => SafeCopy (Set.Set a) where getCopy = contain $ fmap Set.fromDistinctAscList safeGet putCopy = contain . safePut . Set.toAscList+ errorTypeName = typeName1 instance (SafeCopy a, SafeCopy b, Ord a) => SafeCopy (Map.Map a b) where getCopy = contain $ fmap Map.fromDistinctAscList safeGet putCopy = contain . safePut . Map.toAscList+ errorTypeName = typeName2 instance (SafeCopy a) => SafeCopy (IntMap.IntMap a) where getCopy = contain $ fmap IntMap.fromDistinctAscList safeGet putCopy = contain . safePut . IntMap.toAscList+ errorTypeName = typeName1 instance SafeCopy IntSet.IntSet where getCopy = contain $ fmap IntSet.fromDistinctAscList safeGet putCopy = contain . safePut . IntSet.toAscList+ errorTypeName = typeName instance (SafeCopy a) => SafeCopy (Sequence.Seq a) where getCopy = contain $ fmap Sequence.fromList safeGet putCopy = contain . safePut . Foldable.toList+ errorTypeName = typeName1 instance (SafeCopy a) => SafeCopy (Tree.Tree a) where getCopy = contain $ liftM2 Tree.Node safeGet safeGet putCopy (Tree.Node root sub) = contain $ safePut root >> safePut sub-+ errorTypeName = typeName1 iarray_getCopy :: (Ix i, SafeCopy e, SafeCopy i, IArray.IArray a e) => Contained (Get (a i e)) iarray_getCopy = contain $ do getIx <- getSafeGet@@ -101,15 +110,17 @@ instance (Ix i, SafeCopy e, SafeCopy i) => SafeCopy (Array.Array i e) where getCopy = iarray_getCopy putCopy = iarray_putCopy+ errorTypeName = typeName2 instance (IArray.IArray UArray.UArray e, Ix i, SafeCopy e, SafeCopy i) => SafeCopy (UArray.UArray i e) where getCopy = iarray_getCopy putCopy = iarray_putCopy-+ errorTypeName = typeName2 instance (SafeCopy a, SafeCopy b) => SafeCopy (a,b) where getCopy = contain $ liftM2 (,) safeGet safeGet putCopy (a,b) = contain $ safePut a >> safePut b+ errorTypeName = typeName2 instance (SafeCopy a, SafeCopy b, SafeCopy c) => SafeCopy (a,b,c) where getCopy = contain $ liftM3 (,,) safeGet safeGet safeGet putCopy (a,b,c) = contain $ safePut a >> safePut b >> safePut c@@ -134,51 +145,53 @@ instance SafeCopy Int where- getCopy = contain get; putCopy = contain . put+ getCopy = contain get; putCopy = contain . put; errorTypeName = typeName instance SafeCopy Integer where- getCopy = contain get; putCopy = contain . put+ getCopy = contain get; putCopy = contain . put; errorTypeName = typeName instance SafeCopy Float where- getCopy = contain get; putCopy = contain . put+ getCopy = contain get; putCopy = contain . put; errorTypeName = typeName instance SafeCopy Double where- getCopy = contain get; putCopy = contain . put+ getCopy = contain get; putCopy = contain . put; errorTypeName = typeName instance SafeCopy L.ByteString where- getCopy = contain get; putCopy = contain . put+ getCopy = contain get; putCopy = contain . put; errorTypeName = typeName instance SafeCopy B.ByteString where- getCopy = contain get; putCopy = contain . put+ getCopy = contain get; putCopy = contain . put; errorTypeName = typeName instance SafeCopy Char where- getCopy = contain get; putCopy = contain . put+ getCopy = contain get; putCopy = contain . put; errorTypeName = typeName instance SafeCopy Word8 where- getCopy = contain get; putCopy = contain . put+ getCopy = contain get; putCopy = contain . put; errorTypeName = typeName instance SafeCopy Word16 where- getCopy = contain get; putCopy = contain . put+ getCopy = contain get; putCopy = contain . put; errorTypeName = typeName instance SafeCopy Word32 where- getCopy = contain get; putCopy = contain . put+ getCopy = contain get; putCopy = contain . put; errorTypeName = typeName instance SafeCopy Word64 where- getCopy = contain get; putCopy = contain . put+ getCopy = contain get; putCopy = contain . put; errorTypeName = typeName instance SafeCopy Ordering where- getCopy = contain get; putCopy = contain . put+ getCopy = contain get; putCopy = contain . put; errorTypeName = typeName instance SafeCopy Int8 where- getCopy = contain get; putCopy = contain . put+ getCopy = contain get; putCopy = contain . put; errorTypeName = typeName instance SafeCopy Int16 where- getCopy = contain get; putCopy = contain . put+ getCopy = contain get; putCopy = contain . put; errorTypeName = typeName instance SafeCopy Int32 where- getCopy = contain get; putCopy = contain . put+ getCopy = contain get; putCopy = contain . put; errorTypeName = typeName instance SafeCopy Int64 where- getCopy = contain get; putCopy = contain . put+ getCopy = contain get; putCopy = contain . put; errorTypeName = typeName instance (Integral a, SafeCopy a) => SafeCopy (Ratio a) where getCopy = contain $ do n <- safeGet d <- safeGet return (n % d) putCopy r = contain $ do safePut (numerator r) safePut (denominator r)+ errorTypeName = typeName1 instance (HasResolution a, Fractional (Fixed a)) => SafeCopy (Fixed a) where getCopy = contain $ fromRational <$> safeGet putCopy = contain . safePut . toRational+ errorTypeName = typeName1 instance SafeCopy () where- getCopy = contain get; putCopy = contain . put+ getCopy = contain get; putCopy = contain . put; errorTypeName = typeName instance SafeCopy Bool where- getCopy = contain get; putCopy = contain . put+ getCopy = contain get; putCopy = contain . put; errorTypeName = typeName instance (SafeCopy a, SafeCopy b) => SafeCopy (Either a b) where getCopy = contain $ do n <- get if n then liftM Right safeGet@@ -186,17 +199,21 @@ putCopy (Right a) = contain $ put True >> safePut a putCopy (Left a) = contain $ put False >> safePut a + errorTypeName = typeName2+ -- instances for 'text' library instance SafeCopy T.Text where kind = base getCopy = contain $ T.decodeUtf8 <$> safeGet putCopy = contain . safePut . T.encodeUtf8+ errorTypeName = typeName instance SafeCopy TL.Text where kind = base getCopy = contain $ TL.decodeUtf8 <$> safeGet putCopy = contain . safePut . TL.encodeUtf8+ errorTypeName = typeName -- instances for 'time' library @@ -204,16 +221,19 @@ kind = base getCopy = contain $ ModifiedJulianDay <$> safeGet putCopy = contain . safePut . toModifiedJulianDay+ errorTypeName = typeName instance SafeCopy DiffTime where kind = base getCopy = contain $ fromRational <$> safeGet putCopy = contain . safePut . toRational+ errorTypeName = typeName instance SafeCopy UniversalTime where kind = base getCopy = contain $ ModJulianDate <$> safeGet putCopy = contain . safePut . getModJulianDate+ errorTypeName = typeName instance SafeCopy UTCTime where kind = base@@ -222,11 +242,13 @@ return (UTCTime day diffTime) putCopy u = contain $ do safePut (utctDay u) safePut (utctDayTime u)+ errorTypeName = typeName instance SafeCopy NominalDiffTime where kind = base getCopy = contain $ fromRational <$> safeGet putCopy = contain . safePut . toRational+ errorTypeName = typeName instance SafeCopy TimeOfDay where kind = base@@ -237,6 +259,7 @@ putCopy t = contain $ do safePut (todHour t) safePut (todMin t) safePut (todSec t)+ errorTypeName = typeName instance SafeCopy TimeZone where kind = base@@ -247,6 +270,7 @@ putCopy t = contain $ do safePut (timeZoneMinutes t) safePut (timeZoneSummerOnly t) safePut (timeZoneName t)+ errorTypeName = typeName instance SafeCopy LocalTime where kind = base@@ -255,6 +279,7 @@ return (LocalTime day tod) putCopy t = contain $ do safePut (localDay t) safePut (localTimeOfDay t)+ errorTypeName = typeName instance SafeCopy ZonedTime where kind = base@@ -263,6 +288,7 @@ return (ZonedTime localTime timeZone) putCopy t = contain $ do safePut (zonedTimeToLocalTime t) safePut (zonedTimeZone t)+ errorTypeName = typeName instance SafeCopy AbsoluteTime where getCopy = contain $ liftM toAbsoluteTime safeGet@@ -273,6 +299,7 @@ where fromAbsoluteTime :: AbsoluteTime -> DiffTime fromAbsoluteTime at = diffAbsoluteTime at taiEpoch+ errorTypeName = typeName -- instances for old-time @@ -337,3 +364,12 @@ safePut (ctTZName t) put (ctTZ t) put (ctIsDST t)++typeName :: Typeable a => Proxy a -> String+typeName proxy = show (typeOf (undefined `asProxyType` proxy))++typeName1 :: (Typeable1 c) => Proxy (c a) -> String+typeName1 proxy = show (typeOf1 (undefined `asProxyType` proxy))++typeName2 :: (Typeable2 c) => Proxy (c a b) -> String+typeName2 proxy = show (typeOf2 (undefined `asProxyType` proxy))
src/Data/SafeCopy/SafeCopy.hs view
@@ -109,6 +109,12 @@ proxy = proxyFromConsistency ret in ret + -- | The name of the type. This is only used in error+ -- message strings.+ -- Feel free to leave undefined in your instances.+ errorTypeName :: Proxy a -> String+ errorTypeName _ = "<unkown type>"+ #ifdef DEFAULT_SIGNATURES default getCopy :: Serialize a => Contained (Get a) getCopy = contain get@@ -122,10 +128,22 @@ 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+ Primitive -> fail $ errorMsg "Cannot migrate from primitive types."+ Base ->+ fail $+ errorMsg $+ "Cannot find getter associated with this version number: " ++ show diskVersion Extends b_proxy -> fmap migrate (constructGetterFromVersion (castVersion diskVersion) b_proxy)++ where+ errorMsg msg =+ concat+ [ "safecopy: "+ , errorTypeName a_proxy+ , ": "+ , msg+ ] ------------------------------------------------- -- The public interface. These functions are used