binary-orphans-0.1.3.0/src/0000755000000000000000000000000012637037750013574 5ustar0000000000000000binary-orphans-0.1.3.0/src/Data/0000755000000000000000000000000012573202231014430 5ustar0000000000000000binary-orphans-0.1.3.0/src/Data/Binary/0000755000000000000000000000000012637045522015665 5ustar0000000000000000binary-orphans-0.1.3.0/test/0000755000000000000000000000000012602727601013755 5ustar0000000000000000binary-orphans-0.1.3.0/src/Data/Binary/Orphans.hs0000644000000000000000000001201712637045522017634 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE PolyKinds #-} ----------------------------------------------------------------------------- -- | -- 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.Binary import Data.Fixed import qualified Data.HashMap.Lazy as HM import qualified Data.HashSet as HS import Data.Hashable (Hashable) 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 -- 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 k, Eq k, Binary k, Binary v) => Binary (HM.HashMap k v) where get = fmap HM.fromList get put = put . HM.toList instance (Hashable v, Eq v, Binary v) => Binary (HS.HashSet v) where get = fmap HS.fromList get put = put . HS.toList #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) instance Binary (Fixed a) where put (MkFixed a) = put a get = MkFixed `liftM` get #endif 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 :: 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 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 -- Monoid -- | @since 0.1.1.0 instance Binary a => Binary (Monoid.Dual a) -- | /Since: binary-orphans-0.1.1.0/ instance Binary Monoid.All -- | /Since: binary-orphans-0.1.1.0/ instance Binary Monoid.Any -- | /Since: binary-orphans-0.1.1.0/ instance Binary a => Binary (Monoid.Sum a) -- | /Since: binary-orphans-0.1.1.0/ instance Binary a => Binary (Monoid.Product a) -- | /Since: binary-orphans-0.1.1.0/ instance Binary a => Binary (Monoid.First a) -- | /Since: binary-orphans-0.1.1.0/ instance Binary a => Binary (Monoid.Last a) -- Semigroup -- | /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 binary-orphans-0.1.3.0/test/Tests.hs0000644000000000000000000000240212602727601015411 0ustar0000000000000000module 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.Monoid (Sum) 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) ] roundtrip :: (Eq a, Show a, Arbitrary a, Binary a) => Proxy a -> a -> Property roundtrip _ x = x === decode (encode x) binary-orphans-0.1.3.0/LICENSE0000644000000000000000000000276212573204110014002 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.3.0/Setup.hs0000644000000000000000000000005612573204110014423 0ustar0000000000000000import Distribution.Simple main = defaultMain binary-orphans-0.1.3.0/binary-orphans.cabal0000644000000000000000000000465312637045522016731 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.8.0. -- -- see: https://github.com/sol/hpack name: binary-orphans version: 0.1.3.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.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.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 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 >=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 , binary-orphans , quickcheck-instances >=0.3 && <0.4 , tasty >=0.10 && <0.12 , tasty-quickcheck >=0.8 && <0.9 default-language: Haskell2010 binary-orphans-0.1.3.0/CHANGELOG.md0000644000000000000000000000035512637045522014615 0ustar0000000000000000- 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.3.0/README.md0000644000000000000000000000052012573076063014260 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).