{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
-- | The functions in "Data.MonoTraversable" are all prefixed with the letter
-- @o@ to avoid conflicts with their polymorphic counterparts. This module
-- exports the same identifiers without the prefix, for all cases where the
-- monomorphic variant loses no generality versus the polymorphic version. For
-- example, 'olength' is just as general as @Data.Foldable.length@, so we
-- export @length = length@. By contrast, 'omap' cannot fully subsume @fmap@ or
-- @map@, so we do not provide such an export.
--
-- @since 1.0.0
module Data.MonoTraversable.Unprefixed where

import Data.Int (Int64)
import Data.MonoTraversable
import Data.Monoid (Monoid)
import Control.Applicative (Applicative)

-- | Synonym for 'ofoldMap'
--
-- @since 1.0.0
foldMap :: (MonoFoldable mono, Data.Monoid.Monoid m) => (Element mono -> m) -> mono -> m
foldMap :: (Element mono -> m) -> mono -> m
foldMap = (Element mono -> m) -> mono -> m
forall mono m.
(MonoFoldable mono, Monoid m) =>
(Element mono -> m) -> mono -> m
ofoldMap

-- | Synonym for 'ofoldr'
--
-- @since 1.0.0
foldr :: MonoFoldable mono => (Element mono -> b -> b) -> b -> mono -> b
foldr :: (Element mono -> b -> b) -> b -> mono -> b
foldr = (Element mono -> b -> b) -> b -> mono -> b
forall mono b.
MonoFoldable mono =>
(Element mono -> b -> b) -> b -> mono -> b
ofoldr

-- | Synonym for 'ofoldl''
--
-- @since 1.0.0
foldl' :: MonoFoldable mono => (a -> Element mono -> a) -> a -> mono -> a
foldl' :: (a -> Element mono -> a) -> a -> mono -> a
foldl' = (a -> Element mono -> a) -> a -> mono -> a
forall mono a.
MonoFoldable mono =>
(a -> Element mono -> a) -> a -> mono -> a
ofoldl'

-- | Synonym for 'otoList'
--
-- @since 1.0.0
toList :: MonoFoldable mono => mono -> [Element mono]
toList :: mono -> [Element mono]
toList = mono -> [Element mono]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList

-- | Synonym for 'oall'
--
-- @since 1.0.0
all :: MonoFoldable mono => (Element mono -> Bool) -> mono -> Bool
all :: (Element mono -> Bool) -> mono -> Bool
all = (Element mono -> Bool) -> mono -> Bool
forall mono.
MonoFoldable mono =>
(Element mono -> Bool) -> mono -> Bool
oall

-- | Synonym for 'oany'
--
-- @since 1.0.0
any :: MonoFoldable mono => (Element mono -> Bool) -> mono -> Bool
any :: (Element mono -> Bool) -> mono -> Bool
any = (Element mono -> Bool) -> mono -> Bool
forall mono.
MonoFoldable mono =>
(Element mono -> Bool) -> mono -> Bool
oany

-- | Synonym for 'onull'
--
-- @since 1.0.0
null :: MonoFoldable mono => mono -> Bool
null :: mono -> Bool
null = mono -> Bool
forall mono. MonoFoldable mono => mono -> Bool
onull

-- | Synonym for 'olength'
--
-- @since 1.0.0
length :: MonoFoldable mono => mono -> Int
length :: mono -> Int
length = mono -> Int
forall mono. MonoFoldable mono => mono -> Int
olength

-- | Synonym for 'olength64'
--
-- @since 1.0.0
length64 :: MonoFoldable mono => mono -> Int64
length64 :: mono -> Int64
length64 = mono -> Int64
forall mono. MonoFoldable mono => mono -> Int64
olength64

-- | Synonym for 'ocompareLength'
--
-- @since 1.0.0
compareLength :: (MonoFoldable mono, Integral i) => mono -> i -> Ordering
compareLength :: mono -> i -> Ordering
compareLength = mono -> i -> Ordering
forall mono i.
(MonoFoldable mono, Integral i) =>
mono -> i -> Ordering
ocompareLength

-- | Synonym for 'otraverse_'
--
-- @since 1.0.0
traverse_ :: (MonoFoldable mono, Control.Applicative.Applicative f) => (Element mono -> f b) -> mono -> f ()
traverse_ :: (Element mono -> f b) -> mono -> f ()
traverse_ = (Element mono -> f b) -> mono -> f ()
forall mono (f :: * -> *) b.
(MonoFoldable mono, Applicative f) =>
(Element mono -> f b) -> mono -> f ()
otraverse_

-- | Synonym for 'ofor_'
--
-- @since 1.0.0
for_ :: (MonoFoldable mono, Applicative f) => mono -> (Element mono -> f b) -> f ()
for_ :: mono -> (Element mono -> f b) -> f ()
for_ = mono -> (Element mono -> f b) -> f ()
forall mono (f :: * -> *) b.
(MonoFoldable mono, Applicative f) =>
mono -> (Element mono -> f b) -> f ()
ofor_

-- | Synonym for 'omapM_'
--
-- @since 1.0.0
mapM_ :: (MonoFoldable mono, Applicative m)
      => (Element mono -> m ()) -> mono -> m ()
mapM_ :: (Element mono -> m ()) -> mono -> m ()
mapM_ = (Element mono -> m ()) -> mono -> m ()
forall mono (m :: * -> *).
(MonoFoldable mono, Applicative m) =>
(Element mono -> m ()) -> mono -> m ()
omapM_

-- | Synonym for 'oforM_'
--
-- @since 1.0.0
forM_ :: (MonoFoldable mono, Applicative m)
      => mono -> (Element mono -> m ()) -> m ()
forM_ :: mono -> (Element mono -> m ()) -> m ()
forM_ = mono -> (Element mono -> m ()) -> m ()
forall mono (m :: * -> *).
(MonoFoldable mono, Applicative m) =>
mono -> (Element mono -> m ()) -> m ()
oforM_

-- | Synonym for 'ofoldlM'
--
-- @since 1.0.0
foldlM :: (MonoFoldable mono, Monad m)
       => (a -> Element mono -> m a)
       -> a
       -> mono
       -> m a
foldlM :: (a -> Element mono -> m a) -> a -> mono -> m a
foldlM = (a -> Element mono -> m a) -> a -> mono -> m a
forall mono (m :: * -> *) a.
(MonoFoldable mono, Monad m) =>
(a -> Element mono -> m a) -> a -> mono -> m a
ofoldlM

-- | Synonym for 'ofoldMap1Ex'
--
-- @since 1.0.0
foldMap1Ex :: (MonoFoldable mono, Semigroup m)
           => (Element mono -> m)
           -> mono
           -> m
foldMap1Ex :: (Element mono -> m) -> mono -> m
foldMap1Ex = (Element mono -> m) -> mono -> m
forall mono m.
(MonoFoldable mono, Semigroup m) =>
(Element mono -> m) -> mono -> m
ofoldMap1Ex

-- | Synonym for 'ofoldr1Ex'
--
-- @since 1.0.0
foldr1Ex :: MonoFoldable mono
         => (Element mono -> Element mono -> Element mono)
         -> mono
         -> Element mono
foldr1Ex :: (Element mono -> Element mono -> Element mono)
-> mono -> Element mono
foldr1Ex = (Element mono -> Element mono -> Element mono)
-> mono -> Element mono
forall mono.
MonoFoldable mono =>
(Element mono -> Element mono -> Element mono)
-> mono -> Element mono
ofoldr1Ex

-- | Synonym for 'ofoldl1Ex''
--
-- @since 1.0.0
foldl1Ex' :: MonoFoldable mono
          => (Element mono -> Element mono -> Element mono)
          -> mono
          -> Element mono
foldl1Ex' :: (Element mono -> Element mono -> Element mono)
-> mono -> Element mono
foldl1Ex' = (Element mono -> Element mono -> Element mono)
-> mono -> Element mono
forall mono.
MonoFoldable mono =>
(Element mono -> Element mono -> Element mono)
-> mono -> Element mono
ofoldl1Ex'

-- | Synonym for 'osum'
--
-- @since 1.0.0
sum :: (MonoFoldable mono, Num (Element mono)) => mono -> Element mono
sum :: mono -> Element mono
sum = mono -> Element mono
forall mono.
(MonoFoldable mono, Num (Element mono)) =>
mono -> Element mono
osum

-- | Synonym for 'oproduct'
--
-- @since 1.0.0
product :: (MonoFoldable mono, Num (Element mono)) => mono -> Element mono
product :: mono -> Element mono
product = mono -> Element mono
forall mono.
(MonoFoldable mono, Num (Element mono)) =>
mono -> Element mono
oproduct

-- | Synonym for 'oand'
--
-- @since 1.0.0
and :: (MonoFoldable mono, Element mono ~ Bool) => mono -> Bool
and :: mono -> Bool
and = mono -> Bool
forall mono.
(Element mono ~ Bool, MonoFoldable mono) =>
mono -> Bool
oand

-- | Synonym for 'oor'
--
-- @since 1.0.0
or :: (MonoFoldable mono, Element mono ~ Bool) => mono -> Bool
or :: mono -> Bool
or = mono -> Bool
forall mono.
(Element mono ~ Bool, MonoFoldable mono) =>
mono -> Bool
oor

-- | Synonym for 'oconcatMap'
--
-- @since 1.0.0
concatMap :: (MonoFoldable mono, Monoid m) => (Element mono -> m) -> mono -> m
concatMap :: (Element mono -> m) -> mono -> m
concatMap = (Element mono -> m) -> mono -> m
forall mono m.
(MonoFoldable mono, Monoid m) =>
(Element mono -> m) -> mono -> m
oconcatMap

-- | Synonym for 'oelem'
--
-- @since 1.0.0
elem :: (MonoFoldable mono, Eq (Element mono)) => Element mono -> mono -> Bool
elem :: Element mono -> mono -> Bool
elem = Element mono -> mono -> Bool
forall mono.
(MonoFoldable mono, Eq (Element mono)) =>
Element mono -> mono -> Bool
oelem

-- | Synonym for 'onotElem'
--
-- @since 1.0.0
notElem :: (MonoFoldable mono, Eq (Element mono)) => Element mono -> mono -> Bool
notElem :: Element mono -> mono -> Bool
notElem = Element mono -> mono -> Bool
forall mono.
(MonoFoldable mono, Eq (Element mono)) =>
Element mono -> mono -> Bool
onotElem

-- | Synonym for 'opoint'
--
-- @since 1.0.0
point :: MonoPointed mono => Element mono -> mono
point :: Element mono -> mono
point = Element mono -> mono
forall mono. MonoPointed mono => Element mono -> mono
opoint

-- | Synonym for 'ointercalate'
--
-- @since 1.0.0
intercalate :: (MonoFoldable mono, Monoid (Element mono))
            => Element mono -> mono -> Element mono
intercalate :: Element mono -> mono -> Element mono
intercalate = Element mono -> mono -> Element mono
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
Element mono -> mono -> Element mono
ointercalate

-- | Synonym for 'ofold'
--
-- @since 1.0.0
fold :: (MonoFoldable mono, Monoid (Element mono)) => mono -> Element mono
fold :: mono -> Element mono
fold = mono -> Element mono
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
ofold

-- | Synonym for 'oconcat'
--
-- @since 1.0.0
concat :: (MonoFoldable mono, Monoid (Element mono)) => mono -> Element mono
concat :: mono -> Element mono
concat = mono -> Element mono
forall mono.
(MonoFoldable mono, Monoid (Element mono)) =>
mono -> Element mono
oconcat

-- | Synonym for 'ofoldM'
--
-- @since 1.0.0
foldM :: (MonoFoldable mono, Monad m) => (a -> Element mono -> m a) -> a -> mono -> m a
foldM :: (a -> Element mono -> m a) -> a -> mono -> m a
foldM = (a -> Element mono -> m a) -> a -> mono -> m a
forall mono (m :: * -> *) a.
(MonoFoldable mono, Monad m) =>
(a -> Element mono -> m a) -> a -> mono -> m a
ofoldM

-- | Synonym for 'osequence_'
--
-- @since 1.0.0
sequence_ :: (Applicative m, MonoFoldable mono, Element mono ~ (m ())) => mono -> m ()
sequence_ :: mono -> m ()
sequence_ = mono -> m ()
forall (m :: * -> *) mono.
(Applicative m, MonoFoldable mono, Element mono ~ m ()) =>
mono -> m ()
osequence_