finitary 1.0.0.1 → 1.1.0.0
raw patch · 5 files changed
+55/−13 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +6/−0
- README.md +5/−1
- finitary.cabal +1/−1
- src/Data/Finitary.hs +12/−5
- test/Main.hs +31/−6
CHANGELOG.md view
@@ -1,5 +1,11 @@ # Revision history for finitary +## 1.1.0.0 -- 2019-09-21++* Repair a disagreement between ``Ord`` and ``Finitary`` derivations via+ ``Generic`` (thanks jle`!).+* Fix serious bug with ``next`` and ``previous``.+ ## 1.0.0.1 -- 2019-09-17 * Fix README (no code changes).
README.md view
@@ -120,7 +120,9 @@ which we plan to provide. Some examples (with links once we have working, tested code) include: -* Automatic derivation of ``Unbox`` instances+* [Automatic derivation of instances][1]+* Type-safe refinement+* Random generation and stream sampling * Efficient sets, allowing operations like complements and a ``Monoid`` under intersection * Efficient maps@@ -142,3 +144,5 @@ This library is under the GNU General Public License, version 3 or later (SPDX code ``GPL-3.0-or-later``). For more details, see the ``LICENSE.md`` file.++[1]: https://notabug.org/koz.ross/finitary-derive
finitary.cabal view
@@ -3,7 +3,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 1.0.0.1+version: 1.1.0.0 synopsis: A better, more type-safe Enum. description: Provides a type class witnessing that a type has finitely-many inhabitants, as well as its cardinality.
src/Data/Finitary.hs view
@@ -86,6 +86,7 @@ Finitary(..) ) where +import Data.Bifunctor (bimap, first) import Numeric.Natural (Natural) import Data.Semigroup (Max, Min, Sum, Product, Dual, Last, First, Any, All) import Data.Functor.Identity (Identity)@@ -102,7 +103,7 @@ import Data.Finite (Finite, separateSum, separateProduct, combineProduct, weakenN, shiftN) import Data.Ord (Down(..)) import Control.Monad.Primitive (PrimMonad(..))-import Control.Monad (forM_)+import Control.Monad (forM_, join) import GHC.TypeLits.Compare (isLE) import Data.Type.Equality ((:~:)(..)) import Control.Monad.ST (ST, runST)@@ -207,7 +208,7 @@ -- | @previous x@ gives the inhabitant whose index precedes the index of @x@, -- or 'empty' if no such index exists. previous :: (Alternative f) => a -> f a- previous = fmap fromFinite . guarded (== maxBound) . dec . toFinite+ previous = fmap fromFinite . guarded (/= maxBound) . dec . toFinite -- | @previousSkipping i x@ \'skips back\' @i@ index values from the index of -- @x@, then gives the inhabitant whose index precedes the result, or 'empty' -- if no such index exists.@@ -217,7 +218,7 @@ -- | @next x@ gives the inhabitant whose index follows the index of @x@, or -- 'empty' if no such index exists. next :: (Alternative f) => a -> f a- next = fmap fromFinite . guarded (== minBound) . inc . toFinite+ next = fmap fromFinite . guarded (/= minBound) . inc . toFinite -- | @nextSkipping i x@ \'skips forward\' @i@ index values from the index of -- @x@, then gives the inhabitant whose index follows the result, or 'empty' -- if no such index exists.@@ -277,10 +278,10 @@ instance (GFinitary a, GFinitary b) => GFinitary (a :*: b) where type GCardinality (a :*: b) = GCardinality a * GCardinality b {-# INLINE gFromFinite #-}- gFromFinite i = let (x, y) = separateProduct i in+ gFromFinite i = let (x, y) = separateProduct' i in gFromFinite x :*: gFromFinite y {-# INLINE gToFinite #-}- gToFinite (x :*: y) = combineProduct @(GCardinality a) @(GCardinality b) (weakenN . gToFinite $ x, weakenN . gToFinite $ y)+ gToFinite (x :*: y) = combineProduct' @(GCardinality a) @(GCardinality b) (weakenN . gToFinite $ x, weakenN . gToFinite $ y) instance (GFinitary a) => GFinitary (M1 _x _y a) where type GCardinality (M1 _x _y a) = GCardinality a@@ -743,6 +744,12 @@ toFinite = roll -- Helpers++combineProduct' :: forall n m . (KnownNat n, KnownNat m) => (Finite n, Finite m) -> Finite (n * m)+combineProduct' = fromIntegral . uncurry (+) . first ((natVal $ Proxy @m) *) . bimap @_ @_ @Natural @_ @Natural fromIntegral fromIntegral++separateProduct' :: forall n m . (KnownNat n, KnownNat m) => Finite (n * m) -> (Finite n, Finite m)+separateProduct' = bimap (fromIntegral . (\x -> fromIntegral x `div` natVal @m Proxy)) (fromIntegral . (\x -> fromIntegral x `mod` natVal @m Proxy)) . join (,) unroll :: forall a m v n . (Finitary a, PrimMonad m, KnownNat n, VGM.MVector v a) => VGMS.MVector v n (PrimState m) a -> Finite (Cardinality a ^ n) -> m () unroll v acc = forM_ @_ @_ @_ @() (isLE (Proxy @1) (Proxy @n))
test/Main.hs view
@@ -29,14 +29,15 @@ module Main where +import Data.List (sort, sortOn) import Data.Ord (Down)-import Data.Maybe (isNothing)+import Data.Maybe (isNothing, isJust) import Data.Int (Int8, Int16, Int32, Int64) import Data.Word (Word8, Word16, Word32, Word64) import GHC.TypeNats import GHC.Generics import Data.Kind (Type)-import Data.Finite (Finite)+import Data.Finite (Finite, finites) import Data.Proxy (Proxy(..)) import Control.Monad.Loops (andM) import Data.Typeable (Typeable, typeRep)@@ -86,7 +87,6 @@ -- Data allTheTypes :: [SomeFinitaryRep] allTheTypes = [- SomeFinitaryRep @() Proxy, SomeFinitaryRep @(Proxy Int) Proxy, SomeFinitaryRep @Bool Proxy, SomeFinitaryRep @B.Bit Proxy,@@ -109,8 +109,7 @@ SomeFinitaryRep @(Word8, Int8) Proxy, SomeFinitaryRep @(VS.Vector 4 Bool) Proxy, SomeFinitaryRep @(VUS.Vector 4 Bool) Proxy,- SomeFinitaryRep @(VSS.Vector 4 Bool) Proxy,- SomeFinitaryRep @Foo Proxy+ SomeFinitaryRep @(VSS.Vector 4 Bool) Proxy ] constructTest :: SomeTestFunction -> GroupName -> IO Bool@@ -139,6 +138,18 @@ endIsCorrect :: forall (a :: Type) . (Finitary a, Show a, 1 <= (Cardinality a)) => Proxy a -> Property endIsCorrect _ = property $ end @a === fromFinite maxBound +previousIsCorrect :: forall (a :: Type) . (Finitary a, 1 <= Cardinality a, Show a) => Proxy a -> Property+previousIsCorrect _ = withTests (testLimit @a) (property $ do x <- forAll $ choose @a+ if x == start+ then success+ else assert . isJust . previous $ x)++nextIsCorrect :: forall (a :: Type) . (Finitary a, 1 <= Cardinality a, Show a) => Proxy a -> Property+nextIsCorrect _ = withTests (testLimit @a) (property $ do x <- forAll $ choose @a+ if x == end+ then success+ else assert . isJust . next $ x)+ skipZeroIsPrevious :: forall (a :: Type) . (Finitary a, Show a) => Proxy a -> Property skipZeroIsPrevious _ = withTests (testLimit @a) (property $ do x <- forAll $ choose @a previous @a @Maybe x === previousSkipping 0 x)@@ -157,6 +168,18 @@ i <- forAll $ choose @(Finite (Cardinality a)) iterateMN @Maybe i next x === nextSkipping i x) +-- Check the behaviour of the tuple generic so that we don't violate+-- order-preservation+agreesWithOrd :: Property+agreesWithOrd = property $ do let xs = (,) <$> [LT ..] <*> [False ..]+ sort xs === sortOn toFinite xs++-- Check that we can enumerate properly and that our type, in order, is+-- isomorphic to 'finites'+enumeratesProperly :: Property+enumeratesProperly = property $ do let xs = (,) <$> [LT ..] <*> [False ..]+ (toFinite <$> sort xs) === finites+ -- All the tests I want to use allTests :: [(SomeTestFunction, GroupName)] allTests = [@@ -166,6 +189,8 @@ (SomeTestFunction endIsCorrect, "end"), (SomeTestFunction previousStartNothing, "previous + start"), (SomeTestFunction endNextNothing, "next + end"),+ (SomeTestFunction previousIsCorrect, "previous"),+ (SomeTestFunction nextIsCorrect, "next"), (SomeTestFunction skipZeroIsPrevious, "previousSkipping 0"), (SomeTestFunction skipZeroIsNext, "nextSkipping 0"), (SomeTestFunction skipNPreviousAgrees, "previousSkipping n"),@@ -173,4 +198,4 @@ ] main :: IO Bool-main = andM . fmap (uncurry constructTest) $ allTests+main = andM . (:) (checkSequential . Group "Ord agreement" $ [("ordering", agreesWithOrd), ("totality", enumeratesProperly)]) . fmap (uncurry constructTest) $ allTests