diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +- 0.1.4.0 + - Add `AbsoluteTime` instance (thanks @neongreen) + +- 0.1.3.1 + - Support GHC 7.6 + - 0.1.3.0 - Add `Min`, `Max`, `First`, `Last`, `Option`, and `NonEmpty` instances (from `semigroups`) diff --git a/binary-orphans.cabal b/binary-orphans.cabal --- a/binary-orphans.cabal +++ b/binary-orphans.cabal @@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: binary-orphans -version: 0.1.3.0 +version: 0.1.4.0 synopsis: Orphan instances for binary description: `binary-orphans` defines orphan instances for types in some popular packages. category: Web @@ -13,7 +13,7 @@ maintainer: Oleg Grenrus license: BSD3 license-file: LICENSE -tested-with: GHC==7.8.4, GHC==7.10.2 +tested-with: GHC==7.6.3, GHC==7.8.4, GHC==7.10.2 build-type: Simple cabal-version: >= 1.10 @@ -30,19 +30,19 @@ src ghc-options: -Wall -fno-warn-orphans build-depends: - base >=4.7 && <4.9 - , aeson >=0.8 && <0.10.1 - , binary >=0.7 && <0.8.1 - , hashable >=1.2 && <1.3 - , scientific >=0.3 && <0.4 - , semigroups >=0.16 && <0.18.1 - , tagged >=0.7 && <0.8.3 - , text >=1.2 && <1.3 - , time >=1.4 && <1.6.1 - , unordered-containers >=0.2 && <0.3 - , vector >=0.10 && <0.12 - , text-binary >=0.1 && <0.3 - , vector-binary-instances >=0.2 && <0.3 + base >=4.6.0.1 && <4.9 + , aeson >=0.7.0.6 && <0.10.1 + , binary >=0.5.1.1 && <0.8.1 + , hashable >=1.2.3.3 && <1.3 + , scientific >=0.3.3.8 && <0.4 + , semigroups >=0.16.2.2 && <0.18.1 + , tagged >=0.7.3 && <0.8.3 + , text >=1.2.0.6 && <1.3 + , time >=1.4.0.1 && <1.6.1 + , unordered-containers >=0.2.5.1 && <0.3 + , vector >=0.10.12.3 && <0.12 + , text-binary >=0.1.0 && <0.3 + , vector-binary-instances >=0.2.1.0 && <0.3 exposed-modules: Data.Binary.Orphans default-language: Haskell2010 @@ -54,19 +54,19 @@ test ghc-options: -Wall -fno-warn-orphans build-depends: - base >=4.7 && <4.9 - , aeson >=0.8 && <0.10.1 - , binary >=0.7 && <0.8.1 - , hashable >=1.2 && <1.3 - , scientific >=0.3 && <0.4 - , semigroups >=0.16 && <0.18.1 - , tagged >=0.7 && <0.8.3 - , text >=1.2 && <1.3 - , time >=1.4 && <1.6.1 - , unordered-containers >=0.2 && <0.3 - , vector >=0.10 && <0.12 + base >=4.6.0.1 && <4.9 + , aeson >=0.7.0.6 && <0.10.1 + , binary >=0.5.1.1 && <0.8.1 + , hashable >=1.2.3.3 && <1.3 + , scientific >=0.3.3.8 && <0.4 + , semigroups >=0.16.2.2 && <0.18.1 + , tagged >=0.7.3 && <0.8.3 + , text >=1.2.0.6 && <1.3 + , time >=1.4.0.1 && <1.6.1 + , unordered-containers >=0.2.5.1 && <0.3 + , vector >=0.10.12.3 && <0.12 , binary-orphans - , quickcheck-instances >=0.3 && <0.4 - , tasty >=0.10 && <0.12 - , tasty-quickcheck >=0.8 && <0.9 + , quickcheck-instances >=0.3.11 && <0.4 + , tasty >=0.10.1.2 && <0.12 + , tasty-quickcheck >=0.8.3.2 && <0.9 default-language: Haskell2010 diff --git a/src/Data/Binary/Orphans.hs b/src/Data/Binary/Orphans.hs --- a/src/Data/Binary/Orphans.hs +++ b/src/Data/Binary/Orphans.hs @@ -1,5 +1,11 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE PolyKinds #-} +#if MIN_VERSION_base(4,7,0) +#define HAS_FIXED_CONSTRUCTOR +#endif +#ifndef HAS_FIXED_CONSTRUCTOR +{-# LANGUAGE ScopedTypeVariables #-} +#endif ----------------------------------------------------------------------------- -- | -- Module : Data.Binary.Orphans @@ -29,7 +35,7 @@ import Control.Monad (liftM, liftM2, liftM3) import qualified Data.Aeson as A import Data.Binary -import Data.Fixed +import qualified Data.Fixed as Fixed import qualified Data.HashMap.Lazy as HM import qualified Data.HashSet as HS import Data.Hashable (Hashable) @@ -38,6 +44,7 @@ import qualified Data.Semigroup as Semigroup import qualified Data.Tagged as Tagged import qualified Data.Time as Time +import qualified Data.Time.Clock.TAI as Time -- From other packages #if !(MIN_VERSION_text(1,2,1)) @@ -88,10 +95,17 @@ get = fmap Tagged.Tagged get #if !MIN_VERSION_binary(0,8,0) -instance Binary (Fixed a) where - put (MkFixed a) = put a - get = MkFixed `liftM` get +#ifdef HAS_FIXED_CONSTRUCTOR +instance Binary (Fixed.Fixed a) where + put (Fixed.MkFixed a) = put a + get = Fixed.MkFixed `liftM` get +#else +instance Fixed.HasResolution a => Binary (Fixed.Fixed a) where + -- Using undefined :: Maybe a as a proxy, as Data.Proxy is introduced only in base-4.7 + put x = put (truncate (x * fromInteger (Fixed.resolution (undefined :: Maybe a))) :: Integer) + get = (\x -> fromInteger x / fromInteger (Fixed.resolution (undefined :: Maybe a))) `liftM` get #endif +#endif instance Binary Time.Day where get = fmap Time.ModifiedJulianDay get @@ -103,15 +117,15 @@ instance Binary Time.DiffTime where get = fmap Time.picosecondsToDiffTime get - put = (put :: Pico -> Put) . realToFrac + put = (put :: Fixed.Pico -> Put) . realToFrac instance Binary Time.UTCTime where get = liftM2 Time.UTCTime get get put (Time.UTCTime d dt) = put d >> put dt instance Binary Time.NominalDiffTime where - get = fmap realToFrac (get :: Get Pico) - put = (put :: Pico -> Put) . realToFrac + get = fmap realToFrac (get :: Get Fixed.Pico) + put = (put :: Fixed.Pico -> Put) . realToFrac instance Binary Time.TimeZone where get = liftM3 Time.TimeZone get get get @@ -125,22 +139,47 @@ get = liftM2 Time.LocalTime get get put (Time.LocalTime d tod) = put d >> put tod +-- | /Since: binary-orphans-0.1.4.0/ +instance Binary Time.AbsoluteTime where + get = fmap (flip Time.addAbsoluteTime Time.taiEpoch) get + put = put . flip Time.diffAbsoluteTime Time.taiEpoch + -- Monoid -- | @since 0.1.1.0 -instance Binary a => Binary (Monoid.Dual a) +instance Binary a => Binary (Monoid.Dual a) where + get = fmap Monoid.Dual get + put = put . Monoid.getDual + -- | /Since: binary-orphans-0.1.1.0/ -instance Binary Monoid.All +instance Binary Monoid.All where + get = fmap Monoid.All get + put = put . Monoid.getAll + -- | /Since: binary-orphans-0.1.1.0/ -instance Binary Monoid.Any +instance Binary Monoid.Any where + get = fmap Monoid.Any get + put = put . Monoid.getAny + -- | /Since: binary-orphans-0.1.1.0/ -instance Binary a => Binary (Monoid.Sum a) +instance Binary a => Binary (Monoid.Sum a) where + get = fmap Monoid.Sum get + put = put . Monoid.getSum + -- | /Since: binary-orphans-0.1.1.0/ -instance Binary a => Binary (Monoid.Product a) +instance Binary a => Binary (Monoid.Product a) where + get = fmap Monoid.Product get + put = put . Monoid.getProduct + -- | /Since: binary-orphans-0.1.1.0/ -instance Binary a => Binary (Monoid.First a) +instance Binary a => Binary (Monoid.First a) where + get = fmap Monoid.First get + put = put . Monoid.getFirst + -- | /Since: binary-orphans-0.1.1.0/ -instance Binary a => Binary (Monoid.Last a) +instance Binary a => Binary (Monoid.Last a) where + get = fmap Monoid.Last get + put = put . Monoid.getLast -- Semigroup diff --git a/test/Tests.hs b/test/Tests.hs --- a/test/Tests.hs +++ b/test/Tests.hs @@ -10,6 +10,7 @@ import Data.HashMap.Lazy (HashMap) import Data.HashSet (HashSet) import Data.Time (UTCTime, Day, DiffTime, NominalDiffTime, TimeZone, TimeOfDay, LocalTime) +import Data.Time.Clock.TAI (AbsoluteTime) import Data.Monoid (Sum) main :: IO () @@ -26,6 +27,7 @@ , QC.testProperty "TimeZone" $ roundtrip (Proxy :: Proxy TimeZone) , QC.testProperty "TimeOfDay" $ roundtrip (Proxy :: Proxy TimeOfDay) , QC.testProperty "LocalTime" $ roundtrip (Proxy :: Proxy LocalTime) + , QC.testProperty "AbsoluteTime" $ roundtrip (Proxy :: Proxy AbsoluteTime) ] roundtrip :: (Eq a, Show a, Arbitrary a, Binary a) => Proxy a -> a -> Property