binary-orphans-0.1.6.0/0000755000000000000000000000000013040626116012775 5ustar0000000000000000binary-orphans-0.1.6.0/CHANGELOG.md0000644000000000000000000000135713040626116014614 0ustar0000000000000000- 0.1.6.0 - Add instance for `hashed` in `hashable >=1.2.5.0` - 0.1.5.2 - Fix issue with binary-0.5.* - 0.1.5.1 - Fix issue with binary-0.8.4.* and GHC-7.* - 0.1.5.0 - Add `CI a` instance - Add `Alt f a` instance for `base >= 4.8.0.0` - Add `WrappedMonoid m` and `Arg a b` instances - Support `binary-0.8.4.0` - Add `Void` instance (`base <4.8`) - Add `Natural` instance (`nats <1.1`, `base <4.8`) - 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`) - 0.1.2.0 - Support `scientific >= 0.3.4` - 0.1.1.0 - Add `Dual`, `All`, `Any`, `Sum`, `Product`, `First` and `Last` instances binary-orphans-0.1.6.0/LICENSE0000644000000000000000000000276213040626116014011 0ustar0000000000000000Copyright (c) 2015, Oleg Grenrus 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 Oleg Grenrus 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. binary-orphans-0.1.6.0/Setup.hs0000644000000000000000000000005613040626116014432 0ustar0000000000000000import Distribution.Simple main = defaultMain binary-orphans-0.1.6.0/README.md0000644000000000000000000000052013040626116014251 0ustar0000000000000000# binary-orphans [![Build Status](https://travis-ci.org/phadej/binary-orphans.svg?branch=master)](https://travis-ci.org/phadej/binary-orphans) [![Hackage](https://img.shields.io/hackage/v/binary-orphans.svg)](http://hackage.haskell.org/package/binary-orphans) Orphan instances for [binary](http://hackage.haskell.org/package/binary). binary-orphans-0.1.6.0/binary-orphans.cabal0000644000000000000000000000511213040626116016714 0ustar0000000000000000name: binary-orphans version: 0.1.6.0 synopsis: Orphan instances for binary description: `binary-orphans` defines orphan instances for types in some popular packages. category: Web homepage: https://github.com/phadej/binary-orphans#readme bug-reports: https://github.com/phadej/binary-orphans/issues author: Oleg Grenrus maintainer: Oleg Grenrus license: BSD3 license-file: LICENSE tested-with: GHC==7.6.3, GHC==7.8.4, GHC==7.10.2 build-type: Simple cabal-version: >= 1.10 extra-source-files: CHANGELOG.md README.md source-repository head type: git location: https://github.com/phadej/binary-orphans library hs-source-dirs: src ghc-options: -Wall -fno-warn-orphans build-depends: base >=4.6.0.1 && <4.10 , aeson >=0.7.0.6 && <1.2 , binary >=0.5.1.1 && <0.8.5 , case-insensitive >=1.2.0.4 && <1.2.1 , hashable >=1.2.3.3 && <1.3 , scientific >=0.3.3.8 && <0.4 , tagged >=0.7.3 && <0.8.6 , 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.13 , text-binary >=0.1.0 && <0.3 , vector-binary-instances >=0.2.1.0 && <0.3 if !impl(ghc >= 8.0) build-depends: semigroups >=0.16.2.2 && <0.18.3 if !impl(ghc >= 7.10) build-depends: void >=0.7 && <0.8 , nats >=1 && <1.2 exposed-modules: Data.Binary.Orphans default-language: Haskell2010 test-suite binary-orphans-test type: exitcode-stdio-1.0 main-is: Tests.hs hs-source-dirs: test ghc-options: -Wall -fno-warn-orphans build-depends: base , aeson , binary , case-insensitive , hashable , scientific , tagged , text , time , unordered-containers , vector , binary-orphans , QuickCheck >=2.7 && <2.9.3 , quickcheck-instances >=0.3.11 && <0.3.13 , tasty >=0.10.1.2 && <0.12 , tasty-quickcheck >=0.8.3.2 && <0.9 if !impl(ghc >= 8.0) build-depends: semigroups >=0.16.2.2 && <0.18.3 if !impl(ghc >= 7.10) build-depends: void >=0.7 && <0.8 , nats >=1 && <1.2 default-language: Haskell2010 binary-orphans-0.1.6.0/src/0000755000000000000000000000000013040626116013564 5ustar0000000000000000binary-orphans-0.1.6.0/src/Data/0000755000000000000000000000000013040626116014435 5ustar0000000000000000binary-orphans-0.1.6.0/src/Data/Binary/0000755000000000000000000000000013040626116015661 5ustar0000000000000000binary-orphans-0.1.6.0/src/Data/Binary/Orphans.hs0000644000000000000000000002326413040626116017636 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# 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 -- Copyright : (C) 2015 Oleg Grenrus -- License : BSD3 -- Maintainer : Oleg Grenrus -- -- Provides orphan 'Binary' instances for types in various packages: -- -- * aeson -- * scientific (prior to scientific-0.3.4.0) -- * semigroups -- * tagged -- * text (through text-binary, or text >= 1.2.1) -- * time -- * unordered-containers -- * vector (through vector-binary-instances) -- -- Also there is @'Binary' 'Fixed'@ instance. module Data.Binary.Orphans ( -- * Class re-export Binary(..), -- * Module re-export module Data.Binary, ) where import Control.Monad (liftM, liftM2, liftM3) import qualified Data.Aeson as A import Data.Bits import Data.Binary import qualified Data.CaseInsensitive as CI import qualified Data.Fixed as Fixed import qualified Data.HashMap.Lazy as HM import qualified Data.HashSet as HS import qualified Data.Hashable as Hashable import Data.List (unfoldr, foldl') import qualified Data.List.NonEmpty as NE import qualified Data.Monoid as Monoid 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 import qualified Data.Void as Void import Numeric.Natural -- From other packages #if !(MIN_VERSION_text(1,2,1)) import Data.Text.Binary () #endif import Data.Vector.Binary () #if !(MIN_VERSION_scientific(0,3,4)) import qualified Data.Scientific as S #endif instance Binary A.Value where get = do t <- get :: Get Int case t of 0 -> fmap A.Object get 1 -> fmap A.Array get 2 -> fmap A.String get 3 -> fmap A.Number get 4 -> fmap A.Bool get 5 -> return A.Null _ -> fail $ "Invalid Value tag: " ++ show t put (A.Object v) = put (0 :: Int) >> put v put (A.Array v) = put (1 :: Int) >> put v put (A.String v) = put (2 :: Int) >> put v put (A.Number v) = put (3 :: Int) >> put v put (A.Bool v) = put (4 :: Int) >> put v put A.Null = put (5 :: Int) instance (Hashable.Hashable k, Eq k, Binary k, Binary v) => Binary (HM.HashMap k v) where get = fmap HM.fromList get put = put . HM.toList instance (Hashable.Hashable v, Eq v, Binary v) => Binary (HS.HashSet v) where get = fmap HS.fromList get put = put . HS.toList #if MIN_VERSION_hashable(1,2,5) instance (Hashable.Hashable a, Binary a) => Binary (Hashable.Hashed a) where get = fmap Hashable.hashed get put = put . Hashable.unhashed #endif #if !(MIN_VERSION_scientific(0,3,4)) instance Binary S.Scientific where get = liftM2 S.scientific get get put s = put (S.coefficient s) >> put (S.base10Exponent s) #endif instance Binary b => Binary (Tagged.Tagged s b) where put = put . Tagged.unTagged get = fmap Tagged.Tagged get #if !MIN_VERSION_binary(0,8,0) #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 ------------------------------------------------------------------------------- -- time ------------------------------------------------------------------------------- instance Binary Time.Day where get = fmap Time.ModifiedJulianDay get put = put . Time.toModifiedJulianDay instance Binary Time.UniversalTime where get = fmap Time.ModJulianDate get put = put . Time.getModJulianDate instance Binary Time.DiffTime where get = fmap Time.picosecondsToDiffTime get 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 Fixed.Pico) put = (put :: Fixed.Pico -> Put) . realToFrac instance Binary Time.TimeZone where get = liftM3 Time.TimeZone get get get put (Time.TimeZone m s n) = put m >> put s >> put n instance Binary Time.TimeOfDay where get = liftM3 Time.TimeOfDay get get get put (Time.TimeOfDay h m s) = put h >> put m >> put s instance Binary Time.LocalTime where 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 #if !MIN_VERSION_binary(0,8,4) ------------------------------------------------------------------------------- -- Monoid ------------------------------------------------------------------------------- -- | @since 0.1.1.0 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 where get = fmap Monoid.All get put = put . Monoid.getAll -- | /Since: binary-orphans-0.1.1.0/ 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) where get = fmap Monoid.Sum get put = put . Monoid.getSum -- | /Since: binary-orphans-0.1.1.0/ 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) where get = fmap Monoid.First get put = put . Monoid.getFirst -- | /Since: binary-orphans-0.1.1.0/ instance Binary a => Binary (Monoid.Last a) where get = fmap Monoid.Last get put = put . Monoid.getLast #if MIN_VERSION_base(4,8,0) -- | /Since: binary-orphans-0.1.5.0/ instance Binary (f a) => Binary (Monoid.Alt f a) where get = fmap Monoid.Alt get put = put . Monoid.getAlt #endif #endif ------------------------------------------------------------------------------- -- semigroups ------------------------------------------------------------------------------- #if !MIN_VERSION_binary(0,8,4) || !MIN_VERSION_base(4,9,0) -- | /Since: binary-orphans-0.1.3.0/ instance Binary a => Binary (Semigroup.Min a) where get = fmap Semigroup.Min get put = put . Semigroup.getMin -- | /Since: binary-orphans-0.1.3.0/ instance Binary a => Binary (Semigroup.Max a) where get = fmap Semigroup.Max get put = put . Semigroup.getMax -- | /Since: binary-orphans-0.1.3.0/ instance Binary a => Binary (Semigroup.First a) where get = fmap Semigroup.First get put = put . Semigroup.getFirst -- | /Since: binary-orphans-0.1.3.0/ instance Binary a => Binary (Semigroup.Last a) where get = fmap Semigroup.Last get put = put . Semigroup.getLast -- | /Since: binary-orphans-0.1.3.0/ instance Binary a => Binary (Semigroup.Option a) where get = fmap Semigroup.Option get put = put . Semigroup.getOption -- | /Since: binary-orphans-0.1.3.0/ instance Binary a => Binary (NE.NonEmpty a) where get = fmap NE.fromList get put = put . NE.toList -- | /Since: binary-orphans-0.1.5.0/ instance Binary m => Binary (Semigroup.WrappedMonoid m) where get = fmap Semigroup.WrapMonoid get put = put . Semigroup.unwrapMonoid -- | /Since: binary-orphans-0.1.5.0/ instance (Binary a, Binary b) => Binary (Semigroup.Arg a b) where get = liftM2 Semigroup.Arg get get put (Semigroup.Arg a b) = put a >> put b #endif ------------------------------------------------------------------------------- -- case-insensitive ------------------------------------------------------------------------------- -- | /Since: binary-orphans-0.1.5.0/ instance (CI.FoldCase a, Binary a) => Binary (CI.CI a) where get = fmap CI.mk get put = put . CI.foldedCase ------------------------------------------------------------------------------- -- void ------------------------------------------------------------------------------- #if !MIN_VERSION_binary(0,8,0) instance Binary Void.Void where put = Void.absurd get = fail "Binary.get @Void" #endif ------------------------------------------------------------------------------- -- nats ------------------------------------------------------------------------------- #ifndef MIN_VERSION_nats #define MIN_VERSION_nats(x,y,z) 0 #endif #if !MIN_VERSION_binary(0,7,3) && !MIN_VERSION_nats(1,1,0) -- Fixed-size type for a subset of Natural type NaturalWord = Word64 -- | /Since: 0.7.3.0/ instance Binary Natural where {-# INLINE put #-} put n | n <= hi = putWord8 0 >> put (fromIntegral n :: NaturalWord) -- fast path where hi = fromIntegral (maxBound :: NaturalWord) :: Natural put n = putWord8 1 >> put (unroll (abs n)) -- unroll the bytes {-# INLINE get #-} get = do tag <- get :: Get Word8 case tag of 0 -> liftM fromIntegral (get :: Get NaturalWord) _ -> do bytes <- get return $! roll bytes -- -- Fold and unfold an Integer to and from a list of its bytes -- unroll :: (Integral a, Bits a) => a -> [Word8] unroll = unfoldr step where step 0 = Nothing step i = Just (fromIntegral i, i `shiftR` 8) roll :: (Integral a, Bits a) => [Word8] -> a roll = foldl' unstep 0 . reverse where unstep a b = a `shiftL` 8 .|. fromIntegral b #endif binary-orphans-0.1.6.0/test/0000755000000000000000000000000013040626116013754 5ustar0000000000000000binary-orphans-0.1.6.0/test/Tests.hs0000644000000000000000000000422513040626116015415 0ustar0000000000000000{-# LANGUAGE CPP #-} module Main (main) where import Data.Binary import Data.Binary.Orphans () import Data.Proxy import Test.QuickCheck.Instances () import Test.Tasty import Test.Tasty.QuickCheck as QC 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) import Data.Text (Text) import Data.CaseInsensitive (CI) import Data.Monoid (Sum(..)) import Data.Semigroup (Min(..)) import qualified Data.CaseInsensitive as CI main :: IO () main = defaultMain tests tests :: TestTree tests = testGroup "Roundtrip" [ QC.testProperty "HashMap" $ roundtrip (Proxy :: Proxy (HashMap Int String)) , QC.testProperty "HashSet" $ roundtrip (Proxy :: Proxy (HashSet Int)) , QC.testProperty "UTCTime" $ roundtrip (Proxy :: Proxy UTCTime) , QC.testProperty "Day" $ roundtrip (Proxy :: Proxy Day) , QC.testProperty "DiffTime" $ roundtrip (Proxy :: Proxy DiffTime) , QC.testProperty "NominalDiffTime" $ roundtrip (Proxy :: Proxy NominalDiffTime) , 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) , QC.testProperty "CI Text" $ roundtrip (Proxy :: Proxy (CI Text)) , QC.testProperty "Sum Int" $ roundtrip (Proxy :: Proxy (Sum Int)) , QC.testProperty "Min Int" $ roundtrip (Proxy :: Proxy (Min Int)) ] roundtrip :: (Eq a, Show a, Binary a) => Proxy a -> a -> Property roundtrip _ x = x === decode (encode x) instance (CI.FoldCase a, Arbitrary a) => Arbitrary (CI a) where arbitrary = fmap CI.mk arbitrary instance Arbitrary a => Arbitrary (Min a) where arbitrary = fmap Min arbitrary shrink = fmap Min . shrink . getMin #if !MIN_VERSION_QuickCheck(2,9,0) instance Arbitrary a => Arbitrary (Sum a) where arbitrary = fmap Sum arbitrary shrink = fmap Sum . shrink . getSum #endif