diff --git a/safecopy.cabal b/safecopy.cabal --- a/safecopy.cabal +++ b/safecopy.cabal @@ -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.5 +Version: 0.5.1 -- A short (one-line) description of the package. Synopsis: Binary serialization with version control. @@ -51,7 +51,7 @@ -- Packages needed in order to build this package. Build-depends: base >=4 && <5, array, cereal >= 0.3.1.0, bytestring, containers >= 0.3, - template-haskell + old-time, template-haskell, text, time -- Modules not exported by this package. Other-modules: Data.SafeCopy.Instances, Data.SafeCopy.SafeCopy, diff --git a/src/Data/SafeCopy/Instances.hs b/src/Data/SafeCopy/Instances.hs --- a/src/Data/SafeCopy/Instances.hs +++ b/src/Data/SafeCopy/Instances.hs @@ -1,29 +1,39 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts, UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Data.SafeCopy.Instances where import Data.SafeCopy.SafeCopy -import Data.Word -import Data.Int -import Data.Serialize -import Control.Applicative -import Data.Ix +import Control.Applicative +import Control.Monad import qualified Data.Array as Array import qualified Data.Array.Unboxed as UArray import qualified Data.Array.IArray as IArray +import qualified Data.ByteString.Lazy.Char8 as L +import qualified Data.ByteString.Char8 as B import qualified Data.Foldable as Foldable -import qualified Data.Map as Map +import Data.Fixed (HasResolution, Fixed) +import Data.Int import qualified Data.IntMap as IntMap import qualified Data.IntSet as IntSet +import Data.Ix +import qualified Data.Map as Map +import Data.Ratio (Ratio, (%), numerator, denominator) import qualified Data.Sequence as Sequence +import Data.Serialize import qualified Data.Set as Set +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL +import Data.Time.Calendar (Day(..)) +import Data.Time.Clock (DiffTime, NominalDiffTime, UniversalTime(..), UTCTime(..)) +import Data.Time.Clock.TAI (AbsoluteTime, taiEpoch, addAbsoluteTime, diffAbsoluteTime) +import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..), TimeZone(..), ZonedTime(..)) import qualified Data.Tree as Tree - -import qualified Data.ByteString.Lazy.Char8 as L -import qualified Data.ByteString.Char8 as B - -import Control.Monad +import Data.Word +import System.Time (ClockTime(..), TimeDiff(..), CalendarTime(..), Month(..)) +import qualified System.Time as OT instance SafeCopy a => SafeCopy [a] where kind = primitive @@ -155,6 +165,18 @@ kind = primitive; getCopy = contain get; putCopy = contain . put instance SafeCopy Int64 where kind = primitive; getCopy = contain get; putCopy = contain . put +instance (Integral a, SafeCopy a) => SafeCopy (Ratio a) where + kind = primitive; + getCopy = contain $ do n <- safeGet + d <- safeGet + return (n % d) + putCopy r = contain $ do safePut (numerator r) + safePut (denominator r) +instance (HasResolution a, Fractional (Fixed a)) => SafeCopy (Fixed a) where + kind = primitive + getCopy = contain $ fromRational <$> safeGet + putCopy = contain . safePut . toRational + instance SafeCopy () where kind = primitive; getCopy = contain get; putCopy = contain . put instance SafeCopy Bool where @@ -167,4 +189,154 @@ putCopy (Right a) = contain $ put True >> safePut a putCopy (Left a) = contain $ put False >> safePut a +-- instances for 'text' library +instance SafeCopy T.Text where + kind = base + getCopy = contain $ T.decodeUtf8 <$> safeGet + putCopy = contain . safePut . T.encodeUtf8 + +instance SafeCopy TL.Text where + kind = base + getCopy = contain $ TL.decodeUtf8 <$> safeGet + putCopy = contain . safePut . TL.encodeUtf8 + +-- instances for 'time' library + +instance SafeCopy Day where + kind = base + getCopy = contain $ ModifiedJulianDay <$> safeGet + putCopy = contain . safePut . toModifiedJulianDay + +instance SafeCopy DiffTime where + kind = base + getCopy = contain $ fromRational <$> safeGet + putCopy = contain . safePut . toRational + +instance SafeCopy UniversalTime where + kind = base + getCopy = contain $ ModJulianDate <$> safeGet + putCopy = contain . safePut . getModJulianDate + +instance SafeCopy UTCTime where + kind = base + getCopy = contain $ do day <- safeGet + diffTime <- safeGet + return (UTCTime day diffTime) + putCopy u = contain $ do safePut (utctDay u) + safePut (utctDayTime u) + +instance SafeCopy NominalDiffTime where + kind = base + getCopy = contain $ fromRational <$> safeGet + putCopy = contain . safePut . toRational + +instance SafeCopy TimeOfDay where + kind = base + getCopy = contain $ do hour <- safeGet + mins <- safeGet + sec <- safeGet + return (TimeOfDay hour mins sec) + putCopy t = contain $ do safePut (todHour t) + safePut (todMin t) + safePut (todSec t) + +instance SafeCopy TimeZone where + kind = base + getCopy = contain $ do mins <- safeGet + summerOnly <- safeGet + zoneName <- safeGet + return (TimeZone mins summerOnly zoneName) + putCopy t = contain $ do safePut (timeZoneMinutes t) + safePut (timeZoneSummerOnly t) + safePut (timeZoneName t) + +instance SafeCopy LocalTime where + kind = base + getCopy = contain $ do day <- safeGet + tod <- safeGet + return (LocalTime day tod) + putCopy t = contain $ do safePut (localDay t) + safePut (localTimeOfDay t) + +instance SafeCopy ZonedTime where + kind = base + getCopy = contain $ do localTime <- safeGet + timeZone <- safeGet + return (ZonedTime localTime timeZone) + putCopy t = contain $ do safePut (zonedTimeToLocalTime t) + safePut (zonedTimeZone t) + +instance SafeCopy AbsoluteTime where + getCopy = contain $ liftM toAbsoluteTime safeGet + where + toAbsoluteTime :: DiffTime -> AbsoluteTime + toAbsoluteTime dt = addAbsoluteTime dt taiEpoch + putCopy = contain . safePut . fromAbsoluteTime + where + fromAbsoluteTime :: AbsoluteTime -> DiffTime + fromAbsoluteTime at = diffAbsoluteTime at taiEpoch + +-- instances for old-time + +instance SafeCopy ClockTime where + kind = base + getCopy = contain $ do secs <- safeGet + pico <- safeGet + return (TOD secs pico) + putCopy (TOD secs pico) = + contain $ do safePut secs + safePut pico + +instance SafeCopy TimeDiff where + kind = base + getCopy = contain $ do year <- get + month <- get + day <- get + hour <- get + mins <- get + sec <- get + pico <- get + return (TimeDiff year month day hour mins sec pico) + putCopy t = contain $ do put (tdYear t) + put (tdMonth t) + put (tdDay t) + put (tdHour t) + put (tdMin t) + put (tdSec t) + put (tdPicosec t) + +instance SafeCopy OT.Day where + kind = base ; getCopy = contain $ toEnum <$> get ; putCopy = contain . put . fromEnum + +instance SafeCopy Month where + kind = base ; getCopy = contain $ toEnum <$> get ; putCopy = contain . put . fromEnum + + +instance SafeCopy CalendarTime where + kind = base + getCopy = contain $ do year <- get + month <- safeGet + day <- get + hour <- get + mins <- get + sec <- get + pico <- get + wday <- safeGet + yday <- get + tzname <- get + tz <- safeGet + dst <- get + return (CalendarTime year month day hour mins sec pico wday yday tzname tz dst) + putCopy t = contain $ do put (ctYear t) + safePut (ctMonth t) + put (ctDay t) + put (ctHour t) + put (ctMin t) + put (ctSec t) + put (ctPicosec t) + safePut (ctWDay t) + put (ctYDay t) + safePut (ctTZName t) + put (ctTZ t) + put (ctIsDST t)