binary-orphans 0.1.8.0 → 1.0.6
raw patch · 7 files changed
Files
- CHANGELOG.md +24/−28
- LICENSE +19/−21
- README.md +0/−6
- Setup.hs +0/−2
- binary-orphans.cabal +78/−71
- src/Data/Binary/Orphans.hs +71/−319
- test/Tests.hs +15/−30
CHANGELOG.md view
@@ -1,38 +1,34 @@-- 0.1.8.0- - `ZonedTime` instance (by @mstksg)+# 1.0.6 -- 0.1.7.0- - GHC-8.2 support- - `SystemTime` instance (`time-1.8`)+- Use automatic flags for compatibility conditionals -- 0.1.6.0- - Add instance for `hashed` in `hashable >=1.2.5.0`+# 1.0.5 -- 0.1.5.2- - Fix issue with binary-0.5.*+- Support GHC-8.6.5..GHC-9.10.1 -- 0.1.5.1- - Fix issue with binary-0.8.4.* and GHC-7.*+# 1.0.4.1 -- 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`)+- Support OneTuple-0.4 -- 0.1.4.0- - Add `AbsoluteTime` instance (thanks @neongreen)+# 1.0.4 -- 0.1.3.1- - Support GHC 7.6+- Depend on `data-byte-array` to provide `Data.Array.Byte` instance -- 0.1.3.0- - Add `Min`, `Max`, `First`, `Last`, `Option`, and `NonEmpty` instances (from `semigroups`)+# 1.0.3 -- 0.1.2.0- - Support `scientific >= 0.3.4`+- Add `ByteArray` (from `Data.Array.Byte` instance) -- 0.1.1.0- - Add `Dual`, `All`, `Any`, `Sum`, `Product`, `First` and `Last` instances+# 1.0.2++- Add `Solo` instance++# 1.0.1++- Fix `MonadFail` instances shim+- `NonEmpty` doesn't fail on empty list++# 1++Stripped down the package to only shim `binary` orphans.++For more instances check [binary-instances](https://hackage.haskell.org/package/binary-instances) package.
LICENSE view
@@ -1,30 +1,28 @@-Copyright (c) 2015, Oleg Grenrus+Copyright © 2019 @binary@-contributors, 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 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.+* 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.+* Neither the name Mark Karpov nor the names of 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.+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “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 HOLDERS 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.
− README.md
@@ -1,6 +0,0 @@-# binary-orphans--[](https://travis-ci.org/phadej/binary-orphans)-[](http://hackage.haskell.org/package/binary-orphans)--Orphan instances for [binary](http://hackage.haskell.org/package/binary).
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
binary-orphans.cabal view
@@ -1,83 +1,90 @@-name: binary-orphans-version: 0.1.8.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 <oleg.grenrus@iki.fi>-maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>-license: BSD3-license-file: LICENSE-tested-with: GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1-build-type: Simple-cabal-version: >= 1.10+cabal-version: 1.12+name: binary-orphans+version: 1.0.6+synopsis: Compatibility package for binary; provides instances+category: Data, Binary, Parsing, Compatibility+description:+ This package provides instances defined in later versions of @binary@ package+ .+ Prior version 1 this packages provided instances for other packages.+ That functionality is moved to [binary-instances](https://hackage.haskell.org/package/binary-instances) package. -extra-source-files:- CHANGELOG.md- README.md+build-type: Simple+maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>+author: Oleg Grenrus <oleg.grenrus@iki.fi>+license: BSD3+license-file: LICENSE+tested-with:+ GHC ==8.6.5+ || ==8.8.4+ || ==8.10.7+ || ==9.0.2+ || ==9.2.8+ || ==9.4.8+ || ==9.6.6+ || ==9.8.4+ || ==9.10.3+ || ==9.12.4+ || ==9.14.1 +extra-source-files: CHANGELOG.md+ source-repository head- type: git- location: https://github.com/phadej/binary-orphans+ type: git+ location: https://github.com/phadej/binary-orphans.git +flag base-ge-4-16+ description: @base >=4.16@ (GHC-9.2)+ default: True+ manual: False++flag base-ge-4-17+ description: @base >=4.17@ (GHC-9.4)+ default: True+ manual: False+ library- hs-source-dirs:- src- ghc-options: -Wall -fno-warn-orphans- build-depends:- base >=4.6.0.1 && <4.11- , aeson >=0.7.0.6 && <1.3- , binary >=0.5.1.1 && <0.8.6 || ==0.9.0.0- , 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.9- , 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.4- if !impl(ghc >= 7.10)- build-depends:- void >=0.7 && <0.8- , nats >=1 && <1.2- exposed-modules:- Data.Binary.Orphans default-language: Haskell2010+ hs-source-dirs: src+ ghc-options: -Wall+ exposed-modules: Data.Binary.Orphans+ other-extensions: CPP+ build-depends:+ base >=4.12.0.0 && <4.23+ , binary >=0.8.6.0 && <0.8.10 + if !flag(base-ge-4-16)+ build-depends: OneTuple >=0.4.2 && <0.5++ if !flag(base-ge-4-17)+ build-depends: data-array-byte >=0.1.0.1 && <0.2++ if flag(base-ge-4-16)+ build-depends: base >=4.16++ else+ build-depends: base <4.16++ if flag(base-ge-4-17)+ build-depends: base >=4.17++ else+ build-depends: base <4.17+ test-suite binary-orphans-test- type: exitcode-stdio-1.0- main-is: Tests.hs- hs-source-dirs:- test- ghc-options: -Wall -fno-warn-orphans+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: Tests.hs+ hs-source-dirs: test+ ghc-options: -Wall build-depends: base- , aeson , binary- , case-insensitive- , hashable- , scientific- , tagged- , text- , time- , unordered-containers- , vector , binary-orphans- , QuickCheck >=2.10 && <2.11- , quickcheck-instances >=0.3.16 && <0.4- , tasty >=0.10.1.2 && <0.12- , tasty-quickcheck >=0.8.3.2 && <0.10- 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+ , QuickCheck >=2.13.1 && <2.19+ , quickcheck-instances >=0.3.28 && <0.5+ , tasty >=0.10.1.2 && <1.6+ , tasty-quickcheck >=0.8.3.2 && <0.12++ if !flag(base-ge-4-17)+ build-depends: data-array-byte
src/Data/Binary/Orphans.hs view
@@ -1,340 +1,92 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE PolyKinds #-}-#if MIN_VERSION_base(4,7,0)-#define HAS_FIXED_CONSTRUCTOR-#endif-#ifndef HAS_FIXED_CONSTRUCTOR+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-}-#endif--------------------------------------------------------------------------------- |--- Module : Data.Binary.Orphans--- Copyright : (C) 2015 Oleg Grenrus--- License : BSD3--- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>------ 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--#if MIN_VERSION_time(1,8,0)-import qualified Data.Time.Clock.System as Time-#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+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE PolyKinds #-}+{-# OPTIONS_GHC -Wno-orphans #-}+module Data.Binary.Orphans () where -#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+import Data.Binary -instance Binary b => Binary (Tagged.Tagged s b) where- put = put . Tagged.unTagged- get = fmap Tagged.Tagged get+import Control.Monad (replicateM) -#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+#if MIN_VERSION_base(4,18,0)+import Data.Tuple (Solo (MkSolo))+#elif MIN_VERSION_base(4,16,0)+import Data.Tuple (Solo (Solo))+#define MkSolo Solo #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.8.0/-instance Binary Time.ZonedTime where- get = liftM2 Time.ZonedTime get get- put (Time.ZonedTime t z) = put t >> put z---- | /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_time(1,8,0)--- | /Since: binary-orphans-0.1.7.0/-instance Binary Time.SystemTime where- get = liftM2 Time.MkSystemTime get get- put (Time.MkSystemTime s ns) = put s >> put ns-#endif--#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+import Data.Tuple.Solo (Solo (MkSolo)) #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+import Data.Array.Byte (ByteArray (..), MutableByteArray (..))+import GHC.Exts+ (Int (..), indexWord8Array#, newByteArray#, sizeofByteArray#,+ unsafeFreezeByteArray#, writeWord8Array#)+import GHC.ST (ST (..), runST)+import GHC.Word (Word8 (..)) ---------------------------------------------------------------------------------- case-insensitive+-- future-binary ------------------------------------------------------------------------------- --- | /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--------------------------------------------------------------------------------+-- | @since 1.0.2+instance Binary a => Binary (Solo a) where+ put (MkSolo x) = put x+ get = fmap MkSolo get -#if !MIN_VERSION_binary(0,8,0)-instance Binary Void.Void where- put = Void.absurd- get = fail "Binary.get @Void"-#endif+-- | @since 1.0.3+instance Binary ByteArray where+ put ba = put maxI >> go 0+ where+ maxI :: Int+ maxI = sizeofByteArray ba ----------------------------------------------------------------------------------- nats--------------------------------------------------------------------------------+ go :: Int -> Put+ go i | i < maxI = put (indexByteArray ba i) >> go (i + 1)+ | otherwise = return () -#ifndef MIN_VERSION_nats-#define MIN_VERSION_nats(x,y,z) 0-#endif+ get = do+ len <- get+ xs <- replicateM len get+ return (byteArrayFromListN len xs) -#if !MIN_VERSION_binary(0,7,3) && !MIN_VERSION_nats(1,1,0)--- Fixed-size type for a subset of Natural-type NaturalWord = Word64+{-# INLINE sizeofByteArray #-}+sizeofByteArray :: ByteArray -> Int+sizeofByteArray (ByteArray ba) = I# (sizeofByteArray# ba) --- | /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+{-# INLINE indexByteArray #-}+indexByteArray :: ByteArray -> Int -> Word8+indexByteArray (ByteArray ba) (I# i) = W8# (indexWord8Array# ba i) - put n =- putWord8 1- >> put (unroll (abs n)) -- unroll the bytes+{-# INLINE byteArrayFromListN #-}+byteArrayFromListN :: Int -> [Word8] -> ByteArray+byteArrayFromListN len xs = runST $ do+ mba <- newByteArray len+ go mba 0 xs+ unsafeFreezeByteArray mba+ where+ go :: MutableByteArray s -> Int -> [Word8] -> ST s ()+ go mba i ys+ | i < len = case ys of+ [] -> writeWord8Array mba i 0 >> go mba (i + 1) ys+ z:zs -> writeWord8Array mba i z >> go mba (i + 1) zs - {-# INLINE get #-}- get = do- tag <- get :: Get Word8- case tag of- 0 -> liftM fromIntegral (get :: Get NaturalWord)- _ -> do bytes <- get- return $! roll bytes+ | otherwise = return () +{-# INLINE newByteArray #-}+newByteArray :: Int -> ST s (MutableByteArray s)+newByteArray (I# len) = ST $ \s -> case newByteArray# len s of+ (# s', mba #) -> (# s', MutableByteArray mba #) ------ 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)+{-# INLINE unsafeFreezeByteArray #-}+unsafeFreezeByteArray :: MutableByteArray s -> ST s ByteArray+unsafeFreezeByteArray (MutableByteArray mba) = ST $ \s -> case unsafeFreezeByteArray# mba s of+ (# s', ba #) -> (# s', ByteArray ba #) -roll :: (Integral a, Bits a) => [Word8] -> a-roll = foldl' unstep 0 . reverse- where- unstep a b = a `shiftL` 8 .|. fromIntegral b-#endif+{-# INLINE writeWord8Array #-}+writeWord8Array :: MutableByteArray s -> Int -> Word8 -> ST s ()+writeWord8Array (MutableByteArray mba) (I# i) (W8# w) = ST $ \s -> case writeWord8Array# mba i w s of+ s' -> (# s', () #)
test/Tests.hs view
@@ -1,43 +1,28 @@-{-# LANGUAGE CPP #-} module Main (main) where -import Data.Binary+import Data.Array.Byte (ByteArray)+import Data.Binary (Binary, decode, encode) import Data.Binary.Orphans ()-import Data.Proxy+import Data.Monoid (Sum)+import Data.Proxy (Proxy (..))+import Data.Semigroup (Min (..))+-- import Data.Tuple.Solo (Solo (..))+import Numeric.Natural (Natural)+import Test.QuickCheck (Property, (===)) 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+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.QuickCheck (testProperty) 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))+ [ testProperty "Natural" $ roundtrip (Proxy :: Proxy Natural)+ , testProperty "Sum Int" $ roundtrip (Proxy :: Proxy (Sum Int))+ , testProperty "Min Int" $ roundtrip (Proxy :: Proxy (Min Int))+ -- , testProperty "Solo Int" $ roundtrip (Proxy :: Proxy (Solo Int)) -- no Arbitrary instance (always)+ , testProperty "ByteArray" $ roundtrip (Proxy :: Proxy ByteArray) ] roundtrip :: (Eq a, Show a, Binary a) => Proxy a -> a -> Property