{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash    #-}

{- |
Copyright:  (c) 2016-2019 Artyom Kazak
            (c) 2019-2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Note: a lot of these functions are available for other types (in their respective packages):

  * @<http://hackage.haskell.org/package/vector/docs/Data-Vector.html Data.Vector>@ provides 'indexed' and lots of other functions beginning with “i”.

  * @<http://hackage.haskell.org/package/containers/docs/Data-Map-Lazy.html Data.Map>@ and @<http://hackage.haskell.org/package/containers/docs/Data-Sequence.html Data.Sequence>@ provide similar functions, but use a different naming convention (e.g. @<http://hackage.haskell.org/package/containers/docs/Data-Map-Lazy.html#v:mapWithKey mapWithKey>@ for maps and @<http://hackage.haskell.org/package/containers/docs/Data-Sequence.html#v:foldrWithIndex foldrWithIndex>@ for sequences).

  * <http://hackage.haskell.org/package/lens lens> provides several typeclasses for indexed functions that work on maps, lists, vectors, bytestrings, and so on (in @<http://hackage.haskell.org/package/lens/docs/Control-Lens-Indexed.html Control.Lens.Indexed>@), but unfortunately they are pretty slow for lists.
-}

module Data.List.Index
    ( -- * Original functions
      indexed
    , deleteAt
    , setAt
    , modifyAt
    , updateAt
    , insertAt

      -- * Adapted functions from "Data.List"
      -- $adapted
      -- ** Maps
    , imap
    , imapM
    , imapM_
    , ifor
    , ifor_
      -- ** Folds
    , ifoldr
    , ifoldl
    , ifoldl'
    , iall
    , iany
    , iconcatMap
      -- ** Sublists
    , ifilter
    , ipartition
    , itakeWhile
    , idropWhile
      -- ** Zipping
    , izipWith
    , izipWithM
    , izipWithM_
      -- ** Search
    , ifind
    , ifindIndex
    , ifindIndices

      -- * Less commonly used functions
      -- ** Zipping
    , izipWith3
    , izipWith4
    , izipWith5
    , izipWith6
    , izipWith7
      -- ** Monadic functions
    , iforM
    , iforM_
    , itraverse
    , itraverse_
    , ireplicateM
    , ireplicateM_
    , ifoldrM
    , ifoldlM
      -- ** Folds
    , ifoldMap
    , imapAccumR
    , imapAccumL
    ) where

import Data.Foldable (sequenceA_)
import Data.Maybe (listToMaybe)
import Data.Semigroup (Semigroup ((<>)))
import GHC.Base (Int (..), Int#, build, oneShot, (+#))


{- Left to do:

Functions
~~~~~~~~~

alterF or something?

iscanl
iscanl'
iscanl1
iscanr
iscanr1

iiterate?

backpermute?
minIndex/maxIndex?
-}

{- |
'indexed' pairs each element with its index.

>>> indexed "hello"
[(0,'h'),(1,'e'),(2,'l'),(3,'l'),(4,'o')]

/Subject to fusion./
-}
indexed :: [a] -> [(Int, a)]
indexed :: forall a. [a] -> [(Int, a)]
indexed [a]
xs = Int# -> [a] -> [(Int, a)]
forall {b}. Int# -> [b] -> [(Int, b)]
go Int#
0# [a]
xs
  where
    go :: Int# -> [b] -> [(Int, b)]
go Int#
i (b
a:[b]
as) = (Int# -> Int
I# Int#
i, b
a) (Int, b) -> [(Int, b)] -> [(Int, b)]
forall a. a -> [a] -> [a]
: Int# -> [b] -> [(Int, b)]
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) [b]
as
    go Int#
_ [b]
_      = []
{-# NOINLINE [1] indexed #-}

indexedFB :: ((Int, a) -> t -> t) -> a -> (Int# -> t) -> Int# -> t
indexedFB :: forall a t. ((Int, a) -> t -> t) -> a -> (Int# -> t) -> Int# -> t
indexedFB (Int, a) -> t -> t
c = \a
x Int# -> t
cont Int#
i -> (Int# -> Int
I# Int#
i, a
x) (Int, a) -> t -> t
`c` Int# -> t
cont (Int#
i Int# -> Int# -> Int#
+# Int#
1#)
{-# INLINE [0] indexedFB #-}

{-# RULES
"indexed"       [~1] forall xs.    indexed xs = build (\c n -> foldr (indexedFB c) (\_ -> n) xs 0#)
"indexedList"   [1]  forall xs.    foldr (indexedFB (:)) (\_ -> []) xs 0# = indexed xs
  #-}

{- |
'deleteAt' deletes the element at an index.

If the index is negative or exceeds list length, the original list will be returned.
-}
deleteAt :: Int -> [a] -> [a]
deleteAt :: forall a. Int -> [a] -> [a]
deleteAt Int
i [a]
ls
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [a]
ls
  | Bool
otherwise = Int -> [a] -> [a]
forall {t} {a}. (Eq t, Num t) => t -> [a] -> [a]
go Int
i [a]
ls
  where
    go :: t -> [a] -> [a]
go t
0 (a
_:[a]
xs) = [a]
xs
    go t
n (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: t -> [a] -> [a]
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [a]
xs
    go t
_ []     = []
{-# INLINE deleteAt #-}

{- |
'setAt' sets the element at the index.

If the index is negative or exceeds list length, the original list will be returned.
-}
setAt :: Int -> a -> [a] -> [a]
setAt :: forall a. Int -> a -> [a] -> [a]
setAt Int
i a
a [a]
ls
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [a]
ls
  | Bool
otherwise = Int -> [a] -> [a]
forall {t}. (Eq t, Num t) => t -> [a] -> [a]
go Int
i [a]
ls
  where
    go :: t -> [a] -> [a]
go t
0 (a
_:[a]
xs) = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
    go t
n (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: t -> [a] -> [a]
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [a]
xs
    go t
_ []     = []
{-# INLINE setAt #-}

{- |
'modifyAt' applies a function to the element at the index.

If the index is negative or exceeds list length, the original list will be returned.
-}
modifyAt :: Int -> (a -> a) -> [a] -> [a]
modifyAt :: forall a. Int -> (a -> a) -> [a] -> [a]
modifyAt Int
i a -> a
f [a]
ls
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [a]
ls
  | Bool
otherwise = Int -> [a] -> [a]
forall {t}. (Eq t, Num t) => t -> [a] -> [a]
go Int
i [a]
ls
  where
    go :: t -> [a] -> [a]
go t
0 (a
x:[a]
xs) = a -> a
f a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
    go t
n (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: t -> [a] -> [a]
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [a]
xs
    go t
_ []     = []
{-# INLINE modifyAt #-}

{- |
'updateAt' applies a function to the element at the index, and then either replaces the element or deletes it (if the function has returned 'Nothing').

If the index is negative or exceeds list length, the original list will be returned.
-}
updateAt :: Int -> (a -> Maybe a) -> [a] -> [a]
updateAt :: forall a. Int -> (a -> Maybe a) -> [a] -> [a]
updateAt Int
i a -> Maybe a
f [a]
ls
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [a]
ls
  | Bool
otherwise = Int -> [a] -> [a]
forall {t}. (Eq t, Num t) => t -> [a] -> [a]
go Int
i [a]
ls
  where
    go :: t -> [a] -> [a]
go t
0 (a
x:[a]
xs) = case a -> Maybe a
f a
x of
      Maybe a
Nothing -> [a]
xs
      Just a
x' -> a
x' a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
    go t
n (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: t -> [a] -> [a]
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [a]
xs
    go t
_ [] = []
{-# INLINE updateAt #-}

{- |
'insertAt' inserts an element at the given position:

@
(insertAt i x xs) !! i == x
@

If the index is negative or exceeds list length, the original list will be returned. (If the index is equal to the list length, the insertion can be carried out.)
-}
insertAt :: Int -> a -> [a] -> [a]
insertAt :: forall a. Int -> a -> [a] -> [a]
insertAt Int
i a
a [a]
ls
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [a]
ls
  | Bool
otherwise = Int -> [a] -> [a]
forall {t}. (Eq t, Num t) => t -> [a] -> [a]
go Int
i [a]
ls
  where
    go :: t -> [a] -> [a]
go t
0 [a]
xs     = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
    go t
n (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: t -> [a] -> [a]
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [a]
xs
    go t
_ []     = []
{-# INLINE insertAt #-}

{-

David Feuer says that drop-like functions tend to have problems when implemented with folds: <http://ircbrowse.net/browse/haskell?id=22794495&timestamp=1463607633#t1463607633>. I haven't been able to observe this, but since Data.List defines drop/dropWhile/etc that don't fuse, let's do it here as well – just in case. The original version (that does fuse) is below.

-- The plan is that if it does inline, it'll be fast; and if it doesn't
-- inline, the former definition will be used and sharing will be preserved
-- (i.e. if i == 0, it won't rebuild the whole list).
deleteAtFB :: Int -> (a -> t -> t) -> a -> (Int# -> t) -> Int# -> t
deleteAtFB (I# i) c = \x r k ->
  case k ==# i of
    0# -> x `c` r (k +# 1#)
    _  -> r (k +# 1#)
{-# INLINE [0] deleteAtFB #-}

{-# RULES
"deleteAt"       [~1] forall i xs.    deleteAt i xs = build (\c n -> foldr (deleteAtFB i c) (\_ -> n) xs 0#)
"deleteAtList"   [1]  forall i xs.    foldr (deleteAtFB i (:)) (\_ -> []) xs 0# = deleteAt i xs
  #-}

-}

{- $adapted

These functions mimic their counterparts in "Data.List" – 'imap', for instance, works like 'map' but gives the index of the element to the modifying function.

Note that left folds have the index argument /after/ the accumulator argument – that's the convention adopted by containers and vector (but not lens).
-}

{- |
/Subject to fusion./
-}
imap :: (Int -> a -> b) -> [a] -> [b]
imap :: forall a b. (Int -> a -> b) -> [a] -> [b]
imap Int -> a -> b
f [a]
ls = Int# -> [a] -> [b]
go Int#
0# [a]
ls
  where
    go :: Int# -> [a] -> [b]
go Int#
i (a
x:[a]
xs) = Int -> a -> b
f (Int# -> Int
I# Int#
i) a
x b -> [b] -> [b]
forall a. a -> [a] -> [a]
: Int# -> [a] -> [b]
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) [a]
xs
    go Int#
_ [a]
_      = []
{-# NOINLINE [1] imap #-}

imapFB
  :: (b -> t -> t) -> (Int -> a -> b) -> a -> (Int# -> t) -> Int# -> t
imapFB :: forall b t a.
(b -> t -> t) -> (Int -> a -> b) -> a -> (Int# -> t) -> Int# -> t
imapFB b -> t -> t
c Int -> a -> b
f = \a
x Int# -> t
r Int#
k -> Int -> a -> b
f (Int# -> Int
I# Int#
k) a
x b -> t -> t
`c` Int# -> t
r (Int#
k Int# -> Int# -> Int#
+# Int#
1#)
{-# INLINE [0] imapFB #-}

{-# RULES
"imap"       [~1] forall f xs.    imap f xs = build (\c n -> foldr (imapFB c f) (\_ -> n) xs 0#)
"imapList"   [1]  forall f xs.    foldr (imapFB (:) f) (\_ -> []) xs 0# = imap f xs
  #-}

{-
Note: we don't apply the *FB transformation to 'iconcatMap' because it uses 'ifoldr' instead of 'foldr', and 'ifoldr' might get inlined itself, and rewriting 'iconcatMap' with 'foldr' instead of 'ifoldr' is annoying. So, in theory it's a small optimisation possibility (in practice I'm not so sure, given that functions with 'build' don't seem to perform worse than functions without it).
-}
iconcatMap :: (Int -> a -> [b]) -> [a] -> [b]
iconcatMap :: forall a b. (Int -> a -> [b]) -> [a] -> [b]
iconcatMap Int -> a -> [b]
f [a]
xs = (forall b. (b -> b -> b) -> b -> b) -> [b]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build ((forall b. (b -> b -> b) -> b -> b) -> [b])
-> (forall b. (b -> b -> b) -> b -> b) -> [b]
forall a b. (a -> b) -> a -> b
$ \b -> b -> b
c b
n ->
  (Int -> a -> b -> b) -> b -> [a] -> b
forall a b. (Int -> a -> b -> b) -> b -> [a] -> b
ifoldr (\Int
i a
x b
b -> (b -> b -> b) -> b -> [b] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr b -> b -> b
c b
b (Int -> a -> [b]
f Int
i a
x)) b
n [a]
xs
{-# INLINE iconcatMap #-}

ifoldMap :: (Semigroup m, Monoid m) => (Int -> a -> m) -> [a] -> m
ifoldMap :: forall m a. (Semigroup m, Monoid m) => (Int -> a -> m) -> [a] -> m
ifoldMap Int -> a -> m
p [a]
ls = (a -> (Int# -> m) -> Int# -> m) -> (Int# -> m) -> [a] -> Int# -> m
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (Int# -> m) -> Int# -> m
go (\Int#
_ -> m
forall a. Monoid a => a
mempty) [a]
ls Int#
0#
  where go :: a -> (Int# -> m) -> Int# -> m
go a
x Int# -> m
r Int#
k = Int -> a -> m
p (Int# -> Int
I# Int#
k) a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> Int# -> m
r (Int#
k Int# -> Int# -> Int#
+# Int#
1#)
{-# INLINE ifoldMap #-}

{- |
/Subject to fusion./
-}
iall :: (Int -> a -> Bool) -> [a] -> Bool
iall :: forall a. (Int -> a -> Bool) -> [a] -> Bool
iall Int -> a -> Bool
p [a]
ls = (a -> (Int# -> Bool) -> Int# -> Bool)
-> (Int# -> Bool) -> [a] -> Int# -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (Int# -> Bool) -> Int# -> Bool
go (\Int#
_ -> Bool
True) [a]
ls Int#
0#
  where go :: a -> (Int# -> Bool) -> Int# -> Bool
go a
x Int# -> Bool
r Int#
k = Int -> a -> Bool
p (Int# -> Int
I# Int#
k) a
x Bool -> Bool -> Bool
&& Int# -> Bool
r (Int#
k Int# -> Int# -> Int#
+# Int#
1#)
{-# INLINE iall #-}

{- |
/Subject to fusion./
-}
iany :: (Int -> a -> Bool) -> [a] -> Bool
iany :: forall a. (Int -> a -> Bool) -> [a] -> Bool
iany Int -> a -> Bool
p [a]
ls = (a -> (Int# -> Bool) -> Int# -> Bool)
-> (Int# -> Bool) -> [a] -> Int# -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (Int# -> Bool) -> Int# -> Bool
go (\Int#
_ -> Bool
False) [a]
ls Int#
0#
  where go :: a -> (Int# -> Bool) -> Int# -> Bool
go a
x Int# -> Bool
r Int#
k = Int -> a -> Bool
p (Int# -> Int
I# Int#
k) a
x Bool -> Bool -> Bool
|| Int# -> Bool
r (Int#
k Int# -> Int# -> Int#
+# Int#
1#)
{-# INLINE iany #-}

imapM :: Monad m => (Int -> a -> m b) -> [a] -> m [b]
imapM :: forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> [a] -> m [b]
imapM Int -> a -> m b
f [a]
as = (Int -> a -> m [b] -> m [b]) -> m [b] -> [a] -> m [b]
forall a b. (Int -> a -> b -> b) -> b -> [a] -> b
ifoldr Int -> a -> m [b] -> m [b]
k ([b] -> m [b]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []) [a]
as
  where
    k :: Int -> a -> m [b] -> m [b]
k Int
i a
a m [b]
r = do
      b
x <- Int -> a -> m b
f Int
i a
a
      [b]
xs <- m [b]
r
      [b] -> m [b]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b
xb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
xs)
{-# INLINE imapM #-}

iforM :: Monad m => [a] -> (Int -> a -> m b) -> m [b]
iforM :: forall (m :: * -> *) a b.
Monad m =>
[a] -> (Int -> a -> m b) -> m [b]
iforM = ((Int -> a -> m b) -> [a] -> m [b])
-> [a] -> (Int -> a -> m b) -> m [b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> a -> m b) -> [a] -> m [b]
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> [a] -> m [b]
imapM
{-# INLINE iforM #-}

itraverse :: Applicative m => (Int -> a -> m b) -> [a] -> m [b]
itraverse :: forall (m :: * -> *) a b.
Applicative m =>
(Int -> a -> m b) -> [a] -> m [b]
itraverse Int -> a -> m b
f [a]
as = (Int -> a -> m [b] -> m [b]) -> m [b] -> [a] -> m [b]
forall a b. (Int -> a -> b -> b) -> b -> [a] -> b
ifoldr Int -> a -> m [b] -> m [b]
k ([b] -> m [b]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) [a]
as
  where
    k :: Int -> a -> m [b] -> m [b]
k Int
i a
a m [b]
r = (:) (b -> [b] -> [b]) -> m b -> m ([b] -> [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> m b
f Int
i a
a m ([b] -> [b]) -> m [b] -> m [b]
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m [b]
r
{-# INLINE itraverse #-}

ifor :: Applicative m => [a] -> (Int -> a -> m b) -> m [b]
ifor :: forall (m :: * -> *) a b.
Applicative m =>
[a] -> (Int -> a -> m b) -> m [b]
ifor = ((Int -> a -> m b) -> [a] -> m [b])
-> [a] -> (Int -> a -> m b) -> m [b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> a -> m b) -> [a] -> m [b]
forall (m :: * -> *) a b.
Applicative m =>
(Int -> a -> m b) -> [a] -> m [b]
itraverse
{-# INLINE ifor #-}

{- |
/Subject to fusion./
-}
imapM_ :: Monad m => (Int -> a -> m b) -> [a] -> m ()
imapM_ :: forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> [a] -> m ()
imapM_ Int -> a -> m b
f [a]
as = (Int -> a -> m () -> m ()) -> m () -> [a] -> m ()
forall a b. (Int -> a -> b -> b) -> b -> [a] -> b
ifoldr Int -> a -> m () -> m ()
forall {b}. Int -> a -> m b -> m b
k (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) [a]
as
  where
    k :: Int -> a -> m b -> m b
k Int
i a
a m b
r = Int -> a -> m b
f Int
i a
a m b -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m b
r
{-# INLINE imapM_ #-}

{- |
/Subject to fusion./
-}
iforM_ :: Monad m => [a] -> (Int -> a -> m b) -> m ()
iforM_ :: forall (m :: * -> *) a b.
Monad m =>
[a] -> (Int -> a -> m b) -> m ()
iforM_ = ((Int -> a -> m b) -> [a] -> m ())
-> [a] -> (Int -> a -> m b) -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> a -> m b) -> [a] -> m ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> [a] -> m ()
imapM_
{-# INLINE iforM_ #-}

{- |
/Subject to fusion./
-}
itraverse_ :: Applicative m => (Int -> a -> m b) -> [a] -> m ()
itraverse_ :: forall (m :: * -> *) a b.
Applicative m =>
(Int -> a -> m b) -> [a] -> m ()
itraverse_ Int -> a -> m b
f [a]
as = (Int -> a -> m () -> m ()) -> m () -> [a] -> m ()
forall a b. (Int -> a -> b -> b) -> b -> [a] -> b
ifoldr Int -> a -> m () -> m ()
forall {b}. Int -> a -> m b -> m b
k (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) [a]
as
  where
    k :: Int -> a -> m b -> m b
k Int
i a
a m b
r = Int -> a -> m b
f Int
i a
a m b -> m b -> m b
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m b
r
{-# INLINE itraverse_ #-}

{- |
/Subject to fusion./
-}
ifor_ :: Applicative m => [a] -> (Int -> a -> m b) -> m ()
ifor_ :: forall (m :: * -> *) a b.
Applicative m =>
[a] -> (Int -> a -> m b) -> m ()
ifor_ = ((Int -> a -> m b) -> [a] -> m ())
-> [a] -> (Int -> a -> m b) -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> a -> m b) -> [a] -> m ()
forall (m :: * -> *) a b.
Applicative m =>
(Int -> a -> m b) -> [a] -> m ()
itraverse_
{-# INLINE ifor_ #-}

{- |
Perform a given action @n@ times. Behaves like @for_ [0..n-1]@, but avoids <https://ghc.haskell.org/trac/ghc/ticket/12620 space leaks>.

If you want more complicated loops (e.g. counting downwards), consider the <https://hackage.haskell.org/package/loop loop> package.
-}
ireplicateM :: Applicative m => Int -> (Int -> m a) -> m [a]
ireplicateM :: forall (m :: * -> *) a.
Applicative m =>
Int -> (Int -> m a) -> m [a]
ireplicateM Int
cnt Int -> m a
f = Int -> m [a]
go Int
0
  where
    go :: Int -> m [a]
go !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
cnt  = [a] -> m [a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
          | Bool
otherwise = (:) (a -> [a] -> [a]) -> m a -> m ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m a
f Int
i m ([a] -> [a]) -> m [a] -> m [a]
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> m [a]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE ireplicateM #-}

{- |
NB. This function intentionally uses 'Monad' even though 'Applicative' is enough. That's because the @transformers@ package didn't have an optimized definition of ('*>') for 'StateT' prior to 0.5.3.0, so for a common case of 'StateT' this function would be 40 times slower with the 'Applicative' constraint.
-}
ireplicateM_ :: Monad m => Int -> (Int -> m a) -> m ()
ireplicateM_ :: forall (m :: * -> *) a. Monad m => Int -> (Int -> m a) -> m ()
ireplicateM_ Int
cnt Int -> m a
f = if Int
cnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int -> m ()
go Int
0 else () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    -- this is 30% faster for Maybe than the simpler
    --     go i | i == cnt  = return ()
    --          | otherwise = f i >> go (i + 1)
    cnt_ :: Int
cnt_ = Int
cntInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
    go :: Int -> m ()
go !Int
i = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cnt_ then Int -> m a
f Int
i m a -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return () else Int -> m a
f Int
i m a -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> m ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE ireplicateM_ #-}

-- Using unboxed ints here doesn't seem to result in any benefit
ifoldr :: (Int -> a -> b -> b) -> b -> [a] -> b
ifoldr :: forall a b. (Int -> a -> b -> b) -> b -> [a] -> b
ifoldr Int -> a -> b -> b
f b
z [a]
xs = (a -> (Int -> b) -> Int -> b) -> (Int -> b) -> [a] -> Int -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x Int -> b
g Int
i -> Int -> a -> b -> b
f Int
i a
x (Int -> b
g (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))) (b -> Int -> b
forall a b. a -> b -> a
const b
z) [a]
xs Int
0
{-# INLINE ifoldr #-}

ifoldrM :: Monad m => (Int -> a -> b -> m b) -> b -> [a] -> m b
ifoldrM :: forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> b -> m b) -> b -> [a] -> m b
ifoldrM Int -> a -> b -> m b
f b
z [a]
xs = (Int -> a -> m b -> m b) -> m b -> [a] -> m b
forall a b. (Int -> a -> b -> b) -> b -> [a] -> b
ifoldr Int -> a -> m b -> m b
k (b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
z) [a]
xs
  where
    k :: Int -> a -> m b -> m b
k Int
i a
a m b
r = Int -> a -> b -> m b
f Int
i a
a (b -> m b) -> m b -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m b
r
{-# INLINE ifoldrM #-}

imapAccumR
  :: (acc -> Int -> x -> (acc, y))
  -> acc
  -> [x]
  -> (acc, [y])
imapAccumR :: forall acc x y.
(acc -> Int -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
imapAccumR acc -> Int -> x -> (acc, y)
f acc
z [x]
xs =
  (x -> (Int -> (acc, [y])) -> Int -> (acc, [y]))
-> (Int -> (acc, [y])) -> [x] -> Int -> (acc, [y])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\x
x Int -> (acc, [y])
g Int
i -> let (acc
a, [y]
ys) = Int -> (acc, [y])
g (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                       (acc
a', y
y) = acc -> Int -> x -> (acc, y)
f acc
a Int
i x
x
                   in  (acc
a', y
yy -> [y] -> [y]
forall a. a -> [a] -> [a]
:[y]
ys))
        ((acc, [y]) -> Int -> (acc, [y])
forall a b. a -> b -> a
const (acc
z, [])) [x]
xs Int
0
{-# INLINE imapAccumR #-}

{-

ifoldr1 :: (Int -> a -> a -> a) -> [a] -> a
ifoldr1 f = go 0#
  where go _ [x]    = x
        go i (x:xs) = f (I# i) x (go (i +# 1#) xs)
        go _ []     = errorEmptyList "ifoldr1"
{-# INLINE [0] ifoldr1 #-}

-}

{- |
The index isn't the first argument of the function because that's the convention adopted by containers and vector (but not lens).

/Subject to fusion./
-}
ifoldl :: forall a b. (b -> Int -> a -> b) -> b -> [a] -> b
ifoldl :: forall a b. (b -> Int -> a -> b) -> b -> [a] -> b
ifoldl b -> Int -> a -> b
k b
z0 [a]
xs =
  (a -> ((Int, b) -> b) -> (Int, b) -> b)
-> ((Int, b) -> b) -> [a] -> (Int, b) -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(a
v::a) ((Int, b) -> b
fn :: (Int, b) -> b) ->
          ((Int, b) -> b) -> (Int, b) -> b
forall a b. (a -> b) -> a -> b
oneShot (\((!Int
i)::Int, b
z::b) -> (Int, b) -> b
fn (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, b -> Int -> a -> b
k b
z Int
i a
v)))
        ((Int, b) -> b
forall a b. (a, b) -> b
snd :: (Int, b) -> b)
        [a]
xs
        (Int
0, b
z0)
{-# INLINE ifoldl #-}

{- |
/Subject to fusion./
-}
ifoldl' :: forall a b. (b -> Int -> a -> b) -> b -> [a] -> b
ifoldl' :: forall a b. (b -> Int -> a -> b) -> b -> [a] -> b
ifoldl' b -> Int -> a -> b
k b
z0 [a]
xs =
  (a -> ((Int, b) -> b) -> (Int, b) -> b)
-> ((Int, b) -> b) -> [a] -> (Int, b) -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(a
v::a) ((Int, b) -> b
fn :: (Int, b) -> b) ->
          ((Int, b) -> b) -> (Int, b) -> b
forall a b. (a -> b) -> a -> b
oneShot (\((!Int
i)::Int, b
z::b) -> b
z b -> b -> b
forall a b. a -> b -> b
`seq` (Int, b) -> b
fn (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, b -> Int -> a -> b
k b
z Int
i a
v)))
        ((Int, b) -> b
forall a b. (a, b) -> b
snd :: (Int, b) -> b)
        [a]
xs
        (Int
0, b
z0)
{-# INLINE ifoldl' #-}

{- |
/Subject to fusion./
-}
ifoldlM :: Monad m => (b -> Int -> a -> m b) -> b -> [a] -> m b
ifoldlM :: forall (m :: * -> *) b a.
Monad m =>
(b -> Int -> a -> m b) -> b -> [a] -> m b
ifoldlM b -> Int -> a -> m b
f b
z [a]
xs = (m b -> Int -> a -> m b) -> m b -> [a] -> m b
forall a b. (b -> Int -> a -> b) -> b -> [a] -> b
ifoldl m b -> Int -> a -> m b
k (b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
z) [a]
xs
  where
    k :: m b -> Int -> a -> m b
k m b
a Int
i a
r = do b
a' <- m b
a; b -> Int -> a -> m b
f b
a' Int
i a
r
{-# INLINE ifoldlM #-}

imapAccumL
  :: (acc -> Int -> x -> (acc, y))
  -> acc
  -> [x]
  -> (acc, [y])
imapAccumL :: forall acc x y.
(acc -> Int -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
imapAccumL acc -> Int -> x -> (acc, y)
f acc
z [x]
xs =
  (x -> ((Int, acc) -> (acc, [y])) -> (Int, acc) -> (acc, [y]))
-> ((Int, acc) -> (acc, [y])) -> [x] -> (Int, acc) -> (acc, [y])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(x
x::a) ((Int, acc) -> (acc, [y])
r :: (Int,acc) -> (acc,[y])) ->
          ((Int, acc) -> (acc, [y])) -> (Int, acc) -> (acc, [y])
forall a b. (a -> b) -> a -> b
oneShot (\((!Int
i)::Int, acc
s::acc) ->
            let (acc
s', y
y)   = acc -> Int -> x -> (acc, y)
f acc
s Int
i x
x
                (acc
s'', [y]
ys) = (Int, acc) -> (acc, [y])
r (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, acc
s')
            in (acc
s'', y
yy -> [y] -> [y]
forall a. a -> [a] -> [a]
:[y]
ys)))
        ((\(Int
_, acc
a) -> (acc
a, [])) :: (Int,acc) -> (acc,[y]))
        [x]
xs
        (Int
0, acc
z)
{-# INLINE imapAccumL #-}

{-

ifoldl1 :: (a -> Int -> a -> a) -> [a] -> a
ifoldl1 f (x:xs) = ifoldl f x xs
ifoldl1 _ []     = errorEmptyList "ifoldl1"

ifoldl1' :: (a -> Int -> a -> a) -> [a] -> a
ifoldl1' f (x:xs) = ifoldl' f x xs
ifoldl1' _ []     = errorEmptyList "ifoldl1'"

-}

ifilter :: (Int -> a -> Bool) -> [a] -> [a]
ifilter :: forall a. (Int -> a -> Bool) -> [a] -> [a]
ifilter Int -> a -> Bool
p [a]
ls = Int# -> [a] -> [a]
go Int#
0# [a]
ls
  where
    go :: Int# -> [a] -> [a]
go Int#
i (a
x:[a]
xs) | Int -> a -> Bool
p (Int# -> Int
I# Int#
i) a
x = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int# -> [a] -> [a]
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) [a]
xs
                | Bool
otherwise  = Int# -> [a] -> [a]
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) [a]
xs
    go Int#
_ [a]
_ = []
{-# NOINLINE [1] ifilter #-}

ifilterFB
  :: (a -> t -> t) -> (Int -> a -> Bool) -> a -> (Int# -> t) -> Int# -> t
ifilterFB :: forall a t.
(a -> t -> t)
-> (Int -> a -> Bool) -> a -> (Int# -> t) -> Int# -> t
ifilterFB a -> t -> t
c Int -> a -> Bool
p = \a
x Int# -> t
r Int#
k ->
  if Int -> a -> Bool
p (Int# -> Int
I# Int#
k) a
x then a
x a -> t -> t
`c` Int# -> t
r (Int#
k Int# -> Int# -> Int#
+# Int#
1#) else Int# -> t
r (Int#
k Int# -> Int# -> Int#
+# Int#
1#)
{-# INLINE [0] ifilterFB #-}

{-# RULES
"ifilter"       [~1] forall p xs.    ifilter p xs = build (\c n -> foldr (ifilterFB c p) (\_ -> n) xs 0#)
"ifilterList"   [1]  forall p xs.    foldr (ifilterFB (:) p) (\_ -> []) xs 0# = ifilter p xs
  #-}

itakeWhile :: (Int -> a -> Bool) -> [a] -> [a]
itakeWhile :: forall a. (Int -> a -> Bool) -> [a] -> [a]
itakeWhile Int -> a -> Bool
p [a]
ls = Int# -> [a] -> [a]
go Int#
0# [a]
ls
  where
    go :: Int# -> [a] -> [a]
go Int#
i (a
x:[a]
xs) | Int -> a -> Bool
p (Int# -> Int
I# Int#
i) a
x = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int# -> [a] -> [a]
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) [a]
xs
                | Bool
otherwise  = []
    go Int#
_ [a]
_ = []
{-# NOINLINE [1] itakeWhile #-}

itakeWhileFB
  :: (a -> t -> t) -> (Int -> a -> Bool) -> t -> a -> (Int# -> t) -> Int# -> t
itakeWhileFB :: forall a t.
(a -> t -> t)
-> (Int -> a -> Bool) -> t -> a -> (Int# -> t) -> Int# -> t
itakeWhileFB a -> t -> t
c Int -> a -> Bool
p t
n = \a
x Int# -> t
r Int#
k ->
  if Int -> a -> Bool
p (Int# -> Int
I# Int#
k) a
x then a
x a -> t -> t
`c` Int# -> t
r (Int#
k Int# -> Int# -> Int#
+# Int#
1#) else t
n
{-# INLINE [0] itakeWhileFB #-}

{-# RULES
"itakeWhile"       [~1] forall p xs.    itakeWhile p xs = build (\c n -> foldr (itakeWhileFB c p n) (\_ -> n) xs 0#)
"itakeWhileList"   [1]  forall p xs.    foldr (itakeWhileFB (:) p []) (\_ -> []) xs 0# = itakeWhile p xs
  #-}

idropWhile :: (Int -> a -> Bool) -> [a] -> [a]
idropWhile :: forall a. (Int -> a -> Bool) -> [a] -> [a]
idropWhile Int -> a -> Bool
p [a]
ls = Int# -> [a] -> [a]
go Int#
0# [a]
ls
  where
    go :: Int# -> [a] -> [a]
go Int#
i (a
x:[a]
xs) | Int -> a -> Bool
p (Int# -> Int
I# Int#
i) a
x = Int# -> [a] -> [a]
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) [a]
xs
                | Bool
otherwise  = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs
    go Int#
_ [] = []
{-# INLINE idropWhile #-}

ipartition :: (Int -> a -> Bool) -> [a] -> ([a],[a])
ipartition :: forall a. (Int -> a -> Bool) -> [a] -> ([a], [a])
ipartition Int -> a -> Bool
p [a]
xs = (Int -> a -> ([a], [a]) -> ([a], [a]))
-> ([a], [a]) -> [a] -> ([a], [a])
forall a b. (Int -> a -> b -> b) -> b -> [a] -> b
ifoldr ((Int -> a -> Bool) -> Int -> a -> ([a], [a]) -> ([a], [a])
forall a.
(Int -> a -> Bool) -> Int -> a -> ([a], [a]) -> ([a], [a])
iselect Int -> a -> Bool
p) ([],[]) [a]
xs
{-# INLINE ipartition #-}

iselect :: (Int -> a -> Bool) -> Int -> a -> ([a], [a]) -> ([a], [a])
iselect :: forall a.
(Int -> a -> Bool) -> Int -> a -> ([a], [a]) -> ([a], [a])
iselect Int -> a -> Bool
p Int
i a
x ~([a]
ts,[a]
fs) | Int -> a -> Bool
p Int
i a
x     = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ts,[a]
fs)
                       | Bool
otherwise = ([a]
ts, a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
fs)

ifind :: (Int -> a -> Bool) -> [a] -> Maybe (Int, a)
ifind :: forall a. (Int -> a -> Bool) -> [a] -> Maybe (Int, a)
ifind Int -> a -> Bool
p [a]
ls = Int# -> [a] -> Maybe (Int, a)
go Int#
0# [a]
ls
  where
    go :: Int# -> [a] -> Maybe (Int, a)
go Int#
i (a
x:[a]
xs) | Int -> a -> Bool
p (Int# -> Int
I# Int#
i) a
x = (Int, a) -> Maybe (Int, a)
forall a. a -> Maybe a
Just (Int# -> Int
I# Int#
i, a
x)
                | Bool
otherwise  = Int# -> [a] -> Maybe (Int, a)
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) [a]
xs
    go Int#
_ [a]
_ = Maybe (Int, a)
forall a. Maybe a
Nothing
{-# INLINE ifind #-}

ifindIndex :: (Int -> a -> Bool) -> [a] -> Maybe Int
ifindIndex :: forall a. (Int -> a -> Bool) -> [a] -> Maybe Int
ifindIndex Int -> a -> Bool
p = [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe ([Int] -> Maybe Int) -> ([a] -> [Int]) -> [a] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> Bool) -> [a] -> [Int]
forall a. (Int -> a -> Bool) -> [a] -> [Int]
ifindIndices Int -> a -> Bool
p

ifindIndices :: (Int -> a -> Bool) -> [a] -> [Int]
ifindIndices :: forall a. (Int -> a -> Bool) -> [a] -> [Int]
ifindIndices Int -> a -> Bool
p [a]
ls = Int# -> [a] -> [Int]
go Int#
0# [a]
ls
  where
    go :: Int# -> [a] -> [Int]
go Int#
_ [] = []
    go Int#
i (a
x:[a]
xs) | Int -> a -> Bool
p (Int# -> Int
I# Int#
i) a
x = Int# -> Int
I# Int#
i Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int# -> [a] -> [Int]
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) [a]
xs
                | Bool
otherwise  = Int# -> [a] -> [Int]
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) [a]
xs
{-# NOINLINE [1] ifindIndices #-}

ifindIndicesFB
  :: (Int -> t -> t) -> (Int -> a -> Bool) -> a -> (Int# -> t) -> Int# -> t
ifindIndicesFB :: forall t a.
(Int -> t -> t)
-> (Int -> a -> Bool) -> a -> (Int# -> t) -> Int# -> t
ifindIndicesFB Int -> t -> t
c Int -> a -> Bool
p = \a
x Int# -> t
r Int#
k ->
  if Int -> a -> Bool
p (Int# -> Int
I# Int#
k) a
x then Int# -> Int
I# Int#
k Int -> t -> t
`c` Int# -> t
r (Int#
k Int# -> Int# -> Int#
+# Int#
1#) else Int# -> t
r (Int#
k Int# -> Int# -> Int#
+# Int#
1#)
{-# INLINE [0] ifindIndicesFB #-}

{-# RULES
"ifindIndices"       [~1] forall p xs.    ifindIndices p xs = build (\c n -> foldr (ifindIndicesFB c p) (\_ -> n) xs 0#)
"ifindIndicesList"   [1]  forall p xs.    foldr (ifindIndicesFB (:) p) (\_ -> []) xs 0# = ifindIndices p xs
  #-}

{-

errorEmptyList :: String -> a
errorEmptyList fun = error ("Data.List.Index." ++ fun ++ ": empty list")

-}

{- |
/Subject to fusion in the first argument./
-}
izipWith :: (Int -> a -> b -> c) -> [a] -> [b] -> [c]
izipWith :: forall a b c. (Int -> a -> b -> c) -> [a] -> [b] -> [c]
izipWith Int -> a -> b -> c
fun [a]
xs [b]
ys = Int# -> [a] -> [b] -> [c]
go Int#
0# [a]
xs [b]
ys
  where
    go :: Int# -> [a] -> [b] -> [c]
go Int#
i (a
a:[a]
as) (b
b:[b]
bs) = Int -> a -> b -> c
fun (Int# -> Int
I# Int#
i) a
a b
b c -> [c] -> [c]
forall a. a -> [a] -> [a]
: Int# -> [a] -> [b] -> [c]
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) [a]
as [b]
bs
    go Int#
_ [a]
_ [b]
_           = []
{-# NOINLINE [1] izipWith #-}

izipWithFB
  :: (c -> t -> t) -> (Int -> a -> b -> c) -> a -> b -> (Int# -> t) -> Int# -> t
izipWithFB :: forall c t a b.
(c -> t -> t)
-> (Int -> a -> b -> c) -> a -> b -> (Int# -> t) -> Int# -> t
izipWithFB c -> t -> t
c Int -> a -> b -> c
fun = \a
x b
y Int# -> t
cont Int#
i -> Int -> a -> b -> c
fun (Int# -> Int
I# Int#
i) a
x b
y c -> t -> t
`c` Int# -> t
cont (Int#
i Int# -> Int# -> Int#
+# Int#
1#)
{-# INLINE [0] izipWithFB #-}

{-# RULES
"izipWith"       [~1] forall f xs ys.    izipWith f xs ys = build (\c n -> foldr2 (izipWithFB c f) (\_ -> n) xs ys 0#)
"izipWithList"   [1]  forall f xs ys.    foldr2 (izipWithFB (:) f) (\_ -> []) xs ys 0# = izipWith f xs ys
  #-}

-- Copied from GHC.List

foldr2 :: (a -> b -> c -> c) -> c -> [a] -> [b] -> c
foldr2 :: forall a b c. (a -> b -> c -> c) -> c -> [a] -> [b] -> c
foldr2 a -> b -> c -> c
k c
z = [a] -> [b] -> c
go
  where
        go :: [a] -> [b] -> c
go []    [b]
_ys     = c
z
        go [a]
_xs   []      = c
z
        go (a
x:[a]
xs) (b
y:[b]
ys) = a -> b -> c -> c
k a
x b
y ([a] -> [b] -> c
go [a]
xs [b]
ys)
{-# INLINE [0] foldr2 #-}

foldr2_left :: (a -> b -> c -> d) -> d -> a -> ([b] -> c) -> [b] -> d
foldr2_left :: forall a b c d.
(a -> b -> c -> d) -> d -> a -> ([b] -> c) -> [b] -> d
foldr2_left a -> b -> c -> d
_k  d
z a
_x [b] -> c
_r []     = d
z
foldr2_left  a -> b -> c -> d
k d
_z  a
x  [b] -> c
r (b
y:[b]
ys) = a -> b -> c -> d
k a
x b
y ([b] -> c
r [b]
ys)

{-# RULES
"foldr2/left"   forall k z ys (g::forall b.(a->b->b)->b->b) .
                  foldr2 k z (build g) ys = g (foldr2_left  k z) (\_ -> z) ys
 #-}

izipWith3
  :: (Int -> a -> b -> c -> d)
  -> [a] -> [b] -> [c] -> [d]
izipWith3 :: forall a b c d.
(Int -> a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
izipWith3 Int -> a -> b -> c -> d
fun = Int# -> [a] -> [b] -> [c] -> [d]
go Int#
0#
  where
    go :: Int# -> [a] -> [b] -> [c] -> [d]
go Int#
i (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) =
      Int -> a -> b -> c -> d
fun (Int# -> Int
I# Int#
i) a
a b
b c
c d -> [d] -> [d]
forall a. a -> [a] -> [a]
: Int# -> [a] -> [b] -> [c] -> [d]
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) [a]
as [b]
bs [c]
cs
    go Int#
_ [a]
_ [b]
_ [c]
_ = []
{-# INLINE izipWith3 #-}

izipWith4
  :: (Int -> a -> b -> c -> d -> e)
  -> [a] -> [b] -> [c] -> [d] -> [e]
izipWith4 :: forall a b c d e.
(Int -> a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
izipWith4 Int -> a -> b -> c -> d -> e
fun = Int# -> [a] -> [b] -> [c] -> [d] -> [e]
go Int#
0#
  where
    go :: Int# -> [a] -> [b] -> [c] -> [d] -> [e]
go Int#
i (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) =
      Int -> a -> b -> c -> d -> e
fun (Int# -> Int
I# Int#
i) a
a b
b c
c d
d e -> [e] -> [e]
forall a. a -> [a] -> [a]
: Int# -> [a] -> [b] -> [c] -> [d] -> [e]
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) [a]
as [b]
bs [c]
cs [d]
ds
    go Int#
_ [a]
_ [b]
_ [c]
_ [d]
_ = []
{-# INLINE izipWith4 #-}

izipWith5
  :: (Int -> a -> b -> c -> d -> e -> f)
  -> [a] -> [b] -> [c] -> [d] -> [e] -> [f]
izipWith5 :: forall a b c d e f.
(Int -> a -> b -> c -> d -> e -> f)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f]
izipWith5 Int -> a -> b -> c -> d -> e -> f
fun = Int# -> [a] -> [b] -> [c] -> [d] -> [e] -> [f]
go Int#
0#
  where
    go :: Int# -> [a] -> [b] -> [c] -> [d] -> [e] -> [f]
go Int#
i (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) (e
e:[e]
es) =
      Int -> a -> b -> c -> d -> e -> f
fun (Int# -> Int
I# Int#
i) a
a b
b c
c d
d e
e f -> [f] -> [f]
forall a. a -> [a] -> [a]
: Int# -> [a] -> [b] -> [c] -> [d] -> [e] -> [f]
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) [a]
as [b]
bs [c]
cs [d]
ds [e]
es
    go Int#
_ [a]
_ [b]
_ [c]
_ [d]
_ [e]
_ = []
{-# INLINE izipWith5 #-}

izipWith6
  :: (Int -> a -> b -> c -> d -> e -> f -> g)
  -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
izipWith6 :: forall a b c d e f g.
(Int -> a -> b -> c -> d -> e -> f -> g)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
izipWith6 Int -> a -> b -> c -> d -> e -> f -> g
fun = Int# -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
go Int#
0#
  where
    go :: Int# -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
go Int#
i (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) (e
e:[e]
es) (f
f:[f]
fs) =
      Int -> a -> b -> c -> d -> e -> f -> g
fun (Int# -> Int
I# Int#
i) a
a b
b c
c d
d e
e f
f g -> [g] -> [g]
forall a. a -> [a] -> [a]
: Int# -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) [a]
as [b]
bs [c]
cs [d]
ds [e]
es [f]
fs
    go Int#
_ [a]
_ [b]
_ [c]
_ [d]
_ [e]
_ [f]
_ = []
{-# INLINE izipWith6 #-}

izipWith7
  :: (Int -> a -> b -> c -> d -> e -> f -> g -> h)
  -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h]
izipWith7 :: forall a b c d e f g h.
(Int -> a -> b -> c -> d -> e -> f -> g -> h)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h]
izipWith7 Int -> a -> b -> c -> d -> e -> f -> g -> h
fun = Int# -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h]
go Int#
0#
  where
    go :: Int# -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h]
go Int#
i (a
a:[a]
as) (b
b:[b]
bs) (c
c:[c]
cs) (d
d:[d]
ds) (e
e:[e]
es) (f
f:[f]
fs) (g
g:[g]
gs) =
      Int -> a -> b -> c -> d -> e -> f -> g -> h
fun (Int# -> Int
I# Int#
i) a
a b
b c
c d
d e
e f
f g
g h -> [h] -> [h]
forall a. a -> [a] -> [a]
: Int# -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h]
go (Int#
i Int# -> Int# -> Int#
+# Int#
1#) [a]
as [b]
bs [c]
cs [d]
ds [e]
es [f]
fs [g]
gs
    go Int#
_ [a]
_ [b]
_ [c]
_ [d]
_ [e]
_ [f]
_ [g]
_ = []
{-# INLINE izipWith7 #-}

izipWithM :: Applicative f => (Int -> a -> b -> f c) -> [a] -> [b] -> f [c]
izipWithM :: forall (f :: * -> *) a b c.
Applicative f =>
(Int -> a -> b -> f c) -> [a] -> [b] -> f [c]
izipWithM Int -> a -> b -> f c
f [a]
as [b]
bs = [f c] -> f [c]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ((Int -> a -> b -> f c) -> [a] -> [b] -> [f c]
forall a b c. (Int -> a -> b -> c) -> [a] -> [b] -> [c]
izipWith Int -> a -> b -> f c
f [a]
as [b]
bs)
{-# INLINE izipWithM #-}

izipWithM_ :: Applicative f => (Int -> a -> b -> f c) -> [a] -> [b] -> f ()
izipWithM_ :: forall (f :: * -> *) a b c.
Applicative f =>
(Int -> a -> b -> f c) -> [a] -> [b] -> f ()
izipWithM_ Int -> a -> b -> f c
f [a]
as [b]
bs = [f c] -> f ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_ ((Int -> a -> b -> f c) -> [a] -> [b] -> [f c]
forall a b c. (Int -> a -> b -> c) -> [a] -> [b] -> [c]
izipWith Int -> a -> b -> f c
f [a]
as [b]
bs)
{-# INLINE izipWithM_ #-}