indexed-traversable-0.1.4/0000755000000000000000000000000007346545000013635 5ustar0000000000000000indexed-traversable-0.1.4/Changelog.md0000644000000000000000000000141307346545000016045 0ustar0000000000000000# 0.1.4 [2024-05-dd] - Drop support for GHCs prior 8.6.5 # 0.1.3 [2023-10-04] - 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] - Changed `(<$>)` + `(<*>)` to `liftA2` to potentially avoid extra `fmap`. - Add `(#..)`, coercive composition after a 2-parameter function. - Switched references to lens 'Of'- functions to base functions. Thanks to wygulmage for contributions. # 0.1.1 [2020-12-27] - Mark all modules as `Safe`. See https://gitlab.haskell.org/ghc/ghc/-/issues/19127 # 0.1 [2020-12-15] - Split out and combine this package functionality from `lens` and `optics` indexed-traversable-0.1.4/LICENSE0000644000000000000000000000236407346545000014647 0ustar0000000000000000Copyright 2012-2016 Edward Kmett All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. indexed-traversable-0.1.4/indexed-traversable.cabal0000644000000000000000000000401507346545000020551 0ustar0000000000000000cabal-version: 1.12 name: indexed-traversable version: 0.1.4 build-type: Simple license: BSD2 license-file: LICENSE category: Data maintainer: Oleg Grenrus author: Edward Kmett synopsis: FunctorWithIndex, FoldableWithIndex, TraversableWithIndex description: This package provides three useful generalizations: . @ class Functor f => FunctorWithIndex i f | f -> i where \ imap :: (i -> a -> b) -> f a -> f b @ . @ class Foldable f => FoldableWithIndex i f | f -> i where \ ifoldMap :: Monoid m => (i -> a -> m) -> f a -> m @ . @ class (FunctorWithIndex i t, FoldableWithIndex i t, Traversable t) => TraversableWithIndex i t | t -> i where \ itraverse :: Applicative f => (i -> a -> f b) -> t a -> f (t b) @ . This package contains instances for types in GHC boot libraries. For some additional instances see [indexed-traversable-instances](https://hackage.haskell.org/package/indexed-traversable-instances). . The [keys](https://hackage.haskell.org/package/keys) package provides similar functionality, but uses (associated) @TypeFamilies@ instead of @FunctionalDependencies@. extra-source-files: Changelog.md tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.5 || ==9.8.2 || ==9.10.1 source-repository head type: git location: https://github.com/haskellari/indexed-traversable subdir: indexed-traversable library default-language: Haskell2010 hs-source-dirs: src other-modules: CoerceCompat GhcList WithIndex 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.12 && <4.21 , containers >=0.6.0.1 && <0.8 , transformers >=0.5.6.0 && <0.7 if !impl(ghc >=9.6) build-depends: foldable1-classes-compat >=0.1 && <0.2 indexed-traversable-0.1.4/src/0000755000000000000000000000000007346545000014424 5ustar0000000000000000indexed-traversable-0.1.4/src/CoerceCompat.hs0000644000000000000000000000052507346545000017326 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} module CoerceCompat where import Data.Coerce (Coercible, coerce) (#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c) _ #. x = coerce x (#..) :: Coercible b c => (b -> c) -> (i -> a -> b) -> (i -> a -> c) _ #.. x = coerce x infixr 9 #., #.. {-# INLINE (#.) #-} {-# INLINE (#..) #-} indexed-traversable-0.1.4/src/Data/Foldable/0000755000000000000000000000000007346545000017005 5ustar0000000000000000indexed-traversable-0.1.4/src/Data/Foldable/WithIndex.hs0000644000000000000000000001377607346545000021262 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif -- | Indexed Foldables. module Data.Foldable.WithIndex ( -- * Indexed Foldables FoldableWithIndex (..), -- ** Indexed Foldable Combinators iany, iall, inone, none, itraverse_, ifor_, imapM_, iforM_, iconcatMap, ifind, ifoldrM, ifoldlM, itoList, ) where import Prelude (Bool, Maybe (..), Monad (..), flip, not, (.), curry) import Control.Applicative (Applicative (..)) import Control.Monad (liftM, void) import Data.Foldable (Foldable, any) import Data.Monoid (All (..), Any (..)) import CoerceCompat ((#.), (#..)) import GhcList (build) import WithIndex -- | Return whether or not any element in a container satisfies a predicate, with access to the index @i@. -- -- When you don't need access to the index then 'any' is more flexible in what it accepts. -- -- @ -- 'any' ≡ 'iany' '.' 'const' -- @ iany :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Bool iany f = getAny #. ifoldMap (Any #.. f) {-# INLINE iany #-} -- | Return whether or not all elements in a container satisfy a predicate, with access to the index @i@. -- -- When you don't need access to the index then 'all' is more flexible in what it accepts. -- -- @ -- 'all' ≡ 'iall' '.' 'const' -- @ iall :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Bool iall f = getAll #. ifoldMap (All #.. f) {-# INLINE iall #-} -- | Return whether or not none of the elements in a container satisfy a predicate, with access to the index @i@. -- -- When you don't need access to the index then 'none' is more flexible in what it accepts. -- -- @ -- 'none' ≡ 'inone' '.' 'const' -- 'inone' f ≡ 'not' '.' 'iany' f -- @ inone :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Bool inone f = not . iany f {-# INLINE inone #-} -- | Determines whether no elements of the structure satisfy the predicate. -- -- @ -- 'none' f ≡ 'not' '.' 'any' f -- @ none :: Foldable f => (a -> Bool) -> f a -> Bool none f = not . any f {-# INLINE none #-} -- | Traverse elements with access to the index @i@, discarding the results. -- -- When you don't need access to the index then 'traverse_' is more flexible in what it accepts. -- -- @ -- 'traverse_' l = 'itraverse' '.' 'const' -- @ itraverse_ :: (FoldableWithIndex i t, Applicative f) => (i -> a -> f b) -> t a -> f () itraverse_ f = void . getTraversed #. ifoldMap (Traversed #.. f) {-# INLINE itraverse_ #-} -- | Traverse elements with access to the index @i@, discarding the results (with the arguments flipped). -- -- @ -- 'ifor_' ≡ 'flip' 'itraverse_' -- @ -- -- When you don't need access to the index then 'for_' is more flexible in what it accepts. -- -- @ -- 'for_' a ≡ 'ifor_' a '.' 'const' -- @ ifor_ :: (FoldableWithIndex i t, Applicative f) => t a -> (i -> a -> f b) -> f () ifor_ = flip itraverse_ {-# INLINE ifor_ #-} -- | Run monadic actions for each target of an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal' with access to the index, -- discarding the results. -- -- When you don't need access to the index then 'Control.Lens.Fold.mapMOf_' is more flexible in what it accepts. -- -- @ -- 'mapM_' ≡ 'imapM' '.' 'const' -- @ imapM_ :: (FoldableWithIndex i t, Monad m) => (i -> a -> m b) -> t a -> m () imapM_ f = liftM skip . getSequenced #. ifoldMap (Sequenced #.. f) {-# INLINE imapM_ #-} -- | Run monadic actions for each target of an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal' with access to the index, -- discarding the results (with the arguments flipped). -- -- @ -- 'iforM_' ≡ 'flip' 'imapM_' -- @ -- -- When you don't need access to the index then 'Control.Monad.forM_' is more flexible in what it accepts. -- -- @ -- 'Control.Monad.forM_' a ≡ 'iforM' a '.' 'const' -- @ iforM_ :: (FoldableWithIndex i t, Monad m) => t a -> (i -> a -> m b) -> m () iforM_ = flip imapM_ {-# INLINE iforM_ #-} -- | Concatenate the results of a function of the elements of an indexed container with access to the index. -- -- When you don't need access to the index then 'concatMap' is more flexible in what it accepts. -- -- @ -- 'concatMap' ≡ 'iconcatMap' '.' 'const' -- 'iconcatMap' ≡ 'ifoldMap' -- @ iconcatMap :: FoldableWithIndex i f => (i -> a -> [b]) -> f a -> [b] iconcatMap = ifoldMap {-# INLINE iconcatMap #-} -- | Searches a container with a predicate that is also supplied the index, returning the left-most element of the structure -- matching the predicate, or 'Nothing' if there is no such element. -- -- When you don't need access to the index then 'find' is more flexible in what it accepts. -- -- @ -- 'find' ≡ 'ifind' '.' 'const' -- @ ifind :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Maybe (i, a) ifind p = ifoldr (\i a y -> if p i a then Just (i, a) else y) Nothing {-# INLINE ifind #-} -- | Monadic fold right over the elements of a structure with an index. -- -- When you don't need access to the index then 'foldrM' is more flexible in what it accepts. -- -- @ -- 'foldrM' ≡ 'ifoldrM' '.' 'const' -- @ ifoldrM :: (FoldableWithIndex i f, Monad m) => (i -> a -> b -> m b) -> b -> f a -> m b ifoldrM f z0 xs = ifoldl f' return xs z0 where f' i k x z = f i x z >>= k {-# INLINE ifoldrM #-} -- | Monadic fold over the elements of a structure with an index, associating to the left. -- -- When you don't need access to the index then 'foldlM' is more flexible in what it accepts. -- -- @ -- 'foldlM' ≡ 'ifoldlM' '.' 'const' -- @ ifoldlM :: (FoldableWithIndex i f, Monad m) => (i -> b -> a -> m b) -> b -> f a -> m b ifoldlM f z0 xs = ifoldr f' return xs z0 where f' i x k z = f i z x >>= k {-# INLINE ifoldlM #-} -- | Extract the key-value pairs from a structure. -- -- When you don't need access to the indices in the result, then 'toList' is more flexible in what it accepts. -- -- @ -- 'toList' ≡ 'Data.List.map' 'snd' '.' 'itoList' -- @ itoList :: FoldableWithIndex i f => f a -> [(i,a)] itoList xs = build (\c n -> ifoldr (curry c) n xs) {-# INLINE itoList #-} indexed-traversable-0.1.4/src/Data/Foldable1/0000755000000000000000000000000007346545000017066 5ustar0000000000000000indexed-traversable-0.1.4/src/Data/Foldable1/WithIndex.hs0000644000000000000000000000046407346545000021331 0ustar0000000000000000{-# 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 indexed-traversable-0.1.4/src/Data/Functor/0000755000000000000000000000000007346545000016715 5ustar0000000000000000indexed-traversable-0.1.4/src/Data/Functor/WithIndex.hs0000644000000000000000000000041407346545000021153 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif module Data.Functor.WithIndex ( -- * Indexed Functors FunctorWithIndex(..), ) where import WithIndex indexed-traversable-0.1.4/src/Data/Traversable/0000755000000000000000000000000007346545000017547 5ustar0000000000000000indexed-traversable-0.1.4/src/Data/Traversable/WithIndex.hs0000644000000000000000000000527507346545000022017 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif -- | Indexed Traversables module Data.Traversable.WithIndex ( -- * Indexed Traversables TraversableWithIndex(..), -- * Indexed Traversable Combinators ifor, imapM, iforM, imapAccumR, imapAccumL, -- * Default implementations imapDefault, ifoldMapDefault, ) where import Prelude (Monad (..), flip) import Control.Applicative (Applicative (..), WrappedMonad (..)) import Control.Applicative.Backwards (Backwards (..)) import Data.Tuple (swap) import qualified Control.Monad.Trans.State.Lazy as Lazy import WithIndex import CoerceCompat -- | Traverse with an index (and the arguments flipped). -- -- @ -- 'for' a ≡ 'ifor' a '.' 'const' -- 'ifor' ≡ 'flip' 'itraverse' -- @ ifor :: (TraversableWithIndex i t, Applicative f) => t a -> (i -> a -> f b) -> f (t b) ifor = flip itraverse {-# INLINE ifor #-} -- | Map each element of a structure to a monadic action, -- evaluate these actions from left to right, and collect the results, with access -- the index. -- -- When you don't need access to the index 'mapM' is more liberal in what it can accept. -- -- @ -- 'mapM' ≡ 'imapM' '.' 'const' -- @ imapM :: (TraversableWithIndex i t, Monad m) => (i -> a -> m b) -> t a -> m (t b) imapM f = unwrapMonad #. itraverse (WrapMonad #.. f) {-# INLINE imapM #-} -- | Map each element of a structure to a monadic action, -- evaluate these actions from left to right, and collect the results, with access -- its position (and the arguments flipped). -- -- @ -- 'forM' a ≡ 'iforM' a '.' 'const' -- 'iforM' ≡ 'flip' 'imapM' -- @ iforM :: (TraversableWithIndex i t, Monad m) => t a -> (i -> a -> m b) -> m (t b) iforM = flip imapM {-# INLINE iforM #-} -- | Generalizes 'Data.Traversable.mapAccumR' to add access to the index. -- -- 'imapAccumR' accumulates state from right to left. -- -- @ -- 'Data.Traversable.mapAccumR' ≡ 'imapAccumR' '.' 'const' -- @ imapAccumR :: TraversableWithIndex i t => (i -> s -> a -> (s, b)) -> s -> t a -> (s, t b) imapAccumR f s0 a = swap (Lazy.runState (forwards (itraverse (\i c -> Backwards (Lazy.state (\s -> swap (f i s c)))) a)) s0) {-# INLINE imapAccumR #-} -- | Generalizes 'Data.Traversable.mapAccumL' to add access to the index. -- -- 'imapAccumL' accumulates state from left to right. -- -- @ -- 'Data.Traversable.mapAccumL' ≡ 'imapAccumL' '.' 'const' -- @ imapAccumL :: TraversableWithIndex i t => (i -> s -> a -> (s, b)) -> s -> t a -> (s, t b) imapAccumL f s0 a = swap (Lazy.runState (itraverse (\i c -> Lazy.state (\s -> swap (f i s c))) a) s0) {-# INLINE imapAccumL #-} indexed-traversable-0.1.4/src/GhcList.hs0000644000000000000000000000042407346545000016315 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,17,0) {-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif module GhcList ( build, ) where #if MIN_VERSION_base(4,17,0) import GHC.List (build) #else import GHC.Exts (build) #endif indexed-traversable-0.1.4/src/WithIndex.hs0000644000000000000000000006626307346545000016700 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE Safe #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} module WithIndex where import Prelude (Either (..), Functor (..), Int, Maybe (..), Monad (..), Num (..), error, flip, id, seq, snd, ($!), ($), (.)) import Control.Applicative (Applicative (..), Const (..), ZipList (..), liftA2, (<$>)) import Control.Applicative.Backwards (Backwards (..)) import Control.Monad.Trans.Identity (IdentityT (..)) 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 (..)) import Data.Functor.Product (Product (..)) import Data.Functor.Reverse (Reverse (..)) import Data.Functor.Sum (Sum (..)) import Data.IntMap (IntMap) import Data.Ix (Ix (..)) import Data.List.NonEmpty (NonEmpty (..)) import Data.Map (Map) import Data.Monoid (Dual (..), Endo (..), Monoid (..)) import Data.Proxy (Proxy (..)) import Data.Semigroup (Semigroup (..)) import Data.Sequence (Seq) import Data.Traversable (Traversable (..)) import Data.Tree (Tree (..)) import Data.Void (Void) import GHC.Generics (K1 (..), Par1 (..), Rec1 (..), U1 (..), V1, (:*:) (..), (:+:) (..), (:.:) (..)) import qualified Data.Array as Array import qualified Data.IntMap as IntMap import qualified Data.Map as Map import qualified Data.Sequence as Seq #ifdef MIN_VERSION_base_orphans import Data.Orphans () #endif import CoerceCompat ------------------------------------------------------------------------------- -- FunctorWithIndex ------------------------------------------------------------------------------- -- | A 'Functor' with an additional index. -- -- Instances must satisfy a modified form of the 'Functor' laws: -- -- @ -- 'imap' f '.' 'imap' g ≡ 'imap' (\\i -> f i '.' g i) -- 'imap' (\\_ a -> a) ≡ 'id' -- @ class Functor f => FunctorWithIndex i f | f -> i where -- | Map with access to the index. imap :: (i -> a -> b) -> f a -> f b default imap :: TraversableWithIndex i f => (i -> a -> b) -> f a -> f b imap = imapDefault {-# INLINE imap #-} imapDefault :: TraversableWithIndex i f => (i -> a -> b) -> f a -> f b -- imapDefault f = runIdentity #. itraverse (\i a -> Identity (f i a)) imapDefault f = runIdentity #. itraverse (Identity #.. f) {-# INLINE imapDefault #-} ------------------------------------------------------------------------------- -- FoldableWithIndex ------------------------------------------------------------------------------- -- | A container that supports folding with an additional index. class Foldable f => FoldableWithIndex i f | f -> i where -- -- | Fold a container by mapping value to an arbitrary 'Monoid' with access to the index @i@. -- -- When you don't need access to the index then 'foldMap' is more flexible in what it accepts. -- -- @ -- 'foldMap' ≡ 'ifoldMap' '.' 'const' -- @ ifoldMap :: Monoid m => (i -> a -> m) -> f a -> m default ifoldMap :: (TraversableWithIndex i f, Monoid m) => (i -> a -> m) -> f a -> m ifoldMap = ifoldMapDefault {-# INLINE ifoldMap #-} -- | A variant of 'ifoldMap' that is strict in the accumulator. -- -- When you don't need access to the index then 'Data.Foldable.foldMap'' is more flexible in what it accepts. -- -- @ -- 'foldMap'' ≡ 'ifoldMap'' '.' 'const' -- @ ifoldMap' :: Monoid m => (i -> a -> m) -> f a -> m ifoldMap' f = ifoldl' (\i acc a -> mappend acc (f i a)) mempty {-# INLINE ifoldMap' #-} -- | Right-associative fold of an indexed container with access to the index @i@. -- -- When you don't need access to the index then 'Data.Foldable.foldr' is more flexible in what it accepts. -- -- @ -- 'Data.Foldable.foldr' ≡ 'ifoldr' '.' 'const' -- @ ifoldr :: (i -> a -> b -> b) -> b -> f a -> b ifoldr f z t = appEndo (ifoldMap (Endo #.. f) t) z {-# INLINE ifoldr #-} -- | Left-associative fold of an indexed container with access to the index @i@. -- -- When you don't need access to the index then 'Data.Foldable.foldl' is more flexible in what it accepts. -- -- @ -- 'Data.Foldable.foldl' ≡ 'ifoldl' '.' 'const' -- @ ifoldl :: (i -> b -> a -> b) -> b -> f a -> b ifoldl f z t = appEndo (getDual (ifoldMap (\ i -> Dual #. Endo #. flip (f i)) t)) z {-# INLINE ifoldl #-} -- | /Strictly/ fold right over the elements of a structure with access to the index @i@. -- -- When you don't need access to the index then 'foldr'' is more flexible in what it accepts. -- -- @ -- 'foldr'' ≡ 'ifoldr'' '.' 'const' -- @ ifoldr' :: (i -> a -> b -> b) -> b -> f a -> b ifoldr' f z0 xs = ifoldl f' id xs z0 where f' i k x z = k $! f i x z {-# INLINE ifoldr' #-} -- | Fold over the elements of a structure with an index, associating to the left, but /strictly/. -- -- When you don't need access to the index then 'Control.Lens.Fold.foldlOf'' is more flexible in what it accepts. -- -- @ -- 'Data.Foldable.foldl'' l ≡ 'ifoldl'' l '.' 'const' -- @ ifoldl' :: (i -> b -> a -> b) -> b -> f a -> b ifoldl' f z0 xs = ifoldr f' id xs z0 where f' i x k z = k $! f i z x {-# INLINE ifoldl' #-} ifoldMapDefault :: (TraversableWithIndex i f, Monoid m) => (i -> a -> m) -> f a -> m ifoldMapDefault f = getConst #. itraverse (Const #.. f) {-# 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 ------------------------------------------------------------------------------- -- | A 'Traversable' with an additional index. -- -- An instance must satisfy a (modified) form of the 'Traversable' laws: -- -- @ -- 'itraverse' ('const' 'Identity') ≡ 'Identity' -- 'fmap' ('itraverse' f) '.' 'itraverse' g ≡ 'Data.Functor.Compose.getCompose' '.' 'itraverse' (\\i -> 'Data.Functor.Compose.Compose' '.' 'fmap' (f i) '.' g i) -- @ class (FunctorWithIndex i t, FoldableWithIndex i t, Traversable t) => TraversableWithIndex i t | t -> i where -- | Traverse an indexed container. -- -- @ -- 'itraverse' ≡ 'itraverseOf' 'itraversed' -- @ itraverse :: Applicative f => (i -> a -> f b) -> t a -> f (t b) default itraverse :: (i ~ Int, Applicative f) => (i -> a -> f b) -> t a -> f (t b) itraverse f s = snd $ runIndexing (traverse (\a -> Indexing (\i -> i `seq` (i + 1, f i a))) s) 0 {-# INLINE itraverse #-} ------------------------------------------------------------------------------- -- base ------------------------------------------------------------------------------- instance FunctorWithIndex r ((->) r) where imap f g x = f x (g x) {-# INLINE imap #-} instance FunctorWithIndex () Maybe where imap f = fmap (f ()) {-# INLINE imap #-} instance FoldableWithIndex () Maybe where ifoldMap f = foldMap (f ()) {-# INLINE ifoldMap #-} instance TraversableWithIndex () Maybe where itraverse f = traverse (f ()) {-# INLINE itraverse #-} instance FunctorWithIndex Void Proxy where imap _ Proxy = Proxy {-# INLINE imap #-} instance FoldableWithIndex Void Proxy where ifoldMap _ _ = mempty {-# INLINE ifoldMap #-} instance TraversableWithIndex Void Proxy where itraverse _ _ = pure Proxy {-# INLINE itraverse #-} instance FunctorWithIndex k ((,) k) where imap f (k,a) = (k, f k a) {-# INLINE imap #-} instance FoldableWithIndex k ((,) k) where ifoldMap = uncurry' {-# INLINE ifoldMap #-} instance TraversableWithIndex k ((,) k) where itraverse f (k, a) = (,) k <$> f k a {-# INLINE itraverse #-} -- | The position in the list is available as the index. instance FunctorWithIndex Int [] where imap f = go 0 where go !_ [] = [] go !n (x:xs) = f n x : go (n + 1) xs {-# INLINE imap #-} instance FoldableWithIndex Int [] where ifoldMap = ifoldMapListOff 0 {-# INLINE ifoldMap #-} 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] itraverseListOff !_ _ [] = pure [] itraverseListOff !off f (x:xs) = liftA2 (:) (f off x) (itraverseListOff (off + 1) f xs) -- TODO: we could experiment with streaming framework -- imapListFB f xs = build (\c n -> ifoldr (\i a -> c (f i a)) n xs) -- | Same instance as for @[]@. instance FunctorWithIndex Int ZipList where imap f (ZipList xs) = ZipList (imap f xs) {-# INLINE imap #-} instance FoldableWithIndex Int ZipList where ifoldMap f (ZipList xs) = ifoldMap f xs {-# INLINE ifoldMap #-} instance TraversableWithIndex Int ZipList where itraverse f (ZipList xs) = ZipList <$> itraverse f xs {-# INLINE itraverse #-} ------------------------------------------------------------------------------- -- (former) semigroups ------------------------------------------------------------------------------- instance FunctorWithIndex Int NonEmpty where imap = imapDefault {-# INLINE imap #-} instance FoldableWithIndex Int NonEmpty where 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) {-# INLINE itraverse #-} ------------------------------------------------------------------------------- -- Functors (formely) from transformers ------------------------------------------------------------------------------- instance FunctorWithIndex () Identity where imap f (Identity a) = Identity (f () a) {-# INLINE imap #-} instance FoldableWithIndex () Identity where ifoldMap f (Identity a) = f () a {-# INLINE ifoldMap #-} instance TraversableWithIndex () Identity where itraverse f (Identity a) = Identity <$> f () a {-# INLINE itraverse #-} instance FunctorWithIndex Void (Const e) where imap _ (Const a) = Const a {-# INLINE imap #-} instance FoldableWithIndex Void (Const e) where ifoldMap _ _ = mempty {-# INLINE ifoldMap #-} instance TraversableWithIndex Void (Const e) where itraverse _ (Const a) = pure (Const a) {-# INLINE itraverse #-} instance FunctorWithIndex Void (Constant e) where imap _ (Constant a) = Constant a {-# INLINE imap #-} instance FoldableWithIndex Void (Constant e) where ifoldMap _ _ = mempty {-# INLINE ifoldMap #-} instance TraversableWithIndex Void (Constant e) where itraverse _ (Constant a) = pure (Constant a) {-# INLINE itraverse #-} instance (FunctorWithIndex i f, FunctorWithIndex j g) => FunctorWithIndex (i, j) (Compose f g) where imap f (Compose fg) = Compose $ imap (\k -> imap (f . (,) k)) fg {-# INLINE imap #-} instance (FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (i, j) (Compose f g) where ifoldMap f (Compose fg) = ifoldMap (\k -> ifoldMap (f . (,) k)) fg {-# INLINE ifoldMap #-} instance (TraversableWithIndex i f, TraversableWithIndex j g) => TraversableWithIndex (i, j) (Compose f g) where itraverse f (Compose fg) = Compose <$> itraverse (\k -> itraverse (f . (,) k)) fg {-# INLINE itraverse #-} instance (FunctorWithIndex i f, FunctorWithIndex j g) => FunctorWithIndex (Either i j) (Sum f g) where imap q (InL fa) = InL (imap (q . Left) fa) imap q (InR ga) = InR (imap (q . Right) ga) {-# INLINE imap #-} instance (FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (Either i j) (Sum f g) where ifoldMap q (InL fa) = ifoldMap (q . Left) fa ifoldMap q (InR ga) = ifoldMap (q . Right) ga {-# INLINE ifoldMap #-} instance (TraversableWithIndex i f, TraversableWithIndex j g) => TraversableWithIndex (Either i j) (Sum f g) where itraverse q (InL fa) = InL <$> itraverse (q . Left) fa itraverse q (InR ga) = InR <$> itraverse (q . Right) ga {-# INLINE itraverse #-} instance (FunctorWithIndex i f, FunctorWithIndex j g) => FunctorWithIndex (Either i j) (Product f g) where imap f (Pair a b) = Pair (imap (f . Left) a) (imap (f . Right) b) {-# INLINE imap #-} instance (FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (Either i j) (Product f g) where ifoldMap f (Pair a b) = ifoldMap (f . Left) a `mappend` ifoldMap (f . Right) b {-# INLINE ifoldMap #-} instance (TraversableWithIndex i f, TraversableWithIndex j g) => TraversableWithIndex (Either i j) (Product f g) where itraverse f (Pair a b) = liftA2 Pair (itraverse (f . Left) a) (itraverse (f . Right) b) {-# INLINE itraverse #-} ------------------------------------------------------------------------------- -- transformers ------------------------------------------------------------------------------- instance FunctorWithIndex i m => FunctorWithIndex i (IdentityT m) where imap f (IdentityT m) = IdentityT $ imap f m {-# INLINE imap #-} instance FoldableWithIndex i m => FoldableWithIndex i (IdentityT m) where ifoldMap f (IdentityT m) = ifoldMap f m {-# INLINE ifoldMap #-} instance TraversableWithIndex i m => TraversableWithIndex i (IdentityT m) where itraverse f (IdentityT m) = IdentityT <$> itraverse f m {-# INLINE itraverse #-} instance FunctorWithIndex i m => FunctorWithIndex (e, i) (ReaderT e m) where imap f (ReaderT m) = ReaderT $ \k -> imap (f . (,) k) (m k) {-# INLINE imap #-} instance FunctorWithIndex i f => FunctorWithIndex i (Backwards f) where imap f = Backwards . imap f . forwards {-# INLINE imap #-} instance FoldableWithIndex i f => FoldableWithIndex i (Backwards f) where ifoldMap f = ifoldMap f . forwards {-# INLINE ifoldMap #-} instance TraversableWithIndex i f => TraversableWithIndex i (Backwards f) where itraverse f = fmap Backwards . itraverse f . forwards {-# INLINE itraverse #-} instance FunctorWithIndex i f => FunctorWithIndex i (Reverse f) where imap f = Reverse . imap f . getReverse {-# INLINE imap #-} instance FoldableWithIndex i f => FoldableWithIndex i (Reverse f) where ifoldMap f = getDual #. ifoldMap (Dual #.. f) . getReverse {-# INLINE ifoldMap #-} instance TraversableWithIndex i f => TraversableWithIndex i (Reverse f) where itraverse f = fmap Reverse . forwards . itraverse (Backwards #.. f) . getReverse {-# INLINE itraverse #-} ------------------------------------------------------------------------------- -- array ------------------------------------------------------------------------------- instance Ix i => FunctorWithIndex i (Array i) where imap f arr = Array.listArray (Array.bounds arr) . fmap (uncurry' f) $ Array.assocs arr {-# INLINE imap #-} instance Ix i => FoldableWithIndex i (Array i) where ifoldMap f = foldMap (uncurry' f) . Array.assocs {-# INLINE ifoldMap #-} instance Ix i => TraversableWithIndex i (Array i) where itraverse f arr = Array.listArray (Array.bounds arr) <$> traverse (uncurry' f) (Array.assocs arr) {-# INLINE itraverse #-} ------------------------------------------------------------------------------- -- containers ------------------------------------------------------------------------------- instance FunctorWithIndex [Int] Tree where imap f (Node a as) = Node (f [] a) $ imap (\i -> imap (f . (:) i)) as {-# INLINE imap #-} instance FoldableWithIndex [Int] Tree where ifoldMap f (Node a as) = f [] a `mappend` ifoldMap (\i -> ifoldMap (f . (:) i)) as {-# INLINE ifoldMap #-} instance TraversableWithIndex [Int] Tree where itraverse f (Node a as) = liftA2 Node (f [] a) (itraverse (\i -> itraverse (f . (:) i)) as) {-# INLINE itraverse #-} -- -- | The position in the 'Seq' is available as the index. instance FunctorWithIndex Int Seq where imap = Seq.mapWithIndex {-# INLINE imap #-} instance FoldableWithIndex Int Seq where ifoldMap = Seq.foldMapWithIndex {-# INLINE ifoldMap #-} ifoldr = Seq.foldrWithIndex {-# INLINE ifoldr #-} ifoldl f = Seq.foldlWithIndex (flip f) {-# INLINE ifoldl #-} instance TraversableWithIndex Int Seq where itraverse = Seq.traverseWithIndex {-# INLINE itraverse #-} instance FunctorWithIndex Int IntMap where imap = IntMap.mapWithKey {-# INLINE imap #-} instance FoldableWithIndex Int IntMap where ifoldMap = IntMap.foldMapWithKey {-# INLINE ifoldMap #-} ifoldr = IntMap.foldrWithKey ifoldl' = IntMap.foldlWithKey' . flip {-# INLINE ifoldr #-} {-# INLINE ifoldl' #-} instance TraversableWithIndex Int IntMap where itraverse = IntMap.traverseWithKey {-# INLINE itraverse #-} instance FunctorWithIndex k (Map k) where imap = Map.mapWithKey {-# INLINE imap #-} instance FoldableWithIndex k (Map k) where ifoldMap = Map.foldMapWithKey {-# INLINE ifoldMap #-} ifoldr = Map.foldrWithKey ifoldl' = Map.foldlWithKey' . flip {-# INLINE ifoldr #-} {-# INLINE ifoldl' #-} instance TraversableWithIndex k (Map k) where itraverse = Map.traverseWithKey {-# INLINE itraverse #-} ------------------------------------------------------------------------------- -- GHC.Generics ------------------------------------------------------------------------------- instance FunctorWithIndex Void V1 where imap _ v = v `seq` error "imap @V1" {-# INLINE imap #-} instance FoldableWithIndex Void V1 where ifoldMap _ v = v `seq` error "ifoldMap @V1" instance TraversableWithIndex Void V1 where itraverse _ v = v `seq` error "itraverse @V1" instance FunctorWithIndex Void U1 where imap _ U1 = U1 {-# INLINE imap #-} instance FoldableWithIndex Void U1 where ifoldMap _ _ = mempty {-# INLINE ifoldMap #-} instance TraversableWithIndex Void U1 where itraverse _ U1 = pure U1 {-# INLINE itraverse #-} instance FunctorWithIndex () Par1 where imap f = fmap (f ()) {-# INLINE imap #-} instance FoldableWithIndex () Par1 where ifoldMap f (Par1 a) = f () a {-# INLINE ifoldMap #-} instance TraversableWithIndex () Par1 where itraverse f (Par1 a) = Par1 <$> f () a {-# INLINE itraverse #-} instance (FunctorWithIndex i f, FunctorWithIndex j g) => FunctorWithIndex (i, j) (f :.: g) where imap q (Comp1 fga) = Comp1 (imap (\k -> imap (q . (,) k)) fga) {-# INLINE imap #-} instance (FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (i, j) (f :.: g) where ifoldMap q (Comp1 fga) = ifoldMap (\k -> ifoldMap (q . (,) k)) fga {-# INLINE ifoldMap #-} instance (TraversableWithIndex i f, TraversableWithIndex j g) => TraversableWithIndex (i, j) (f :.: g) where itraverse q (Comp1 fga) = Comp1 <$> itraverse (\k -> itraverse (q . (,) k)) fga {-# INLINE itraverse #-} instance (FunctorWithIndex i f, FunctorWithIndex j g) => FunctorWithIndex (Either i j) (f :*: g) where imap q (fa :*: ga) = imap (q . Left) fa :*: imap (q . Right) ga {-# INLINE imap #-} instance (FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (Either i j) (f :*: g) where ifoldMap q (fa :*: ga) = ifoldMap (q . Left) fa `mappend` ifoldMap (q . Right) ga {-# INLINE ifoldMap #-} instance (TraversableWithIndex i f, TraversableWithIndex j g) => TraversableWithIndex (Either i j) (f :*: g) where itraverse q (fa :*: ga) = liftA2 (:*:) (itraverse (q . Left) fa) (itraverse (q . Right) ga) {-# INLINE itraverse #-} instance (FunctorWithIndex i f, FunctorWithIndex j g) => FunctorWithIndex (Either i j) (f :+: g) where imap q (L1 fa) = L1 (imap (q . Left) fa) imap q (R1 ga) = R1 (imap (q . Right) ga) {-# INLINE imap #-} instance (FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (Either i j) (f :+: g) where ifoldMap q (L1 fa) = ifoldMap (q . Left) fa ifoldMap q (R1 ga) = ifoldMap (q . Right) ga {-# INLINE ifoldMap #-} instance (TraversableWithIndex i f, TraversableWithIndex j g) => TraversableWithIndex (Either i j) (f :+: g) where itraverse q (L1 fa) = L1 <$> itraverse (q . Left) fa itraverse q (R1 ga) = R1 <$> itraverse (q . Right) ga {-# INLINE itraverse #-} instance FunctorWithIndex i f => FunctorWithIndex i (Rec1 f) where imap q (Rec1 f) = Rec1 (imap q f) {-# INLINE imap #-} instance FoldableWithIndex i f => FoldableWithIndex i (Rec1 f) where ifoldMap q (Rec1 f) = ifoldMap q f {-# INLINE ifoldMap #-} instance TraversableWithIndex i f => TraversableWithIndex i (Rec1 f) where itraverse q (Rec1 f) = Rec1 <$> itraverse q f {-# INLINE itraverse #-} instance FunctorWithIndex Void (K1 i c) where imap _ (K1 c) = K1 c {-# INLINE imap #-} instance FoldableWithIndex Void (K1 i c) where ifoldMap _ _ = mempty {-# INLINE ifoldMap #-} instance TraversableWithIndex Void (K1 i c) where itraverse _ (K1 a) = pure (K1 a) {-# INLINE itraverse #-} ------------------------------------------------------------------------------- -- Misc. ------------------------------------------------------------------------------- skip :: a -> () skip _ = () {-# INLINE skip #-} ------------------------------------------------------------------------------ -- Traversed ------------------------------------------------------------------------------ -- | Used internally by 'Control.Lens.Traversal.traverseOf_' and the like. -- -- The argument 'a' of the result should not be used! newtype Traversed a f = Traversed { getTraversed :: f a } -- See 4.16 Changelog entry for the explanation of "why not Apply f =>"? instance Applicative f => Semigroup (Traversed a f) where Traversed ma <> Traversed mb = Traversed (ma *> mb) {-# INLINE (<>) #-} instance Applicative f => Monoid (Traversed a f) where mempty = Traversed (pure (error "Traversed: value used")) {-# INLINE mempty #-} mappend = (<>) {-# INLINE mappend #-} ------------------------------------------------------------------------------ -- Sequenced ------------------------------------------------------------------------------ -- | Used internally by 'Control.Lens.Traversal.mapM_' and the like. -- -- The argument 'a' of the result should not be used! -- -- See 4.16 Changelog entry for the explanation of "why not Apply f =>"? newtype Sequenced a m = Sequenced { getSequenced :: m a } instance Monad m => Semigroup (Sequenced a m) where Sequenced ma <> Sequenced mb = Sequenced (ma >> mb) {-# INLINE (<>) #-} instance Monad m => Monoid (Sequenced a m) where mempty = Sequenced (return (error "Sequenced: value used")) {-# INLINE mempty #-} mappend = (<>) {-# INLINE mappend #-} ------------------------------------------------------------------------------ -- Indexing ------------------------------------------------------------------------------ -- | 'Applicative' composition of @'Control.Monad.Trans.State.Lazy.State' 'Int'@ with a 'Functor', used -- by 'Control.Lens.Indexed.indexed'. newtype Indexing f a = Indexing { runIndexing :: Int -> (Int, f a) } instance Functor f => Functor (Indexing f) where fmap f (Indexing m) = Indexing $ \i -> case m i of (j, x) -> (j, fmap f x) {-# INLINE fmap #-} instance Applicative f => Applicative (Indexing f) where pure x = Indexing $ \i -> (i, pure x) {-# INLINE pure #-} Indexing mf <*> Indexing ma = Indexing $ \i -> case mf i of (j, ff) -> case ma j of ~(k, fa) -> (k, ff <*> fa) {-# INLINE (<*>) #-} liftA2 f (Indexing ma) (Indexing mb) = Indexing $ \ i -> case ma i of (j, ja) -> case mb j of ~(k, kb) -> (k, liftA2 f ja kb) {-# INLINE liftA2 #-} ------------------------------------------------------------------------------- -- Strict curry ------------------------------------------------------------------------------- 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