-- |
-- Higher-order functions with their function arguments at the end,
-- for channeling the full power of BlockArguments and LambdaCase .
module Control.Block
  ( -- * Functor
    (<$>)
  , (<&>)
  , fmap
  , imap
  , change
  , ichange

    -- * Applicative
  , (<**>)
  , apply
  , through

    -- * Monad
  , bind
  , ibind

    -- * Foldable

    -- ** With monoids
  , Fold.foldMap
  , foldMap1
  , foldMapA
  , foldMapA1
  , ifoldMap
  , ifoldMapA
  , reduce
  , reduce1
  , reduceA
  , reduceA1
  , ireduce
  , ireduceA

    -- ** Without monoids
  , reduceL
  , reduceL1
  , reduceR
  , reduceR1

    -- * Traversable
  , traverse
  , itraverse
  , itraverse_
  , for
  , ifor
  , ifor_

    -- * Maybe and List
  , mabye
  , emptn

    -- * Filterable
  , (<$?>)
  , (<&?>)
  , filter
  , ifilter
  , sift
  , isift
  , Witherable.mapMaybe
  , imapMaybe
  , changeMaybe
  , ichangeMaybe

    -- * Witherable
  , filterA
  , ifilterA
  , siftA
  , isiftA
  , wither
  , iwither
  , forMaybe
  , iforMaybe
  )
where

import Control.Applicative
import Control.Monad
import Data.Foldable (Foldable)
import Data.Foldable qualified as Fold
import Data.Foldable.WithIndex
import Data.Foldable1 (Foldable1, foldMap1, foldl1', toNonEmpty)
import Data.Function
import Data.Functor
import Data.Functor.WithIndex
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Maybe
import Data.Monoid (Monoid (mempty))
import Data.Semigroup
import Data.Traversable
import Data.Traversable.WithIndex
import Witherable
import Prelude (Bool)

-- | Non-infix version of '(<&>)'.
change :: (Functor f) => f x -> (x -> y) -> f y
change :: forall (f :: * -> *) x y. Functor f => f x -> (x -> y) -> f y
change = f x -> (x -> y) -> f y
forall (f :: * -> *) x y. Functor f => f x -> (x -> y) -> f y
(<&>)

-- | Flipped version of 'imap'.
ichange :: (FunctorWithIndex i f) => f x -> (i -> x -> y) -> f y
ichange :: forall i (f :: * -> *) x y.
FunctorWithIndex i f =>
f x -> (i -> x -> y) -> f y
ichange = ((i -> x -> y) -> f x -> f y) -> f x -> (i -> x -> y) -> f y
forall a b c. (a -> b -> c) -> b -> a -> c
flip (i -> x -> y) -> f x -> f y
forall a b. (i -> a -> b) -> f a -> f b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap

-- | Non-infix version of '(<*>)'.
apply :: (Applicative f) => f (x -> y) -> f x -> f y
apply :: forall (f :: * -> *) x y. Applicative f => f (x -> y) -> f x -> f y
apply = f (x -> y) -> f x -> f y
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)

-- | Flipped version of 'apply'. Non-infix version of '(<**>)'.
through :: (Applicative f) => f x -> f (x -> y) -> f y
through :: forall (f :: * -> *) x y. Applicative f => f x -> f (x -> y) -> f y
through = f x -> f (x -> y) -> f y
forall (f :: * -> *) x y. Applicative f => f x -> f (x -> y) -> f y
(<**>)

-- | 'foldMap' through an 'Applicative' functor.
foldMapA :: (Foldable t, Applicative f, Monoid m) => (x -> f m) -> t x -> f m
foldMapA :: forall (t :: * -> *) (f :: * -> *) m x.
(Foldable t, Applicative f, Monoid m) =>
(x -> f m) -> t x -> f m
foldMapA x -> f m
f = (f m -> x -> f m) -> f m -> t x -> f m
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Fold.foldl' (\ !f m
fm x
x -> (m -> m -> m) -> f m -> f m -> f m
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 m -> m -> m
forall a. Semigroup a => a -> a -> a
(<>) f m
fm (x -> f m
f x
x)) (m -> f m
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure m
forall a. Monoid a => a
mempty)

-- | 'ifoldMap' through an 'Applicative' functor.
ifoldMapA ::
  (FoldableWithIndex i t, Applicative f, Monoid m) =>
  ((i -> x -> f m) -> t x -> f m)
ifoldMapA :: forall i (t :: * -> *) (f :: * -> *) m x.
(FoldableWithIndex i t, Applicative f, Monoid m) =>
(i -> x -> f m) -> t x -> f m
ifoldMapA i -> x -> f m
f = (i -> f m -> x -> f m) -> f m -> t x -> f m
forall b a. (i -> b -> a -> b) -> b -> t a -> b
forall i (f :: * -> *) b a.
FoldableWithIndex i f =>
(i -> b -> a -> b) -> b -> f a -> b
ifoldl' (\i
i !f m
fm x
x -> (m -> m -> m) -> f m -> f m -> f m
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 m -> m -> m
forall a. Semigroup a => a -> a -> a
(<>) f m
fm (i -> x -> f m
f i
i x
x)) (m -> f m
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure m
forall a. Monoid a => a
mempty)

-- | 'foldMap1' through an 'Applicative' functor.
foldMapA1 ::
  (Foldable1 t, Applicative f, Semigroup s) => (x -> f s) -> t x -> f s
foldMapA1 :: forall (t :: * -> *) (f :: * -> *) s x.
(Foldable1 t, Applicative f, Semigroup s) =>
(x -> f s) -> t x -> f s
foldMapA1 x -> f s
f t x
tx = case t x -> NonEmpty x
forall a. t a -> NonEmpty a
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty t x
tx of
  x
x :| [] -> x -> f s
f x
x
  x
x :| (x
y : [x]
ys) -> (s -> s -> s) -> f s -> f s -> f s
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 s -> s -> s
forall a. Semigroup a => a -> a -> a
(<>) (x -> f s
f x
x) ((x -> f s) -> NonEmpty x -> f s
forall (t :: * -> *) (f :: * -> *) s x.
(Foldable1 t, Applicative f, Semigroup s) =>
(x -> f s) -> t x -> f s
foldMapA1 x -> f s
f (x
y x -> [x] -> NonEmpty x
forall a. a -> [a] -> NonEmpty a
:| [x]
ys))

-- | Flipped version of 'foldMap1'.
reduce1 :: (Foldable1 t, Semigroup s) => t x -> (x -> s) -> s
reduce1 :: forall (t :: * -> *) s x.
(Foldable1 t, Semigroup s) =>
t x -> (x -> s) -> s
reduce1 = ((x -> s) -> t x -> s) -> t x -> (x -> s) -> s
forall a b c. (a -> b -> c) -> b -> a -> c
flip (x -> s) -> t x -> s
forall m a. Semigroup m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1

-- | Flipped version of 'foldMap'.
reduce :: (Foldable t, Monoid m) => t x -> (x -> m) -> m
reduce :: forall (t :: * -> *) m x.
(Foldable t, Monoid m) =>
t x -> (x -> m) -> m
reduce = ((x -> m) -> t x -> m) -> t x -> (x -> m) -> m
forall a b c. (a -> b -> c) -> b -> a -> c
flip (x -> m) -> t x -> m
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Fold.foldMap

-- | Flipped version of 'ifoldMap'.
ireduce :: (FoldableWithIndex i t, Monoid m) => t x -> (i -> x -> m) -> m
ireduce :: forall i (t :: * -> *) m x.
(FoldableWithIndex i t, Monoid m) =>
t x -> (i -> x -> m) -> m
ireduce = ((i -> x -> m) -> t x -> m) -> t x -> (i -> x -> m) -> m
forall a b c. (a -> b -> c) -> b -> a -> c
flip (i -> x -> m) -> t x -> m
forall m a. Monoid m => (i -> a -> m) -> t a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap

-- | A version of 'foldl'' taking the accumulator first, then the @Foldable@.
reduceL :: (Foldable t) => y -> t x -> (y -> x -> y) -> y
reduceL :: forall (t :: * -> *) y x.
Foldable t =>
y -> t x -> (y -> x -> y) -> y
reduceL = ((y -> x -> y) -> t x -> y) -> t x -> (y -> x -> y) -> y
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((y -> x -> y) -> t x -> y) -> t x -> (y -> x -> y) -> y)
-> (y -> (y -> x -> y) -> t x -> y)
-> y
-> t x
-> (y -> x -> y)
-> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((y -> x -> y) -> y -> t x -> y) -> y -> (y -> x -> y) -> t x -> y
forall a b c. (a -> b -> c) -> b -> a -> c
flip (y -> x -> y) -> y -> t x -> y
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Fold.foldl'

-- | A version of 'foldl1'' taking the accumulator first, then the @Foldable1@.
reduceL1 :: (Foldable1 t) => t x -> (x -> x -> x) -> x
reduceL1 :: forall (t :: * -> *) x. Foldable1 t => t x -> (x -> x -> x) -> x
reduceL1 = ((x -> x -> x) -> t x -> x) -> t x -> (x -> x -> x) -> x
forall a b c. (a -> b -> c) -> b -> a -> c
flip (x -> x -> x) -> t x -> x
forall (t :: * -> *) a. Foldable1 t => (a -> a -> a) -> t a -> a
foldl1'

-- | A version of 'foldr' taking the accumulator first, then the @Foldable@.
reduceR :: (Foldable t) => y -> t x -> (x -> y -> y) -> y
reduceR :: forall (t :: * -> *) y x.
Foldable t =>
y -> t x -> (x -> y -> y) -> y
reduceR = ((x -> y -> y) -> t x -> y) -> t x -> (x -> y -> y) -> y
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((x -> y -> y) -> t x -> y) -> t x -> (x -> y -> y) -> y)
-> (y -> (x -> y -> y) -> t x -> y)
-> y
-> t x
-> (x -> y -> y)
-> y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((x -> y -> y) -> y -> t x -> y) -> y -> (x -> y -> y) -> t x -> y
forall a b c. (a -> b -> c) -> b -> a -> c
flip (x -> y -> y) -> y -> t x -> y
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Fold.foldr

-- | A version of 'foldr1' taking the accumulator first, then the @Foldable@.
reduceR1 :: (Foldable1 t) => t x -> (x -> x -> x) -> x
reduceR1 :: forall (t :: * -> *) x. Foldable1 t => t x -> (x -> x -> x) -> x
reduceR1 = ((x -> x -> x) -> t x -> x) -> t x -> (x -> x -> x) -> x
forall a b c. (a -> b -> c) -> b -> a -> c
flip (x -> x -> x) -> t x -> x
forall a. (a -> a -> a) -> t a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
Fold.foldr1

-- | Flipped version of 'foldMapA'.
reduceA :: (Foldable t, Applicative f, Monoid m) => t x -> (x -> f m) -> f m
reduceA :: forall (t :: * -> *) (f :: * -> *) m x.
(Foldable t, Applicative f, Monoid m) =>
t x -> (x -> f m) -> f m
reduceA = ((x -> f m) -> t x -> f m) -> t x -> (x -> f m) -> f m
forall a b c. (a -> b -> c) -> b -> a -> c
flip (x -> f m) -> t x -> f m
forall (t :: * -> *) (f :: * -> *) m x.
(Foldable t, Applicative f, Monoid m) =>
(x -> f m) -> t x -> f m
foldMapA

-- | Flipped version of 'foldMapA'.
ireduceA ::
  (FoldableWithIndex i t, Applicative f, Monoid m) =>
  t x ->
  (i -> x -> f m) ->
  f m
ireduceA :: forall i (t :: * -> *) (f :: * -> *) m x.
(FoldableWithIndex i t, Applicative f, Monoid m) =>
t x -> (i -> x -> f m) -> f m
ireduceA = ((i -> x -> f m) -> t x -> f m) -> t x -> (i -> x -> f m) -> f m
forall a b c. (a -> b -> c) -> b -> a -> c
flip (i -> x -> f m) -> t x -> f m
forall i (t :: * -> *) (f :: * -> *) m x.
(FoldableWithIndex i t, Applicative f, Monoid m) =>
(i -> x -> f m) -> t x -> f m
ifoldMapA

-- | Flipped version of 'foldMapA1'.
reduceA1 ::
  (Foldable1 t, Applicative f, Semigroup s) => t x -> (x -> f s) -> f s
reduceA1 :: forall (t :: * -> *) (f :: * -> *) s x.
(Foldable1 t, Applicative f, Semigroup s) =>
t x -> (x -> f s) -> f s
reduceA1 = ((x -> f s) -> t x -> f s) -> t x -> (x -> f s) -> f s
forall a b c. (a -> b -> c) -> b -> a -> c
flip (x -> f s) -> t x -> f s
forall (t :: * -> *) (f :: * -> *) s x.
(Foldable1 t, Applicative f, Semigroup s) =>
(x -> f s) -> t x -> f s
foldMapA1

-- | Non-infix version of '(>>=)'.
bind :: (Monad f) => f x -> (x -> f y) -> f y
bind :: forall (f :: * -> *) x y. Monad f => f x -> (x -> f y) -> f y
bind = f x -> (x -> f y) -> f y
forall a b. f a -> (a -> f b) -> f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=)

-- | Indexed version of 'bind'.
ibind :: (FunctorWithIndex i f, Monad f) => f x -> (i -> x -> f y) -> f y
ibind :: forall i (f :: * -> *) x y.
(FunctorWithIndex i f, Monad f) =>
f x -> (i -> x -> f y) -> f y
ibind = (f (f y) -> f y
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join .) (((i -> x -> f y) -> f (f y)) -> (i -> x -> f y) -> f y)
-> (f x -> (i -> x -> f y) -> f (f y))
-> f x
-> (i -> x -> f y)
-> f y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> (i -> x -> f y) -> f (f y)
forall i (f :: * -> *) x y.
FunctorWithIndex i f =>
f x -> (i -> x -> y) -> f y
ichange

-- | A version of 'maybe' with the 'Maybe' argument first.
mabye :: Maybe x -> y -> (x -> y) -> y
mabye :: forall x y. Maybe x -> y -> (x -> y) -> y
mabye Maybe x
mx y
nothing x -> y
just = y -> (x -> y) -> Maybe x -> y
forall b a. b -> (a -> b) -> Maybe a -> b
maybe y
nothing x -> y
just Maybe x
mx

-- | Act on the empty or 'NonEmpty' cases of a regular list.
emptn :: [x] -> y -> (NonEmpty x -> y) -> y
emptn :: forall x y. [x] -> y -> (NonEmpty x -> y) -> y
emptn [x]
lx y
y NonEmpty x -> y
xy = case [x]
lx of [] -> y
y; (x
x : [x]
xs) -> NonEmpty x -> y
xy (x
x x -> [x] -> NonEmpty x
forall a. a -> [a] -> NonEmpty a
:| [x]
xs)

-- | Flipped version of 'filter'.
sift :: (Filterable t) => t x -> (x -> Bool) -> t x
sift :: forall (t :: * -> *) x. Filterable t => t x -> (x -> Bool) -> t x
sift = ((x -> Bool) -> t x -> t x) -> t x -> (x -> Bool) -> t x
forall a b c. (a -> b -> c) -> b -> a -> c
flip (x -> Bool) -> t x -> t x
forall a. (a -> Bool) -> t a -> t a
forall (f :: * -> *) a. Filterable f => (a -> Bool) -> f a -> f a
filter

-- | Flipped version of 'ifilter'.
isift :: (FilterableWithIndex i t) => t x -> (i -> x -> Bool) -> t x
isift :: forall i (t :: * -> *) x.
FilterableWithIndex i t =>
t x -> (i -> x -> Bool) -> t x
isift = ((i -> x -> Bool) -> t x -> t x) -> t x -> (i -> x -> Bool) -> t x
forall a b c. (a -> b -> c) -> b -> a -> c
flip (i -> x -> Bool) -> t x -> t x
forall a. (i -> a -> Bool) -> t a -> t a
forall i (t :: * -> *) a.
FilterableWithIndex i t =>
(i -> a -> Bool) -> t a -> t a
ifilter

-- | Flipped version of 'mapMaybe'.
changeMaybe :: (Filterable t) => t x -> (x -> Maybe y) -> t y
changeMaybe :: forall (t :: * -> *) x y.
Filterable t =>
t x -> (x -> Maybe y) -> t y
changeMaybe = ((x -> Maybe y) -> t x -> t y) -> t x -> (x -> Maybe y) -> t y
forall a b c. (a -> b -> c) -> b -> a -> c
flip (x -> Maybe y) -> t x -> t y
forall a b. (a -> Maybe b) -> t a -> t b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
Witherable.mapMaybe

-- | Flipped version of 'imapMaybe'.
ichangeMaybe :: (FilterableWithIndex i t) => t x -> (i -> x -> Maybe y) -> t y
ichangeMaybe :: forall i (t :: * -> *) x y.
FilterableWithIndex i t =>
t x -> (i -> x -> Maybe y) -> t y
ichangeMaybe = ((i -> x -> Maybe y) -> t x -> t y)
-> t x -> (i -> x -> Maybe y) -> t y
forall a b c. (a -> b -> c) -> b -> a -> c
flip (i -> x -> Maybe y) -> t x -> t y
forall a b. (i -> a -> Maybe b) -> t a -> t b
forall i (t :: * -> *) a b.
FilterableWithIndex i t =>
(i -> a -> Maybe b) -> t a -> t b
imapMaybe

-- | Flipped version of 'filterA'.
siftA :: (Applicative f, Witherable t) => t x -> (x -> f Bool) -> f (t x)
siftA :: forall (f :: * -> *) (t :: * -> *) x.
(Applicative f, Witherable t) =>
t x -> (x -> f Bool) -> f (t x)
siftA = ((x -> f Bool) -> t x -> f (t x))
-> t x -> (x -> f Bool) -> f (t x)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (x -> f Bool) -> t x -> f (t x)
forall (t :: * -> *) (f :: * -> *) a.
(Witherable t, Applicative f) =>
(a -> f Bool) -> t a -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
(a -> f Bool) -> t a -> f (t a)
filterA

-- | Flipped version of 'ifilterA'.
isiftA ::
  (Applicative f, WitherableWithIndex i t) =>
  (t x -> (i -> x -> f Bool) -> f (t x))
isiftA :: forall (f :: * -> *) i (t :: * -> *) x.
(Applicative f, WitherableWithIndex i t) =>
t x -> (i -> x -> f Bool) -> f (t x)
isiftA = ((i -> x -> f Bool) -> t x -> f (t x))
-> t x -> (i -> x -> f Bool) -> f (t x)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (i -> x -> f Bool) -> t x -> f (t x)
forall i (t :: * -> *) (f :: * -> *) a.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f Bool) -> t a -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
(i -> a -> f Bool) -> t a -> f (t a)
ifilterA

-- | Flipped version of 'iwither'.
iforMaybe ::
  (Applicative f, WitherableWithIndex i t) =>
  (t x -> (i -> x -> f (Maybe y)) -> f (t y))
iforMaybe :: forall (f :: * -> *) i (t :: * -> *) x y.
(Applicative f, WitherableWithIndex i t) =>
t x -> (i -> x -> f (Maybe y)) -> f (t y)
iforMaybe = ((i -> x -> f (Maybe y)) -> t x -> f (t y))
-> t x -> (i -> x -> f (Maybe y)) -> f (t y)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (i -> x -> f (Maybe y)) -> t x -> f (t y)
forall i (t :: * -> *) (f :: * -> *) a b.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f (Maybe b)) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(i -> a -> f (Maybe b)) -> t a -> f (t b)
iwither