{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 710
{-# LANGUAGE Trustworthy #-}
#endif

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Generator.Combinators
-- Copyright   :  (c) Edward Kmett 2009
-- License     :  BSD-style
-- Maintainer  :  ekmett@gmail.com
-- Stability   :  experimental
-- Portability :  non-portable (type families, MPTCs)
--
-- Utilities for working with Monoids that conflict with names from the "Prelude",
-- "Data.Foldable", "Control.Monad" or elsewhere. Intended to be imported qualified.
--
-- > import Data.Generator.Combinators as Generator
--
-----------------------------------------------------------------------------

module Data.Generator.Combinators
    (
    -- * Monadic Reduction
      mapM_
    , forM_
    , msum
    -- * Applicative Reduction
    , traverse_
    , for_
    , asum
    -- * Logical Reduction
    , and
    , or
    , any
    , all
    -- * Monoidal Reduction
    , foldMap
    , fold
    , toList
    -- * List-Like Reduction
    , concatMap
    , elem
    , filter
    , filterWith
    --, find
    , sum
    , product
    , notElem
    ) where

import Prelude hiding
  ( mapM_, any, all, elem, filter, concatMap, and, or
  , sum, product, notElem, replicate, cycle, repeat
#if __GLASGOW_HASKELL__ >= 710
  , foldMap
#endif
  )
import Control.Applicative (Alternative)
import Control.Monad (MonadPlus)
import Data.Generator
import Data.Semigroup (Sum(..), Product(..), All(..), Any(..), WrappedMonoid(..))
import Data.Semigroup.Applicative (Traversal(..))
import Data.Semigroup.Alternative (Alternate(..))
import Data.Semigroup.Monad (Action(..))
import Data.Semigroup.MonadPlus (MonadSum(..))
import Data.Semigroup.Reducer (Reducer(..))

#if !(MIN_VERSION_base(4,8,0))
import Control.Applicative (Applicative)
import Data.Monoid (Monoid(..))
#endif

-- | Efficiently 'mapReduce' a 'Generator' using the 'Traversal' monoid. A specialized version of its namesake from "Data.Foldable"
--
-- @
--     'mapReduce' 'getTraversal'
-- @
traverse_ :: (Generator c, Applicative f) => (Elem c -> f b) -> c -> f ()
traverse_ :: (Elem c -> f b) -> c -> f ()
traverse_ = (Traversal f -> f ()) -> (Elem c -> f b) -> c -> f ()
forall c e m n.
(Generator c, Reducer e m, Monoid m) =>
(m -> n) -> (Elem c -> e) -> c -> n
mapReduceWith Traversal f -> f ()
forall (f :: * -> *). Traversal f -> f ()
getTraversal
{-# INLINE traverse_ #-}

-- | Convenience function as found in "Data.Foldable"
--
-- @
--     'flip' 'traverse_'
-- @
for_ :: (Generator c, Applicative f) => c -> (Elem c -> f b) -> f ()
for_ :: c -> (Elem c -> f b) -> f ()
for_ = ((Elem c -> f b) -> c -> f ()) -> c -> (Elem c -> f b) -> f ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Elem c -> f b) -> c -> f ()
forall c (f :: * -> *) b.
(Generator c, Applicative f) =>
(Elem c -> f b) -> c -> f ()
traverse_
{-# INLINE for_ #-}

-- | The sum of a collection of actions, generalizing 'concat'
--
-- @
--    'reduceWith' 'getAlt'
-- @
asum :: (Generator c, Alternative f, f a ~ Elem c) => c -> f a
asum :: c -> f a
asum = (Alternate f a -> f a) -> c -> f a
forall c m n.
(Generator c, Reducer (Elem c) m, Monoid m) =>
(m -> n) -> c -> n
reduceWith Alternate f a -> f a
forall (f :: * -> *) a. Alternate f a -> f a
getAlternate
{-# INLINE asum #-}

-- | Efficiently 'mapReduce' a 'Generator' using the 'Action' monoid. A specialized version of its namesake from "Data.Foldable" and "Control.Monad"
--
-- @
--    'mapReduceWith' 'getAction'
-- @
mapM_ :: (Generator c, Monad m) => (Elem c -> m b) -> c -> m ()
mapM_ :: (Elem c -> m b) -> c -> m ()
mapM_ = (Action m -> m ()) -> (Elem c -> m b) -> c -> m ()
forall c e m n.
(Generator c, Reducer e m, Monoid m) =>
(m -> n) -> (Elem c -> e) -> c -> n
mapReduceWith Action m -> m ()
forall (f :: * -> *). Action f -> f ()
getAction
{-# INLINE mapM_ #-}

-- | Convenience function as found in "Data.Foldable" and "Control.Monad"
--
-- @
--     'flip' 'mapM_'
-- @
forM_ :: (Generator c, Monad m) => c -> (Elem c -> m b) -> m ()
forM_ :: c -> (Elem c -> m b) -> m ()
forM_ = ((Elem c -> m b) -> c -> m ()) -> c -> (Elem c -> m b) -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Elem c -> m b) -> c -> m ()
forall c (m :: * -> *) b.
(Generator c, Monad m) =>
(Elem c -> m b) -> c -> m ()
mapM_
{-# INLINE forM_ #-}

-- | The sum of a collection of actions, generalizing 'concat'
--
-- @
--     'reduceWith' 'getMonadSum'
-- @
msum :: (Generator c, MonadPlus m, m a ~ Elem c) => c -> m a
msum :: c -> m a
msum = (MonadSum m a -> m a) -> c -> m a
forall c m n.
(Generator c, Reducer (Elem c) m, Monoid m) =>
(m -> n) -> c -> n
reduceWith MonadSum m a -> m a
forall (f :: * -> *) a. MonadSum f a -> f a
getMonadSum
{-# INLINE msum #-}

-- | Efficiently 'mapReduce' a 'Generator' using the 'WrappedMonoid' monoid. A specialized version of its namesake from "Data.Foldable"
--
-- @
--     'mapReduceWith' 'unwrapMonoid'
-- @
foldMap :: (Monoid m, Generator c) => (Elem c -> m) -> c -> m
foldMap :: (Elem c -> m) -> c -> m
foldMap = (WrappedMonoid m -> m) -> (Elem c -> m) -> c -> m
forall c e m n.
(Generator c, Reducer e m, Monoid m) =>
(m -> n) -> (Elem c -> e) -> c -> n
mapReduceWith WrappedMonoid m -> m
forall m. WrappedMonoid m -> m
unwrapMonoid
{-# INLINE foldMap #-}

-- | Type specialization of "foldMap" above
concatMap :: Generator c => (Elem c -> [b]) -> c -> [b]
concatMap :: (Elem c -> [b]) -> c -> [b]
concatMap = (Elem c -> [b]) -> c -> [b]
forall m c. (Monoid m, Generator c) => (Elem c -> m) -> c -> m
foldMap
{-# INLINE concatMap #-}

-- | Efficiently 'reduce' a 'Generator' using the 'WrappedMonoid' monoid. A specialized version of its namesake from "Data.Foldable"
--
-- @
--     'reduceWith' 'unwrapMonoid'
-- @
fold :: (Monoid m, Generator c, Elem c ~ m) => c -> m
fold :: c -> m
fold = (WrappedMonoid m -> m) -> c -> m
forall c m n.
(Generator c, Reducer (Elem c) m, Monoid m) =>
(m -> n) -> c -> n
reduceWith WrappedMonoid m -> m
forall m. WrappedMonoid m -> m
unwrapMonoid
{-# INLINE fold #-}

-- | Convert any 'Generator' to a list of its contents. Specialization of 'reduce'
toList :: Generator c => c -> [Elem c]
toList :: c -> [Elem c]
toList = c -> [Elem c]
forall c m. (Generator c, Reducer (Elem c) m, Monoid m) => c -> m
reduce
{-# INLINE toList #-}

-- | Efficiently 'reduce' a 'Generator' that contains values of type 'Bool'
--
-- @
--     'reduceWith' 'getAll'
-- @
and :: (Generator c, Elem c ~ Bool) => c -> Bool
and :: c -> Bool
and = (All -> Bool) -> c -> Bool
forall c m n.
(Generator c, Reducer (Elem c) m, Monoid m) =>
(m -> n) -> c -> n
reduceWith All -> Bool
getAll
{-# INLINE and #-}

-- | Efficiently 'reduce' a 'Generator' that contains values of type 'Bool'
--
-- @
--     'reduceWith' 'getAny'
-- @
or :: (Generator c, Elem c ~ Bool) => c -> Bool
or :: c -> Bool
or = (Any -> Bool) -> c -> Bool
forall c m n.
(Generator c, Reducer (Elem c) m, Monoid m) =>
(m -> n) -> c -> n
reduceWith Any -> Bool
getAny
{-# INLINE or #-}

-- | Efficiently 'mapReduce' any 'Generator' checking to see if any of its values match the supplied predicate
--
-- @
--     'mapReduceWith' 'getAny'
-- @
any :: Generator c => (Elem c -> Bool) -> c -> Bool
any :: (Elem c -> Bool) -> c -> Bool
any = (Any -> Bool) -> (Elem c -> Bool) -> c -> Bool
forall c e m n.
(Generator c, Reducer e m, Monoid m) =>
(m -> n) -> (Elem c -> e) -> c -> n
mapReduceWith Any -> Bool
getAny
{-# INLINE any #-}

-- | Efficiently 'mapReduce' any 'Generator' checking to see if all of its values match the supplied predicate
--
-- @
--     'mapReduceWith' 'getAll'
-- @
all :: Generator c => (Elem c -> Bool) -> c -> Bool
all :: (Elem c -> Bool) -> c -> Bool
all = (All -> Bool) -> (Elem c -> Bool) -> c -> Bool
forall c e m n.
(Generator c, Reducer e m, Monoid m) =>
(m -> n) -> (Elem c -> e) -> c -> n
mapReduceWith All -> Bool
getAll
{-# INLINE all #-}

-- | Efficiently sum over the members of any 'Generator'
--
-- @
--     'reduceWith' 'getSum'
-- @
sum :: (Generator c, Num (Elem c)) => c -> Elem c
sum :: c -> Elem c
sum = (Sum (Elem c) -> Elem c) -> c -> Elem c
forall c m n.
(Generator c, Reducer (Elem c) m, Monoid m) =>
(m -> n) -> c -> n
reduceWith Sum (Elem c) -> Elem c
forall a. Sum a -> a
getSum
{-# INLINE sum #-}

-- | Efficiently take the product of every member of a 'Generator'
--
-- @
--     'reduceWith' 'getProduct'
-- @
product :: (Generator c, Num (Elem c)) => c -> Elem c
product :: c -> Elem c
product = (Product (Elem c) -> Elem c) -> c -> Elem c
forall c m n.
(Generator c, Reducer (Elem c) m, Monoid m) =>
(m -> n) -> c -> n
reduceWith Product (Elem c) -> Elem c
forall a. Product a -> a
getProduct
{-# INLINE product #-}

-- | Check to see if 'any' member of the 'Generator' matches the supplied value
elem :: (Generator c, Eq (Elem c)) => Elem c -> c -> Bool
elem :: Elem c -> c -> Bool
elem = (Elem c -> Bool) -> c -> Bool
forall c. Generator c => (Elem c -> Bool) -> c -> Bool
any ((Elem c -> Bool) -> c -> Bool)
-> (Elem c -> Elem c -> Bool) -> Elem c -> c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Elem c -> Elem c -> Bool
forall a. Eq a => a -> a -> Bool
(==)
{-# INLINE elem #-}

-- | Check to make sure that the supplied value is not a member of the 'Generator'
notElem :: (Generator c, Eq (Elem c)) => Elem c -> c -> Bool
notElem :: Elem c -> c -> Bool
notElem Elem c
x = Bool -> Bool
not (Bool -> Bool) -> (c -> Bool) -> c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Elem c -> c -> Bool
forall c. (Generator c, Eq (Elem c)) => Elem c -> c -> Bool
elem Elem c
x
{-# INLINE notElem #-}

-- | Efficiently 'mapReduce' a subset of the elements in a 'Generator'
filter :: (Generator c, Reducer (Elem c) m, Monoid m) => (Elem c -> Bool) -> c -> m
filter :: (Elem c -> Bool) -> c -> m
filter Elem c -> Bool
p = (Elem c -> m) -> c -> m
forall m c. (Monoid m, Generator c) => (Elem c -> m) -> c -> m
foldMap Elem c -> m
f where
    f :: Elem c -> m
f Elem c
x | Elem c -> Bool
p Elem c
x = Elem c -> m
forall c m. Reducer c m => c -> m
unit Elem c
x
        | Bool
otherwise = m
forall a. Monoid a => a
mempty
{-# INLINE filter #-}

-- | Allows idiomatic specialization of filter by proving a function that will be used to transform the output
filterWith :: (Generator c, Reducer (Elem c) m, Monoid m) => (m -> n) -> (Elem c -> Bool) -> c -> n
filterWith :: (m -> n) -> (Elem c -> Bool) -> c -> n
filterWith m -> n
f Elem c -> Bool
p = m -> n
f (m -> n) -> (c -> m) -> c -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Elem c -> Bool) -> c -> m
forall c m.
(Generator c, Reducer (Elem c) m, Monoid m) =>
(Elem c -> Bool) -> c -> m
filter Elem c -> Bool
p
{-# INLINE filterWith #-}

{-

-- | A specialization of 'filter' using the 'First' 'Monoid', analogous to 'Data.List.find'
--
-- @
--     'filterWith' 'getFirst'
-- @
find :: Generator c => (Elem c -> Bool) -> c -> Maybe (Elem c)
find = filterWith getFirst
{-# INLINE find #-}

-}