finitary 2.1.3.0 → 2.2.0.1
raw patch · 5 files changed
Files
- CHANGELOG.md +20/−0
- README.md +0/−7
- finitary.cabal +13/−14
- src/Data/Finitary.hs +16/−16
- test/Main.hs +95/−46
CHANGELOG.md view
@@ -1,5 +1,25 @@ # Revision history for finitary +## 2.2.0.1 -- 2026-04-18 + +* Relax upper bounds: + + - `ghc-typelits-knownnat`: `< 0.8 ==> < 0.9` + - `ghc-typelits-natnormalise`: `< 0.8 ==> < 0.10` + +* Update the testsuite to account for changes in `hspec-hedgehog`. + +## 2.2.0.0 -- 2024-08-07 + +* Fix behaviour of `previous` and `next`, which incorrectly handled endpoints. + Thanks to `blmage` for their contribution. + +* Relax upper bounds: + + - `primitive`: `< 0.8 ==> < 0.10` + - `vector`: `< 0.13 ==> < 0.14` + - `vector-sized`: `< 1.6 ==> < 1.7` + ## 2.1.3.0 -- 2024-05-09 * Add support for `finite-typelits >= 2.0.0`.
README.md view
@@ -133,13 +133,6 @@ If there's something else interesting you think can be done with this, let us know: it might make it onto this list, and into code. -## What will this work on? - -Currently, we support GHC versions ranging from 8.6 to 9.0. - -The library has been tested on x86_64, GNU/Linux and Windows. -If you have results on other platforms or architectures, please let us know too! - ## License This library is under the GNU General Public License, version 3 or later (SPDX
finitary.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: finitary -version: 2.1.3.0 +version: 2.2.0.1 synopsis: A better, more type-safe Enum. description: Provides a type class witnessing that a type has @@ -9,8 +9,8 @@ Generics, together with a range of instances for existing types. -homepage: https://notabug.org/sheaf/finitary -bug-reports: https://notabug.org/sheaf/finitary/issues +homepage: https://codeberg.org/sheaf/finitary +bug-reports: https://codeberg.org/sheaf/finitary/issues license: GPL-3.0-or-later license-file: LICENSE.md author: Koz Ross @@ -18,7 +18,6 @@ copyright: (C) Koz Ross 2019-2020 category: Data build-type: Simple -tested-with: GHC ==8.6.5 || ==8.8.3 || ==8.10.1 || == 9.0.1 extra-source-files: CHANGELOG.md README.md @@ -36,7 +35,7 @@ source-repository head type: git - location: git://notabug.org/sheaf/finitary.git + location: https://codeberg.org/sheaf/finitary.git library exposed-modules: Data.Finitary @@ -47,11 +46,11 @@ , finite-typelits >= 0.1.4.2 && < 0.3 , ghc-typelits-knownnat - ^>= 0.7.2 + >= 0.7.2 && < 0.9 , ghc-typelits-natnormalise - ^>= 0.7.2 + >= 0.7.2 && < 0.10 , template-haskell - >= 2.14.0.0 && < 3.0.0.0 + >= 2.14.0.0 && < 3 if flag(bitvec) cpp-options: @@ -64,13 +63,13 @@ -DVECTOR build-depends: , primitive - ^>= 0.7.0.1 + >= 0.7.0.1 && < 0.10 , vector - ^>= 0.12.1.2 + >= 0.12.1.2 && < 0.14 , vector-sized - >= 1.4.1.0 && < 1.6 + >= 1.4.1.0 && < 1.7 , typelits-witnesses - ^>= 0.4.0.1 + >= 0.4.0.1 && < 0.5 hs-source-dirs: src ghc-options: @@ -91,11 +90,11 @@ , ghc-typelits-knownnat , ghc-typelits-natnormalise , hedgehog - >= 1.0.2 && < 1.3 + >= 1.0.2 && < 1.8 , hspec >= 2.7.1 && < 3.0 , hspec-hedgehog - >= 0.0.1.2 && < 0.2 + >= 0.0.1.2 && < 0.4 , primitive , template-haskell , typelits-witnesses
src/Data/Finitary.hs view
@@ -257,12 +257,12 @@ -- | @previous x@ gives 'Just' the inhabitant whose index precedes the index of @x@, -- or 'Nothing' if no such index exists. previous :: a -> Maybe a - previous = fmap fromFinite . guarded (/= maxBound) . dec . toFinite + previous = fmap (fromFinite . dec) . guarded (/= minBound) . toFinite -- | @next x@ gives 'Just' the inhabitant whose index follows the index of @x@, or -- 'Nothing' if no such index exists. next :: a -> Maybe a - next = fmap fromFinite . guarded (/= minBound) . inc . toFinite + next = fmap (fromFinite . inc) . guarded (/= maxBound) . toFinite class (KnownNat (GCardinality a)) => GFinitary (a :: Type -> Type) where type GCardinality a :: Nat @@ -420,9 +420,9 @@ {-# INLINE end #-} end = maxBound {-# INLINE next #-} - next = guarded (== minBound) . inc + next = fmap inc . guarded (/= maxBound) {-# INLINE previous #-} - previous = guarded (== maxBound) . dec + previous = fmap dec . guarded (/= minBound) instance Finitary Word64 where type Cardinality Word64 = $(cardinalityOf @Word64) @@ -435,9 +435,9 @@ {-# INLINE end #-} end = maxBound {-# INLINE next #-} - next = guarded (== minBound) . inc + next = fmap inc . guarded (/= maxBound) {-# INLINE previous #-} - previous = guarded (== maxBound) . dec + previous = fmap dec . guarded (/= minBound) instance Finitary Int8 where type Cardinality Int8 = $(cardinalityOf @Int8) @@ -480,9 +480,9 @@ {-# INLINE end #-} end = maxBound {-# INLINE next #-} - next = guarded (== minBound) . inc + next = fmap inc . guarded (/= maxBound) {-# INLINE previous #-} - previous = guarded (== maxBound) . dec + previous = fmap dec . guarded (/= minBound) instance Finitary Int64 where type Cardinality Int64 = $(cardinalityOf @Int64) @@ -495,9 +495,9 @@ {-# INLINE end #-} end = maxBound {-# INLINE next #-} - next = guarded (== minBound) . inc + next = fmap inc . guarded (/= maxBound) {-# INLINE previous #-} - previous = guarded (== maxBound) . dec + previous = fmap dec . guarded (/= minBound) -- Variable-width instances @@ -514,9 +514,9 @@ {-# INLINE end #-} end = maxBound {-# INLINE next #-} - next = guarded (== minBound) . inc + next = fmap inc . guarded (/= maxBound) {-# INLINE previous #-} - previous = guarded (== maxBound) . dec + previous = fmap dec . guarded (/= minBound) -- | 'Word' has a finite number of inhabitants, varying by platform. This -- instance will determine this when the library is built. @@ -531,9 +531,9 @@ {-# INLINE end #-} end = maxBound {-# INLINE next #-} - next = guarded (== minBound) . inc + next = fmap inc . guarded (/= maxBound) {-# INLINE previous #-} - previous = guarded (== maxBound) . dec + previous = fmap dec . guarded (/= minBound) -- | Since any type is isomorphic to itself, it follows that a \'valid\' @Finite -- n@ (meaning that @n@ is a 'KnownNat') has finite cardinality. @@ -548,9 +548,9 @@ {-# INLINE end #-} end = maxBound {-# INLINE next #-} - next = guarded (== minBound) . inc + next = fmap inc . guarded (/= maxBound) {-# INLINE previous #-} - previous = guarded (== maxBound) . dec + previous = fmap dec . guarded (/= minBound) -- | @Maybe a@ introduces one additional inhabitant (namely, 'Nothing') to @a@. instance (Finitary a) => Finitary (Maybe a)
test/Main.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} {- - Copyright (C) 2019 Koz Ross <koz.ross@retro-freedom.nz> @@ -24,106 +25,146 @@ module Main where +-- base +import Data.Bit (Bit) import Data.Finitary (Finitary (..)) -import Data.Int (Int16, Int32, Int8) +import Data.Finite (Finite) +import Data.Functor.Const (Const) +import Data.Functor.Identity (Identity) +import Data.Int (Int16, Int32, Int64, Int8) import Data.Ord (Down (..)) +import Data.Proxy (Proxy (..)) +import Data.Semigroup (All, Any, Dual, First, Last, Max, Min, Product, Sum) +import Data.Word (Word16, Word32, Word64, Word8) +import Foreign.Storable (Storable) +import GHC.Generics (Generic) +import GHC.TypeNats (type (<=)) + +-- vector-sized import qualified Data.Vector.Sized as V import qualified Data.Vector.Storable.Sized as VS import Data.Vector.Unboxed.Sized (Unbox) import qualified Data.Vector.Unboxed.Sized as VU -import Data.Word (Word16, Word32, Word8) -import Foreign.Storable (Storable) -import GHC.Generics (Generic) + +-- hedgehog import Hedgehog ((===), Gen, PropertyT, forAll) import qualified Hedgehog.Gen as Gen import Hedgehog.Range (constantBounded) -import Test.Hspec (SpecWith, describe, hspec, it, parallel) -import Test.Hspec.Hedgehog (hedgehog, modifyMaxSize) +-- hspec +import Test.Hspec (SpecWith, describe, hspec, it, parallel, shouldBe) + +-- hspec-hedgehod +import Test.Hspec.Hedgehog (hedgehog) + +-------------------------------------------------------------------------------- + main :: IO () main = hspec . parallel $ do + describe "Previous and next values for bounds" $ do + checkBoundsPrevNext (Proxy @All) "All" + checkBoundsPrevNext (Proxy @Any) "Any" + checkBoundsPrevNext (Proxy @Int16) "Int16" + checkBoundsPrevNext (Proxy @Int32) "Int32" + checkBoundsPrevNext (Proxy @Int64) "Int64" + checkBoundsPrevNext (Proxy @Int8) "Int8" + checkBoundsPrevNext (Proxy @Word16) "Word16" + checkBoundsPrevNext (Proxy @Word32) "Word32" + checkBoundsPrevNext (Proxy @Word64) "Word64" + checkBoundsPrevNext (Proxy @Word8) "Word8" + checkBoundsPrevNext (Proxy @Bit) "Bit" + checkBoundsPrevNext (Proxy @Ordering) "Ordering" + checkBoundsPrevNext (Proxy @()) "()" + checkBoundsPrevNext (Proxy @Bool) "Bool" + checkBoundsPrevNext (Proxy @Char) "Char" + checkBoundsPrevNext (Proxy @Int) "Int" + checkBoundsPrevNext (Proxy @Word) "Word" + checkBoundsPrevNext (Proxy @(Identity Int32)) "Identity a" + checkBoundsPrevNext (Proxy @(Down Int32)) "Down a" + checkBoundsPrevNext (Proxy @(First Int32)) "First a" + checkBoundsPrevNext (Proxy @(Last Int32)) "Last a" + checkBoundsPrevNext (Proxy @(Max Int32)) "Max a" + checkBoundsPrevNext (Proxy @(Min Int32)) "Min a" + checkBoundsPrevNext (Proxy @(Dual Int32)) "Dual a" + checkBoundsPrevNext (Proxy @(Product Int32)) "Product a" + checkBoundsPrevNext (Proxy @(Sum Int32)) "Sum a" + checkBoundsPrevNext (Proxy @(Finite 10000)) "Finite n" + checkBoundsPrevNext (Proxy @(Maybe Int32)) "Maybe a" + checkBoundsPrevNext (Proxy @(Either Bool Int32)) "Either a b" + checkBoundsPrevNext (Proxy @(Proxy Int32)) "Proxy a" + checkBoundsPrevNext (Proxy @(V.Vector 10 Int32)) "V.Vector a" + checkBoundsPrevNext (Proxy @(VS.Vector 10 Int32)) "VS.Vector a" + checkBoundsPrevNext (Proxy @(VU.Vector 10 Int32)) "VU.Vector a" + checkBoundsPrevNext (Proxy @(Bool, Int32)) "(a, b)" + checkBoundsPrevNext (Proxy @(Const Int32 Bool)) "Const a b" + checkBoundsPrevNext (Proxy @(Bool, Bool, Int32)) "(a, b, c)" + checkBoundsPrevNext (Proxy @(Bool, Int8, Bool, Int32)) "(a, b, c, d)" + checkBoundsPrevNext (Proxy @(Bool, Int8, Bool, Int8, Int32)) "(a, b, c, d, e)" + checkBoundsPrevNext (Proxy @(Bool, Int8, Bool, Int8, Bool, Int32)) "(a, b, c, d, e, f)" + checkBoundsPrevNext (Proxy @Foo) "Foo" describe "Bijectivity and order preservation" $ do checkBijection "Char" Gen.unicode checkBijection "Word8" (Gen.enumBounded @_ @Word8) - modifyMaxSize (const 10000) - . checkBijection "Word16" + checkBijection "Word16" $ Gen.enumBounded @_ @Word16 - modifyMaxSize (const 10000) - . checkBijection "Word32" + checkBijection "Word32" $ Gen.enumBounded @_ @Word32 - modifyMaxSize (const 10000) - . checkBijection "Word64" + checkBijection "Word64" $ Gen.word64 constantBounded checkBijection "Int8" (Gen.enumBounded @_ @Int8) - modifyMaxSize (const 10000) - . checkBijection "Int16" + checkBijection "Int16" $ Gen.enumBounded @_ @Int16 - modifyMaxSize (const 10000) - . checkBijection "Int32" + checkBijection "Int32" $ Gen.enumBounded @_ @Int32 - modifyMaxSize (const 10000) - . checkBijection "Int64" + checkBijection "Int64" $ Gen.int64 constantBounded - modifyMaxSize (const 10000) - . checkBijection "Int" + checkBijection "Int" $ Gen.int constantBounded - modifyMaxSize (const 10000) - . checkBijection "Word" + checkBijection "Word" $ Gen.word constantBounded describe "Down" $ do checkMonotonic "Bool" Gen.bool - modifyMaxSize (const 10000) - . checkMonotonic "Int" + checkMonotonic "Int" $ (Gen.enumBounded @_ @Int) - modifyMaxSize (const 10000) - . checkMonotonic "(Either Int Bool)" + checkMonotonic "(Either Int32 Bool)" $ Gen.choice - [ Left <$> Gen.enumBounded @_ @Int, + [ Left <$> Gen.enumBounded @_ @Int32, Right <$> Gen.enumBounded @_ @Bool ] - modifyMaxSize (const 10000) - . checkMonotonic "(Int, Bool)" + checkMonotonic "(Int32, Bool)" $ ( (,) - <$> Gen.enumBounded @_ @Int + <$> Gen.enumBounded @_ @Int32 <*> Gen.enumBounded @_ @Bool ) - modifyMaxSize (const 10000) - . checkMonotonic "of a user-defined type" + checkMonotonic "of a user-defined type" $ genFoo describe "Fixed-length vectors" $ do - modifyMaxSize (const 10000) - . checkStorable "Int8" + checkStorable "Int8" . genStorable $ Gen.enumBounded @_ @Int8 - modifyMaxSize (const 10000) - . checkUnboxed "Int8" + checkUnboxed "Int8" . genUnboxed $ Gen.enumBounded @_ @Int8 - modifyMaxSize (const 10000) - . checkRegular "Int8" + checkRegular "Int8" . genRegular $ Gen.enumBounded @_ @Int8 - modifyMaxSize (const 10000) - . checkUnboxed "(Int8, Int8)" + checkUnboxed "(Int8, Int8)" . genUnboxed $ ( (,) <$> Gen.enumBounded @_ @Int8 <*> Gen.enumBounded @_ @Int8 ) - modifyMaxSize (const 10000) - . checkRegular "(Int8, Int8)" + checkRegular "(Int8, Int8)" . genRegular $ ( (,) <$> Gen.enumBounded @_ @Int8 <*> Gen.enumBounded @_ @Int8 ) - modifyMaxSize (const 10000) - . checkRegular "Either Int8 Bool" + checkRegular "Either Int8 Bool" . genRegular . Gen.choice $ [ Left <$> Gen.enumBounded @_ @Int8, Right <$> Gen.bool ] - modifyMaxSize (const 10000) - . checkRegular "a user defined type" + checkRegular "a user defined type" . genRegular $ genFoo @@ -228,3 +269,11 @@ LT -> compare dx dy === GT EQ -> compare dx dy === EQ GT -> compare dx dy === LT + +checkBoundsPrevNext :: forall a. (1 <= Cardinality a, Show a, Finitary a) => Proxy a -> String -> SpecWith () +checkBoundsPrevNext _ name = do + it ("(start :: " <> name <> ") should have no predecessor") $ + previous (start @a) `shouldBe` Nothing + it ("(end :: " <> name <> ") should have no successor") $ + next (end @a) `shouldBe` Nothing +