Add Foldable1 instances

.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"  }

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]

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,18 +534,35 @@ 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    #-}
   {-# INLINE foldl'   #-}
   {-# 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
 --

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

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,18 +533,35 @@ instance (ArityPeano n) => F.Foldable (ContVec n) where
   toList     = toList
   sum        = sum
   product    = foldl' (*) 0
+  length     = length
   {-# INLINE foldMap' #-}
   {-# INLINE foldr    #-}
   {-# INLINE foldl    #-}
   {-# INLINE foldl'   #-}
   {-# 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 #-}

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

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

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