diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 1df24eb..468faf4 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -23,8 +23,6 @@ jobs: matrix: include: # Linux - - { cabal: "3.14", os: ubuntu-latest, ghc: "8.10.7" } - - { cabal: "3.14", os: ubuntu-latest, ghc: "9.0.2" } - { cabal: "3.14", os: ubuntu-latest, ghc: "9.2.8" } - { cabal: "3.14", os: ubuntu-latest, ghc: "9.4.8" } - { cabal: "3.14", os: ubuntu-latest, ghc: "9.6.7" } diff --git a/fixed-vector/ChangeLog.md b/fixed-vector/ChangeLog.md index bf97ca3..afe59f6 100644 --- a/fixed-vector/ChangeLog.md +++ b/fixed-vector/ChangeLog.md @@ -1,7 +1,10 @@ 2.0.1.0 [XXX] ------------- -* All data types defined in library now has `Prim` instance. -* `Prim` could be derived using `ViaFixed` by deriving via mechanism. +* Support for GHC<9.2 dropped. +* `Prim` could be derived using `ViaFixed` by deriving via mechanism and add + data types defined in library now has `Prim` instance. +* `Foldable1` could be derived using `ViaFixed`. All types for which it could be + defined now has it. For GHC<9.6 `foldable1-classes-compat` is used. 2.0.0.0 [2025.07.10] diff --git a/fixed-vector/Data/Vector/Fixed.hs b/fixed-vector/Data/Vector/Fixed.hs index 5c3a4a8..de57f0e 100644 --- a/fixed-vector/Data/Vector/Fixed.hs +++ b/fixed-vector/Data/Vector/Fixed.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE QuantifiedConstraints #-} @@ -199,6 +198,7 @@ import Data.Monoid (Monoid(..)) import Data.Semigroup (Semigroup(..)) import Data.Foldable qualified as F import Data.Traversable qualified as T +import Data.Foldable1 qualified as F1 import Data.Primitive.Types (Prim(..)) import Foreign.Storable (Storable(..)) import GHC.TypeLits @@ -290,6 +290,9 @@ newtype T_List a n k = T_List (VecPeano k a -> VecPeano n a) deriving via ViaFixed (VecList n) instance (Arity n) => Functor (VecList n) deriving via ViaFixed (VecList n) instance (Arity n) => Applicative (VecList n) deriving via ViaFixed (VecList n) instance (Arity n) => F.Foldable (VecList n) +-- | @since @2.0.1.0 +deriving via ViaFixed (VecList n) + instance (Arity n, C.Peano n ~ S k) => F1.Foldable1 (VecList n) instance Arity n => T.Traversable (VecList n) where sequence = sequence @@ -316,6 +319,9 @@ deriving via ViaFixed (VecList n) a instance (Arity n, Prim a) => Prim deriving via ViaFixed (VecPeano n) instance (ArityPeano n) => Functor (VecPeano n) deriving via ViaFixed (VecPeano n) instance (ArityPeano n) => Applicative (VecPeano n) deriving via ViaFixed (VecPeano n) instance (ArityPeano n) => F.Foldable (VecPeano n) +-- | @since @2.0.1.0 +deriving via ViaFixed (VecPeano n) + instance (ArityPeano n, n ~ S k) => F1.Foldable1 (VecPeano n) instance ArityPeano n => T.Traversable (VecPeano n) where sequence = sequence @@ -343,6 +349,10 @@ deriving via ViaFixed (VecPeano n) a instance (ArityPeano n, Prim a) => Pri newtype Only a = Only a deriving (Show,Eq,Ord,Data,Functor,F.Foldable,T.Traversable) +-- | @since @2.0.1.0 +deriving via ViaFixed Only instance F1.Foldable1 Only + + instance Monoid a => Monoid (Only a) where mempty = Only mempty mappend = (<>) @@ -524,6 +534,7 @@ instance (forall a. Vector v a) => F.Foldable (ViaFixed v) where toList = toList sum = sum product = foldl' (*) 0 + length = length {-# INLINE foldMap' #-} {-# INLINE foldr #-} {-# INLINE foldl #-} @@ -531,11 +542,27 @@ instance (forall a. Vector v a) => F.Foldable (ViaFixed v) where {-# INLINE toList #-} {-# INLINE sum #-} {-# INLINE product #-} --- GHC<9.2 fails to compile this -#if MIN_VERSION_base(4,16,0) - length = length - {-# INLINE length #-} -#endif + {-# INLINE length #-} + + +-- | @since @2.0.1.0 +instance (forall a. Vector v a, Dim v ~ S k) => F1.Foldable1 (ViaFixed v) where + fold1 = foldl1 (<>) + foldMap1 f = F1.foldMap1 f . cvec + foldMap1' f = F1.foldMap1' f . cvec + toNonEmpty = F1.toNonEmpty . cvec + head = head + last = F1.last . cvec + maximum = maximum + minimum = minimum + {-# INLINE fold1 #-} + {-# INLINE foldMap1 #-} + {-# INLINE foldMap1' #-} + {-# INLINE toNonEmpty #-} + {-# INLINE maximum #-} + {-# INLINE minimum #-} + {-# INLINE head #-} + {-# INLINE last #-} ---------------------------------------------------------------- @@ -545,34 +572,26 @@ instance (forall a. Vector v a) => F.Foldable (ViaFixed v) where pattern V1 :: (Vector v a, Dim v ~ C.N1) => a -> v a pattern V1 x <- (convert -> (Only x)) where V1 x = mk1 x -#if MIN_VERSION_base(4,16,0) {-# INLINE V1 #-} {-# COMPLETE V1 #-} -#endif pattern V2 :: (Vector v a, Dim v ~ C.N2) => a -> a -> v a pattern V2 x y <- (convert -> (x,y)) where V2 x y = mk2 x y -#if MIN_VERSION_base(4,16,0) {-# INLINE V2 #-} {-# COMPLETE V2 #-} -#endif pattern V3 :: (Vector v a, Dim v ~ C.N3) => a -> a -> a -> v a pattern V3 x y z <- (convert -> (x,y,z)) where V3 x y z = mk3 x y z -#if MIN_VERSION_base(4,16,0) {-# INLINE V3 #-} {-# COMPLETE V3 #-} -#endif pattern V4 :: (Vector v a, Dim v ~ C.N4) => a -> a -> a -> a -> v a pattern V4 t x y z <- (convert -> (t,x,y,z)) where V4 t x y z = mk4 t x y z -#if MIN_VERSION_base(4,16,0) {-# INLINE V4 #-} {-# COMPLETE V4 #-} -#endif -- $setup -- diff --git a/fixed-vector/Data/Vector/Fixed/Boxed.hs b/fixed-vector/Data/Vector/Fixed/Boxed.hs index b166390..25abe50 100644 --- a/fixed-vector/Data/Vector/Fixed/Boxed.hs +++ b/fixed-vector/Data/Vector/Fixed/Boxed.hs @@ -24,6 +24,7 @@ import Data.Semigroup (Semigroup(..)) import Data.Data import Data.Primitive.Types (Prim) import qualified Data.Foldable as F +import qualified Data.Foldable1 as F1 import qualified Data.Traversable as T import Foreign.Storable (Storable) import GHC.TypeLits @@ -66,6 +67,9 @@ type instance DimM (MVec n) = Peano n deriving via ViaFixed (Vec n) instance Arity n => Functor (Vec n) deriving via ViaFixed (Vec n) instance Arity n => Applicative (Vec n) deriving via ViaFixed (Vec n) instance Arity n => F.Foldable (Vec n) +-- | @since @2.0.1.0 +deriving via ViaFixed (Vec n) + instance (Arity n, Peano n ~ S k) => F1.Foldable1 (Vec n) instance Arity n => T.Traversable (Vec n) where sequence = sequence diff --git a/fixed-vector/Data/Vector/Fixed/Cont.hs b/fixed-vector/Data/Vector/Fixed/Cont.hs index 72108c5..3efdbcd 100644 --- a/fixed-vector/Data/Vector/Fixed/Cont.hs +++ b/fixed-vector/Data/Vector/Fixed/Cont.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE UndecidableInstances #-} @@ -126,9 +125,11 @@ import Data.Data (Data) import Data.Kind (Type) import Data.Functor.Identity (Identity(..)) import Data.Typeable (Proxy(..)) -import qualified Data.Foldable as F -import qualified Data.Traversable as T -import Unsafe.Coerce (unsafeCoerce) +import Data.Foldable qualified as F +import Data.Traversable qualified as T +import Data.List.NonEmpty qualified as NE +import Data.Foldable1 qualified as F1 +import Unsafe.Coerce (unsafeCoerce) import GHC.TypeLits import GHC.Exts (Proxy#, proxy#) import Prelude ( Bool(..), Int, Maybe(..), Either(..) @@ -532,6 +533,7 @@ instance (ArityPeano n) => F.Foldable (ContVec n) where toList = toList sum = sum product = foldl' (*) 0 + length = length {-# INLINE foldMap' #-} {-# INLINE foldr #-} {-# INLINE foldl #-} @@ -539,11 +541,27 @@ instance (ArityPeano n) => F.Foldable (ContVec n) where {-# INLINE toList #-} {-# INLINE sum #-} {-# INLINE product #-} --- GHC<9.2 fails to compile this -#if MIN_VERSION_base(4,16,0) - length = length {-# INLINE length #-} -#endif + + +instance (ArityPeano n, n ~ S k) => F1.Foldable1 (ContVec n) where + fold1 = foldl1 (<>) + foldMap1 f = foldl1 (<>) . map f + foldMap1' f = foldl1' (<>) . map f + toNonEmpty v = dictionaryPred (proxy# @n) + $ head v NE.:| toList (tail v) + maximum = maximum + minimum = minimum + head = head + last = F1.last . F1.toNonEmpty + {-# INLINE fold1 #-} + {-# INLINE foldMap1 #-} + {-# INLINE foldMap1' #-} + {-# INLINE toNonEmpty #-} + {-# INLINE maximum #-} + {-# INLINE minimum #-} + {-# INLINE head #-} + {-# INLINE last #-} instance (ArityPeano n) => T.Traversable (ContVec n) where sequence = sequence @@ -1013,7 +1031,6 @@ head $ runContVec $ uncurryFirst pure - -- | /O(n)/ Get value at specified index. index :: ArityPeano n => Int -> ContVec n a -> a {-# INLINE index #-} diff --git a/fixed-vector/Data/Vector/Fixed/Storable.hs b/fixed-vector/Data/Vector/Fixed/Storable.hs index 33888ae..08ee0fb 100644 --- a/fixed-vector/Data/Vector/Fixed/Storable.hs +++ b/fixed-vector/Data/Vector/Fixed/Storable.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UndecidableInstances #-} @@ -35,9 +34,7 @@ import GHC.ForeignPtr ( mallocPlainForeignPtrBytes ) import GHC.Ptr ( Ptr(..) ) import GHC.Exts ( proxy# ) import GHC.TypeLits -#if MIN_VERSION_base(4,15,0) import GHC.ForeignPtr ( unsafeWithForeignPtr ) -#endif import Foreign.ForeignPtr ( ForeignPtr, withForeignPtr ) import Prelude ( Show(..),Eq(..),Ord(..),Num(..),Monad(..),IO,Int , ($),undefined,seq,pure) @@ -186,13 +183,3 @@ mallocVector :: forall a. Storable a => Int -> IO (ForeignPtr a) {-# INLINE mallocVector #-} mallocVector size = mallocPlainForeignPtrBytes (size * sizeOf (undefined :: a)) - -#if !MIN_VERSION_base(4,15,0) --- | A compatibility wrapper for 'GHC.ForeignPtr.unsafeWithForeignPtr' provided --- by GHC 9.0.1 and later. --- --- Only to be used when the continuation is known not to --- unconditionally diverge lest unsoundness can result. -unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b -unsafeWithForeignPtr = withForeignPtr -#endif diff --git a/fixed-vector/Data/Vector/Fixed/Strict.hs b/fixed-vector/Data/Vector/Fixed/Strict.hs index 5035ddd..b309400 100644 --- a/fixed-vector/Data/Vector/Fixed/Strict.hs +++ b/fixed-vector/Data/Vector/Fixed/Strict.hs @@ -14,6 +14,7 @@ import Data.Semigroup (Semigroup(..)) import Data.Data import Data.Primitive.Types (Prim) import qualified Data.Foldable as F +import qualified Data.Foldable1 as F1 import qualified Data.Traversable as T import Foreign.Storable (Storable) import GHC.TypeLits @@ -56,6 +57,9 @@ type instance DimM (MVec n) = Peano n deriving via ViaFixed (Vec n) instance Arity n => Functor (Vec n) deriving via ViaFixed (Vec n) instance Arity n => Applicative (Vec n) deriving via ViaFixed (Vec n) instance Arity n => F.Foldable (Vec n) +-- | @since @2.0.1.0 +deriving via ViaFixed (Vec n) + instance (Arity n, Peano n ~ S k) => F1.Foldable1 (Vec n) instance Arity n => T.Traversable (Vec n) where sequence = sequence diff --git a/fixed-vector/fixed-vector.cabal b/fixed-vector/fixed-vector.cabal index 3cf55d4..f9ce760 100644 --- a/fixed-vector/fixed-vector.cabal +++ b/fixed-vector/fixed-vector.cabal @@ -59,9 +59,7 @@ extra-doc-files: ChangeLog.md tested-with: - GHC ==8.10.7 - || ==9.0.2 - || ==9.2.8 + GHC ==9.2.8 || ==9.4.7 || ==9.6.7 || ==9.8.4 @@ -132,9 +130,11 @@ common language Library import: language - Build-Depends: base >=4.14 && <5 + Build-Depends: base >=4.16 && <5 , primitive >=0.6.2 , deepseq + if impl(ghc<9.6) + Build-Depends: foldable1-classes-compat >=0.1 Exposed-modules: -- API Data.Vector.Fixed.Cont