indexed-traversable 0.1.2.1 → 0.1.3
raw patch · 4 files changed
+128/−15 lines, 4 filesdep +foldable1-classes-compatdep ~base
Dependencies added: foldable1-classes-compat
Dependency ranges changed: base
Files
- Changelog.md +6/−2
- indexed-traversable.cabal +11/−6
- src/Data/Foldable1/WithIndex.hs +13/−0
- src/WithIndex.hs +98/−7
Changelog.md view
@@ -1,6 +1,10 @@-# 0.1.2.1 [2022-12-28]+# 0.1.3 [2023-10-04] -- TraversableWithIndex [] doesn't use `zip [0..]` idiom anymore.+- Add `Foldable1WithIndex1` type-class, an indexed version of `Foldable1`.++# 0.1.2.1 [2023-03-12]++- `TraversableWithIndex []` doesn't use the `zip [0..]` idiom anymore. https://gitlab.haskell.org/ghc/ghc/-/issues/22673 # 0.1.2 [2021-10-30]
indexed-traversable.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: indexed-traversable-version: 0.1.2.1+version: 0.1.3 build-type: Simple license: BSD2 license-file: LICENSE@@ -47,9 +47,10 @@ || ==8.8.4 || ==8.10.7 || ==9.0.2- || ==9.2.7- || ==9.4.4- || ==9.6.1+ || ==9.2.8+ || ==9.4.7+ || ==9.6.3+ || ==9.8.1 source-repository head type: git@@ -67,12 +68,13 @@ exposed-modules: Data.Foldable.WithIndex+ Data.Foldable1.WithIndex Data.Functor.WithIndex Data.Traversable.WithIndex build-depends: array >=0.3.0.2 && <0.6- , base >=4.3 && <4.19+ , base >=4.3 && <4.20 , containers >=0.4.0.0 && <0.7 , transformers >=0.3.0.0 && <0.7 @@ -88,8 +90,11 @@ , semigroups >=0.18.4 && <0.21 , transformers-compat >=0.6.6 && <0.8 + if !impl(ghc >=9.6)+ build-depends: foldable1-classes-compat >=0.1 && <0.2+ if (impl(ghc >=7.0) && impl(ghc <7.6)) build-depends: ghc-prim if (impl(ghc >=7.0) && impl(ghc <7.2))- build-depends: generic-deriving ==1.14.*+ build-depends: generic-deriving >=1.14 && <1.15
+ src/Data/Foldable1/WithIndex.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Safe #-}+#elif __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif+-- | Indexed non-empty Foldables.+module Data.Foldable1.WithIndex (+ -- * Indexed Foldables+ Foldable1WithIndex (..),+) where++import WithIndex
src/WithIndex.hs view
@@ -34,6 +34,7 @@ import Control.Monad.Trans.Reader (ReaderT (..)) import Data.Array (Array) import Data.Foldable (Foldable (..))+import Data.Foldable1 (Foldable1 (..)) import Data.Functor.Compose (Compose (..)) import Data.Functor.Constant (Constant (..)) import Data.Functor.Identity (Identity (..))@@ -184,6 +185,62 @@ {-# INLINE ifoldMapDefault #-} -------------------------------------------------------------------------------+-- Foldable1WithIndex+-------------------------------------------------------------------------------++-- | A non-empty container that supports folding with an additional index.+class (Foldable1 f, FoldableWithIndex i f) => Foldable1WithIndex i f | f -> i where+ -- | Map each element of the structure to a semigroup, and combine the results.+ ifoldMap1 :: Semigroup m => (i -> a -> m) -> f a -> m+ ifoldMap1 f = ifoldrMap1 f (\i a m -> f i a <> m)++ -- | A variant of 'ifoldMap1' that is strict in the accumulator.+ ifoldMap1' :: Semigroup m => (i -> a -> m) -> f a -> m+ ifoldMap1' f = ifoldlMap1' f (\i m a -> m <> f i a)++ -- | Generalized 'ifoldr1'.+ ifoldrMap1 :: (i -> a -> b) -> (i -> a -> b -> b) -> f a -> b+ ifoldrMap1 f g xs =+ appFromMaybe (ifoldMap1 (FromMaybe #.. h) xs) Nothing+ where+ h i a Nothing = f i a+ h i a (Just b) = g i a b++ -- | Generalized 'ifoldl1''.+ ifoldlMap1' :: (i -> a -> b) -> (i -> b -> a -> b) -> f a -> b+ ifoldlMap1' f g xs =+ ifoldrMap1 f' g' xs SNothing+ where+ -- f' :: i -> a -> SMaybe b -> b+ f' i a SNothing = f i a+ f' i a (SJust b) = g i b a++ -- g' :: i -> a -> (SMaybe b -> b) -> SMaybe b -> b+ g' i a x SNothing = x $! SJust (f i a)+ g' i a x (SJust b) = x $! SJust (g i b a)++ -- | Generalized 'ifoldl1'.+ ifoldlMap1 :: (i -> a -> b) -> (i -> b -> a -> b) -> f a -> b+ ifoldlMap1 f g xs =+ appFromMaybe (getDual (ifoldMap1 ((Dual . FromMaybe) #.. h) xs)) Nothing+ where+ h i a Nothing = f i a+ h i a (Just b) = g i b a++ -- | Generalized 'ifoldr1''.+ ifoldrMap1' :: (i -> a -> b) -> (i -> a -> b -> b) -> f a -> b+ ifoldrMap1' f g xs =+ ifoldlMap1 f' g' xs SNothing+ where+ f' i a SNothing = f i a+ f' i a (SJust b) = g i a b++ g' i bb a SNothing = bb $! SJust (f i a)+ g' i bb a (SJust b) = bb $! SJust (g i a b)++ {-# MINIMAL ifoldMap1 | ifoldrMap1 #-}++------------------------------------------------------------------------------- -- TraversableWithIndex ------------------------------------------------------------------------------- @@ -258,16 +315,26 @@ go !n (x:xs) = f n x : go (n + 1) xs {-# INLINE imap #-} instance FoldableWithIndex Int [] where- ifoldMap = ifoldMapDefault+ ifoldMap = ifoldMapListOff 0 {-# INLINE ifoldMap #-}- ifoldr f z = go 0 where- go !_ [] = z- go !n (x:xs) = f n x (go (n + 1) xs)+ ifoldr = ifoldrListOff 0 {-# INLINE ifoldr #-}+ ifoldl' = ifoldl'ListOff 0 instance TraversableWithIndex Int [] where itraverse = itraverseListOff 0 {-# INLINE itraverse #-} +ifoldMapListOff :: Monoid m => Int -> (Int -> a -> m) -> [a] -> m+ifoldMapListOff off f = ifoldrListOff off (\i x acc -> mappend (f i x) acc) mempty++ifoldrListOff :: Int -> (Int -> a -> b -> b) -> b -> [a] -> b+ifoldrListOff !_ _ z [] = z+ifoldrListOff !off f z (x:xs) = f off x (ifoldrListOff (off + 1) f z xs)++ifoldl'ListOff :: Int -> (Int -> b -> a -> b) -> b -> [a] -> b+ifoldl'ListOff !_ _ !z [] = z+ifoldl'ListOff !off f !z (x:xs) = ifoldl'ListOff (off + 1) f (f off z x) xs+ -- traverse (uncurry' f) . zip [0..] seems to not work well: -- https://gitlab.haskell.org/ghc/ghc/-/issues/22673 itraverseListOff :: Applicative f => Int -> (Int -> a -> f b) -> [a] -> f [b]@@ -296,8 +363,19 @@ imap = imapDefault {-# INLINE imap #-} instance FoldableWithIndex Int NonEmpty where- ifoldMap = ifoldMapDefault+ ifoldMap f (x :| xs) = mappend (f 0 x) (ifoldMapListOff 1 f xs)+ ifoldr f z (x :| xs) = f 0 x (ifoldrListOff 1 f z xs)+ ifoldl' f z (x :| xs) = ifoldl'ListOff 1 f (f 0 z x) xs {-# INLINE ifoldMap #-}+instance Foldable1WithIndex Int NonEmpty where+ ifoldMap1 f (x :| xs) = go 1 (f 0 x) xs where+ go _ y [] = y+ go i y (z : zs) = y <> go (i + 1) (f i z) zs+ ifoldMap1' f (x :| xs) = ifoldl'ListOff 1 (\i m y -> m <> f i y) (f 0 x) xs+ ifoldrMap1 f g (x :| xs) = go 0 x xs where+ go i y [] = f i y+ go i y (z : zs) = g i y (go (i + 1) z zs)+ ifoldlMap1' f g (x :| xs) = ifoldl'ListOff 1 g (f 0 x) xs instance TraversableWithIndex Int NonEmpty where itraverse f ~(a :| as) = liftA2 (:|) (f 0 a) (itraverseListOff 1 f as)@@ -484,7 +562,7 @@ {-# INLINE itraverse #-} instance FunctorWithIndex Int IntMap where- imap = IntMap.mapWithKey + imap = IntMap.mapWithKey {-# INLINE imap #-} instance FoldableWithIndex Int IntMap where@@ -512,7 +590,7 @@ instance FunctorWithIndex k (Map k) where imap = Map.mapWithKey {-# INLINE imap #-}- + instance FoldableWithIndex k (Map k) where #if MIN_VERSION_containers(0,5,4) ifoldMap = Map.foldMapWithKey@@ -719,3 +797,16 @@ uncurry' :: (a -> b -> c) -> (a, b) -> c uncurry' f (a, b) = f a b {-# INLINE uncurry' #-}++-------------------------------------------------------------------------------+-- FromMaybe & SMaybe+-------------------------------------------------------------------------------++-- | Used for foldrMap1 and foldlMap1 definitions+newtype FromMaybe b = FromMaybe { appFromMaybe :: Maybe b -> b }++instance Semigroup (FromMaybe b) where+ FromMaybe f <> FromMaybe g = FromMaybe (f . Just . g)++-- | Strict maybe, used to implement default foldlMap1' etc.+data SMaybe a = SNothing | SJust !a