{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Trustworthy #-}

-- |
-- Module      :   Grisette.Lib.Control.Foldable
-- Copyright   :   (c) Sirui Lu 2021-2023
-- License     :   BSD-3-Clause (see the LICENSE file)
--
-- Maintainer  :   siruilu@cs.washington.edu
-- Stability   :   Experimental
-- Portability :   GHC only
module Grisette.Lib.Data.Foldable
  ( -- * mrg* variants for operations in "Data.Foldable"
    mrgFoldlM,
    mrgFoldrM,
    mrgTraverse_,
    mrgFor_,
    mrgMapM_,
    mrgForM_,
    mrgSequence_,
    mrgMsum,
  )
where

import Control.Monad
import Grisette.Core.Control.Monad.Union
import Grisette.Core.Data.Class.Bool
import Grisette.Core.Data.Class.Mergeable
import Grisette.Core.Data.Class.SimpleMergeable
import {-# SOURCE #-} Grisette.Lib.Control.Monad

-- | 'Data.Foldable.foldlM' with 'MergingStrategy' knowledge propagation.
mrgFoldlM :: (MonadUnion m, Mergeable b, Foldable t) => (b -> a -> m b) -> b -> t a -> m b
mrgFoldlM :: forall (m :: * -> *) b (t :: * -> *) a.
(MonadUnion m, Mergeable b, Foldable t) =>
(b -> a -> m b) -> b -> t a -> m b
mrgFoldlM b -> a -> m b
f b
z0 t a
xs = (a -> (b -> m b) -> b -> m b) -> (b -> m b) -> t a -> b -> m b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (b -> m b) -> b -> m b
forall {b}. a -> (b -> m b) -> b -> m b
c b -> m b
forall (u :: * -> *) a. (MonadUnion u, Mergeable a) => a -> u a
mrgReturn t a
xs b
z0
  where
    c :: a -> (b -> m b) -> b -> m b
c a
x b -> m b
k b
z = m b -> m b
forall (u :: * -> *) a. (UnionLike u, Mergeable a) => u a -> u a
merge (b -> a -> m b
f b
z a
x) m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m b
k
{-# INLINE mrgFoldlM #-}

-- | 'Data.Foldable.foldrM' with 'MergingStrategy' knowledge propagation.
mrgFoldrM :: (MonadUnion m, Mergeable b, Foldable t) => (a -> b -> m b) -> b -> t a -> m b
mrgFoldrM :: forall (m :: * -> *) b (t :: * -> *) a.
(MonadUnion m, Mergeable b, Foldable t) =>
(a -> b -> m b) -> b -> t a -> m b
mrgFoldrM a -> b -> m b
f b
z0 t a
xs = ((b -> m b) -> a -> b -> m b) -> (b -> m b) -> t a -> b -> m b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (b -> m b) -> a -> b -> m b
forall {b}. (b -> m b) -> a -> b -> m b
c b -> m b
forall (u :: * -> *) a. (MonadUnion u, Mergeable a) => a -> u a
mrgReturn t a
xs b
z0
  where
    c :: (b -> m b) -> a -> b -> m b
c b -> m b
k a
x b
z = m b -> m b
forall (u :: * -> *) a. (UnionLike u, Mergeable a) => u a -> u a
merge (a -> b -> m b
f a
x b
z) m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m b
k
{-# INLINE mrgFoldrM #-}

-- | 'Data.Foldable.traverse_' with 'MergingStrategy' knowledge propagation.
mrgTraverse_ :: (MonadUnion m, Foldable t) => (a -> m b) -> t a -> m ()
mrgTraverse_ :: forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnion m, Foldable t) =>
(a -> m b) -> t a -> m ()
mrgTraverse_ a -> m b
f = (a -> m () -> m ()) -> m () -> t a -> m ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> m () -> m ()
forall {b}. a -> m b -> m b
c (() -> m ()
forall (u :: * -> *) a. (MonadUnion u, Mergeable a) => a -> u a
mrgReturn ())
  where
    c :: a -> m b -> m b
c a
x m b
k = a -> m b
f a
x m b -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m b
k
{-# INLINE mrgTraverse_ #-}

-- | 'Data.Foldable.for_' with 'MergingStrategy' knowledge propagation.
mrgFor_ :: (MonadUnion m, Foldable t) => t a -> (a -> m b) -> m ()
mrgFor_ :: forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnion m, Foldable t) =>
t a -> (a -> m b) -> m ()
mrgFor_ = ((a -> m b) -> t a -> m ()) -> t a -> (a -> m b) -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m b) -> t a -> m ()
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnion m, Foldable t) =>
(a -> m b) -> t a -> m ()
mrgTraverse_
{-# INLINE mrgFor_ #-}

-- | 'Data.Foldable.mapM_' with 'MergingStrategy' knowledge propagation.
mrgMapM_ :: (MonadUnion m, Foldable t) => (a -> m b) -> t a -> m ()
mrgMapM_ :: forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnion m, Foldable t) =>
(a -> m b) -> t a -> m ()
mrgMapM_ = (a -> m b) -> t a -> m ()
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnion m, Foldable t) =>
(a -> m b) -> t a -> m ()
mrgTraverse_
{-# INLINE mrgMapM_ #-}

-- | 'Data.Foldable.forM_' with 'MergingStrategy' knowledge propagation.
mrgForM_ :: (MonadUnion m, Foldable t) => t a -> (a -> m b) -> m ()
mrgForM_ :: forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnion m, Foldable t) =>
t a -> (a -> m b) -> m ()
mrgForM_ = ((a -> m b) -> t a -> m ()) -> t a -> (a -> m b) -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m b) -> t a -> m ()
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnion m, Foldable t) =>
(a -> m b) -> t a -> m ()
mrgMapM_
{-# INLINE mrgForM_ #-}

-- | 'Data.Foldable.sequence_' with 'MergingStrategy' knowledge propagation.
mrgSequence_ :: (Foldable t, MonadUnion m) => t (m a) -> m ()
mrgSequence_ :: forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadUnion m) =>
t (m a) -> m ()
mrgSequence_ = (m a -> m () -> m ()) -> m () -> t (m a) -> m ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr m a -> m () -> m ()
forall {m :: * -> *} {a} {b}. Monad m => m a -> m b -> m b
c (() -> m ()
forall (u :: * -> *) a. (MonadUnion u, Mergeable a) => a -> u a
mrgReturn ())
  where
    c :: m a -> m b -> m b
c m a
m m b
k = m a
m m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m b
k
{-# INLINE mrgSequence_ #-}

-- | 'Data.Foldable.msum' with 'MergingStrategy' knowledge propagation.
mrgMsum :: forall m a t. (MonadUnion m, Mergeable a, MonadPlus m, Foldable t) => t (m a) -> m a
mrgMsum :: forall (m :: * -> *) a (t :: * -> *).
(MonadUnion m, Mergeable a, MonadPlus m, Foldable t) =>
t (m a) -> m a
mrgMsum = (m a -> m a -> m a) -> m a -> t (m a) -> m a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr m a -> m a -> m a
forall (m :: * -> *) a.
(MonadUnion m, Mergeable a, MonadPlus m) =>
m a -> m a -> m a
mrgMplus m a
forall (m :: * -> *) a.
(MonadUnion m, Mergeable a, MonadPlus m) =>
m a
mrgMzero
{-# INLINE mrgMsum #-}