finitary-derive 2.0.0.0 → 2.1.0.0

raw patch · 9 files changed

+129/−34 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• README.md +1/−1
• finitary-derive.cabal +2/−1
• src/Data/Finitary/PackBits.hs +35/−15
• src/Data/Finitary/PackBits/Unsafe.hs +36/−6
• src/Data/Finitary/PackBytes.hs +9/−4
• src/Data/Finitary/PackInto.hs +3/−2
• src/Data/Finitary/PackWords.hs +9/−4
• test/Main.hs +24/−1

@@ -1,5 +1,15 @@ # Revision history for finitary-derive +## 2.1.0.0 -- 2019-11-24++* Fix bug in ``Ord`` instances for the ``Pack*`` types.+* Fix definition of ``Packed`` pattern to actually agree with the documentation.+* Define a ``newtype`` wrapper for better provision of ``Binary`` and+  ``Hashable`` instances for ``Vector``s of ``PackBits`` types.+* Remove ``Hashable`` and ``Binary`` instances for ``PackBits`` (both+  varieties).+* Fix documentation typoes.+ ## 2.0.0.0 -- 2019-11-23  * Remove ``Data.Finitary.Pack``.

@@ -105,7 +105,7 @@  ## Why do ``PackBytes``, ``PackWords`` and ``PackInto`` have ``Storable`` instances, but not ``PackBits``? -Because it's not clear what they should be. Let's suppose you want to bit-pack a+Because it's not clear what this instance should look like. Let's suppose you want to bit-pack a type ``Giraffe`` with cardinality 11 - what should ``sizeOf`` for ``PackBits Giraffe`` be? How about ``alignment``? The only obvious solution is padding, but in this case, you might as well use ``PackBytes``, ``PackWords`` or

@@ -3,7 +3,7 @@ -- PVP summary:        +-+------- breaking API changes --                     | | +----- non-breaking API additions --                     | | | +--- code changes with no API change-version:               2.0.0.0+version:               2.1.0.0 synopsis:              Flexible and easy deriving of type classes for finitary                        types. description:           Provides a collection of wrappers, allowing you to easily@@ -52,6 +52,7 @@ test-suite tests   type:                exitcode-stdio-1.0   main-is:             Main.hs+  ghc-options:         -O2 -threaded -rtsopts -with-rtsopts=-N   hs-source-dirs:      test   build-depends:       base >= 4.12 && < 4.14,                        hedgehog >= 1.0.1 && < 1.1,

@@ -30,6 +30,8 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}  -- | -- Module:        Data.Finitary.PackBits@@ -41,7 +43,8 @@ -- Portability:   GHC only -- -- From the [Kraft-McMillan--- inequality](https://en.wikipedia.org/wiki/Kraft%E2%80%93McMillan_inequality),+-- inequality](https://en.wikipedia.org/wiki/Kraft%E2%80%93McMillan_inequality)+-- and  -- the fact that we are not able to have \'fractional\' bits, we can derive a -- fixed-length code into a bitstring for any 'Finitary' type @a@, with code -- length \(\lceil \log_{2}(\texttt{Cardinality a}) \rceil\) bits. This code is@@ -66,7 +69,8 @@ -- by using "Data.Finitary.PackBits.Unsafe" instead. module Data.Finitary.PackBits  (-  PackBits, pattern Packed+  PackBits, pattern Packed,+  BulkPack, exposeVector ) where  import GHC.TypeLits.Extra@@ -82,6 +86,7 @@ import Data.Finitary(Finitary(..)) import Data.Finite (Finite) import Control.Monad.Trans.State.Strict (evalState, get, modify, put)+import Data.Semigroup (Dual(..))  import qualified Data.Binary as Bin import qualified Data.Bit.ThreadSafe as BT@@ -92,7 +97,7 @@ -- | An opaque wrapper around @a@, representing each value as a 'bit-packed' -- encoding. newtype PackBits (a :: Type) = PackBits (VU.Vector BT.Bit)-  deriving (Eq, Ord)+  deriving (Eq, Show)  type role PackBits nominal @@ -113,19 +118,13 @@ -- Use with this in mind. pattern Packed :: forall (a :: Type) .    (Finitary a, 1 <= Cardinality a) => -  PackBits a -> a-pattern Packed x <- (packBits -> x)-  where Packed x = unpackBits x--instance Bin.Binary (PackBits a) where-  {-# INLINE put #-}-  put = Bin.put . BT.cloneToWords . op PackBits-  {-# INLINE get #-}-  get = PackBits . BT.castFromWords <$> Bin.get+  a -> PackBits a+pattern Packed x <- (unpackBits -> x)+  where Packed x = packBits x -instance Hashable (PackBits a) where-  {-# INLINE hashWithSalt #-}-  hashWithSalt salt = hashWithSalt salt . BT.cloneToWords . op PackBits+instance Ord (PackBits a) where+  compare (PackBits v1) (PackBits v2) = getDual . VU.foldr go (Dual EQ) . VU.zipWith (,) v1 $ v2+    where go input order = (order <>) . Dual . uncurry compare $ input  instance NFData (PackBits a) where   {-# INLINE rnf #-}@@ -178,6 +177,27 @@   basicUnsafeIndexM (V_PackBits v) i = pure . PackBits . VG.unsafeSlice (i * bitLength @a) (bitLength @a) $ v  instance (Finitary a, 1 <= Cardinality a) => VU.Unbox (PackBits a)++-- | This wrapper provides an efficient 'Hashable' instance (hash the entire+-- underlying bit-packed vector, rather than each element individually), as well+-- as a 'Bin.Binary' instance (which stores or reads the entire blob of+-- bits \'in one go\').+newtype BulkPack a = BulkPack { exposeVector :: VU.Vector (PackBits a) }+  deriving (NFData)++deriving instance (Finitary a, 1 <= Cardinality a) => Eq (BulkPack a)++deriving instance (Finitary a, 1 <= Cardinality a) => Ord (BulkPack a)++instance Hashable (BulkPack a) where+  {-# INLINE hashWithSalt #-}+  hashWithSalt salt = hashWithSalt salt . BT.cloneToWords . op V_PackBits . op BulkPack++instance Bin.Binary (BulkPack a) where+  {-# INLINE put #-}+  put = Bin.put . BT.cloneToWords . op V_PackBits . op BulkPack+  {-# INLINE get #-}+  get = BulkPack . V_PackBits . BT.castFromWords <$> Bin.get  -- Helpers 

@@ -30,6 +30,8 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}  -- | -- Module:        Data.Finitary.PackBits.Unsafe@@ -41,7 +43,8 @@ -- Portability:   GHC only -- -- From the [Kraft-McMillan--- inequality](https://en.wikipedia.org/wiki/Kraft%E2%80%93McMillan_inequality),+-- inequality](https://en.wikipedia.org/wiki/Kraft%E2%80%93McMillan_inequality)+-- and  -- the fact that we are not able to have \'fractional\' bits, we can derive a -- fixed-length code into a bitstring for any 'Finitary' type @a@, with code -- length \(\lceil \log_{2}(\texttt{Cardinality a}) \rceil\) bits. This code is@@ -66,7 +69,8 @@ -- "Data.Finitary.PackBits" instead. module Data.Finitary.PackBits.Unsafe  (-  PackBits, pattern Packed+  PackBits, pattern Packed,+  BulkPack, exposeVector ) where  import GHC.TypeLits.Extra@@ -82,6 +86,7 @@ import Data.Finitary(Finitary(..)) import Data.Finite (Finite) import Control.Monad.Trans.State.Strict (evalState, get, modify, put)+import Data.Semigroup (Dual(..))  import qualified Data.Binary as Bin import qualified Data.Bit as B@@ -92,7 +97,7 @@ -- | An opaque wrapper around @a@, representing each value as a 'bit-packed' -- encoding. newtype PackBits (a :: Type) = PackBits (VU.Vector B.Bit)-  deriving (Eq, Ord)+  deriving (Eq, Show)  type role PackBits nominal @@ -113,10 +118,14 @@ -- Use with this in mind. pattern Packed :: forall (a :: Type) .    (Finitary a, 1 <= Cardinality a) => -  PackBits a -> a-pattern Packed x <- (packBits -> x)-  where Packed x = unpackBits x+  a -> PackBits a+pattern Packed x <- (unpackBits -> x)+  where Packed x = packBits x +instance Ord (PackBits a) where+  compare (PackBits v1) (PackBits v2) = getDual . VU.foldr go (Dual EQ) . VU.zipWith (,) v1 $ v2+    where go input order = (order <>) . Dual . uncurry compare $ input+ instance Bin.Binary (PackBits a) where   {-# INLINE put #-}   put = Bin.put . B.cloneToWords . op PackBits@@ -178,6 +187,27 @@   basicUnsafeIndexM (V_PackBits v) i = pure . PackBits . VG.unsafeSlice (i * bitLength @a) (bitLength @a) $ v  instance (Finitary a, 1 <= Cardinality a) => VU.Unbox (PackBits a)++-- | This wrapper provides an efficient 'Hashable' instance (hash the entire+-- underlying bit-packed vector, rather than each element individually), as well+-- as a 'Bin.Binary' instance (which stores or reads the entire blob of+-- bits \'in one go\').+newtype BulkPack a = BulkPack { exposeVector :: VU.Vector (PackBits a) }+  deriving (NFData)++deriving instance (Finitary a, 1 <= Cardinality a) => Eq (BulkPack a)++deriving instance (Finitary a, 1 <= Cardinality a) => Ord (BulkPack a)++instance Hashable (BulkPack a) where+  {-# INLINE hashWithSalt #-}+  hashWithSalt salt = hashWithSalt salt . B.cloneToWords . op V_PackBits . op BulkPack++instance Bin.Binary (BulkPack a) where+  {-# INLINE put #-}+  put = Bin.put . B.cloneToWords . op V_PackBits . op BulkPack+  {-# INLINE get #-}+  get = BulkPack . V_PackBits . B.castFromWords <$> Bin.get  -- Helpers 

@@ -78,6 +78,7 @@ import Numeric.Natural (Natural) import Data.Finite (Finite) import Control.Monad.Trans.State.Strict (evalState, get, modify, put)+import Data.Semigroup (Dual(..))  import qualified Data.Binary as Bin import qualified Data.Vector.Unboxed as VU@@ -86,7 +87,7 @@  -- | An opaque wrapper around @a@, representing each value as a byte string. newtype PackBytes (a :: Type) = PackBytes (VU.Vector Word8)-  deriving (Eq, Ord, Show)+  deriving (Eq, Show)  type role PackBytes nominal @@ -107,9 +108,13 @@ -- Use with this in mind. pattern Packed :: forall (a :: Type) .    (Finitary a, 1 <= Cardinality a) => -  PackBytes a -> a-pattern Packed x <- (packBytes -> x)-  where Packed x = unpackBytes x+  a -> PackBytes a+pattern Packed x <- (unpackBytes -> x)+  where Packed x = packBytes x++instance Ord (PackBytes a) where+  compare (PackBytes v1) (PackBytes v2) = getDual . VU.foldr go (Dual EQ) . VU.zipWith (,) v1 $ v2+    where go input order = (order <>) . Dual . uncurry compare $ input  instance Bin.Binary (PackBytes a) where   {-# INLINE put #-}

@@ -23,6 +23,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TypeApplications #-}  -- | -- Module:        Data.Finitary.PackInto@@ -110,9 +111,9 @@ pattern Packed x <- (packInto -> x)   where Packed x = unpackOutOf x -instance (Finitary a, Finitary b, Cardinality a <= Cardinality b) => Ord (PackInto a b) where+instance (Ord a, Finitary a, Finitary b, Cardinality a <= Cardinality b) => Ord (PackInto a b) where   {-# INLINE compare #-}-  compare = comparing toFinite+  compare = comparing @a (fromFinite . toFinite)  instance (Hashable b) => Hashable (PackInto a b) where   {-# INLINE hashWithSalt #-}

@@ -76,6 +76,7 @@ import Data.Hashable (Hashable(..)) import Control.DeepSeq (NFData(..)) import Control.Monad.Trans.State.Strict (evalState, get, modify, put)+import Data.Semigroup (Dual(..))  import qualified Data.Binary as Bin import qualified Data.Vector.Unboxed as VU@@ -85,7 +86,7 @@ -- | An opaque wrapper around @a@, representing each value as a fixed-length -- array of machine words. newtype PackWords (a :: Type) = PackWords (VU.Vector Word)-  deriving (Eq, Ord, Show)+  deriving (Eq, Show)  type role PackWords nominal @@ -106,9 +107,13 @@ -- Use with this in mind. pattern Packed :: forall (a :: Type) .    (Finitary a, 1 <= Cardinality a) => -  PackWords a -> a-pattern Packed x <- (packWords -> x)-  where Packed x = unpackWords x+  a -> PackWords a+pattern Packed x <- (unpackWords -> x)+  where Packed x = packWords x++instance Ord (PackWords a) where+  compare (PackWords v1) (PackWords v2) = getDual . VU.foldr go (Dual EQ) . VU.zipWith (,) v1 $ v2+    where go input order = (order <>) . Dual . uncurry compare $ input  instance Bin.Binary (PackWords a) where   {-# INLINE put #-}

@@ -15,6 +15,8 @@  - along with this program.  If not, see <http://www.gnu.org/licenses/>.  -} +{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}@@ -46,6 +48,11 @@ import Data.Finitary.PackWords (PackWords) import Data.Finitary.PackInto (PackInto) +import qualified Data.Finitary.PackBits as Safe+import qualified Data.Finitary.PackBits.Unsafe as Unsafe+import qualified Data.Finitary.PackBytes as PackBytes+import qualified Data.Finitary.PackWords as PackWords+ data Foo = Bar | Baz Word8 Word8 | Quux Word16   deriving (Eq, Show, Generic, Finitary)   deriving (Ord, Bounded, NFData, Hashable, Binary) via (Finiteness Foo)@@ -68,6 +75,13 @@ packLaws :: (Eq a, Show a, Storable a) => Gen a -> [Laws] packLaws p = [storableLaws p] +ordIsMonotonic :: forall (a :: Type) (t :: Type -> Type) . +  (Finitary a, Show a, Ord a, Ord (t a)) => +  (a -> t a) -> Property+ordIsMonotonic f = property $ do x <- forAll $ choose @a+                                 y <- forAll $ choose @a+                                 (x < y) === (f x < f y)+ finitenessTests :: [(String, [Laws])] finitenessTests = [("Small Finiteness", finitenessLaws @Foo choose),                    ("Big Finiteness", finitenessLaws @Big choose)]@@ -80,4 +94,13 @@              ("Small packed into Word64", packLaws @(PackInto Foo Word64) choose)]  main :: IO Bool-main = (&&) <$> lawsCheckMany finitenessTests <*> lawsCheckMany packTests+main = (&&) <$> checkLaws <*> checkMonotonicity+  where checkLaws = (&&) <$> lawsCheckMany finitenessTests <*> lawsCheckMany packTests+        checkMonotonicity = checkParallel . Group "Monotonicity" $ [("Small PackBits", ordIsMonotonic @Foo Safe.Packed),+                                                                    ("Small unsafe PackBits", ordIsMonotonic @Foo Unsafe.Packed),+                                                                    ("Small PackBytes", ordIsMonotonic @Foo PackBytes.Packed),+                                                                    ("Small PackWords", ordIsMonotonic @Foo PackWords.Packed),+                                                                    ("Big PackBits", ordIsMonotonic @Big Safe.Packed),+                                                                    ("Big unsafe PackBits", ordIsMonotonic @Big Unsafe.Packed),+                                                                    ("Big PackBytes", ordIsMonotonic @Big PackBytes.Packed),+                                                                    ("Big PackWords", ordIsMonotonic @Big PackWords.Packed)]