module Data.MonoTraversable where
import Control.Applicative
import Control.Category
import Control.Monad (Monad (..), liftM)
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Data.Foldable as F
import Data.Functor
import Data.Maybe (fromMaybe)
import Data.Monoid (Monoid (..), Any (..), All (..))
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Traversable
import Data.Traversable.Instances ()
import Data.Word (Word8)
import Data.Int (Int, Int64)
import GHC.Exts (build)
import Prelude (Bool (..), const, Char, flip, IO, Maybe (..), Either (..),
(+), Integral, Ordering (..), compare, fromIntegral, Num, (>=),
seq, otherwise, Eq, Ord, (), (*))
import qualified Prelude
import qualified Data.ByteString.Internal as Unsafe
import qualified Foreign.ForeignPtr.Unsafe as Unsafe
import Foreign.Ptr (plusPtr)
import Foreign.ForeignPtr (touchForeignPtr)
import Foreign.Storable (peek)
import Control.Arrow (Arrow)
import Data.Tree (Tree (..))
import Data.Sequence (Seq, ViewL (..), ViewR (..))
import qualified Data.Sequence as Seq
import Data.IntMap (IntMap)
import Data.IntSet (IntSet)
import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty)
import Data.Functor.Identity (Identity)
import Data.Map (Map)
import Data.HashMap.Strict (HashMap)
import Data.Vector (Vector)
import Control.Monad.Trans.Maybe (MaybeT (..))
import Control.Monad.Trans.List (ListT)
import Control.Monad.Trans.Identity (IdentityT)
import Data.Functor.Apply (MaybeApply (..), WrappedApplicative)
import Control.Comonad (Cokleisli, Comonad, extract, extend)
import Control.Comonad.Store (StoreT)
import Control.Comonad.Env (EnvT)
import Control.Comonad.Traced (TracedT)
#if !MIN_VERSION_comonad(5,0,0)
import Data.Functor.Coproduct (Coproduct)
#endif
import Control.Monad.Trans.Writer (WriterT)
import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT)
import Control.Monad.Trans.State (StateT(..))
import qualified Control.Monad.Trans.State.Strict as Strict (StateT(..))
import Control.Monad.Trans.RWS (RWST(..))
import qualified Control.Monad.Trans.RWS.Strict as Strict (RWST(..))
import Control.Monad.Trans.Reader (ReaderT)
import Control.Monad.Trans.Error (ErrorT(..))
import Control.Monad.Trans.Cont (ContT)
import Data.Functor.Compose (Compose)
import Data.Functor.Product (Product)
import Data.Semigroupoid.Static (Static)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.Hashable (Hashable)
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Storable as VS
import qualified Data.IntSet as IntSet
import Data.Semigroup (Semigroup, Option (..), Arg)
import qualified Data.ByteString.Unsafe as SU
import Data.DList (DList)
import qualified Data.DList as DL
type family Element mono
type instance Element S.ByteString = Word8
type instance Element L.ByteString = Word8
type instance Element T.Text = Char
type instance Element TL.Text = Char
type instance Element [a] = a
type instance Element (IO a) = a
type instance Element (ZipList a) = a
type instance Element (Maybe a) = a
type instance Element (Tree a) = a
type instance Element (Seq a) = a
type instance Element (DList a) = a
type instance Element (ViewL a) = a
type instance Element (ViewR a) = a
type instance Element (IntMap a) = a
type instance Element IntSet = Int
type instance Element (Option a) = a
type instance Element (NonEmpty a) = a
type instance Element (Identity a) = a
type instance Element (r -> a) = a
type instance Element (Either a b) = b
type instance Element (a, b) = b
type instance Element (Const m a) = a
type instance Element (WrappedMonad m a) = a
type instance Element (Map k v) = v
type instance Element (HashMap k v) = v
type instance Element (Set e) = e
type instance Element (HashSet e) = e
type instance Element (Vector a) = a
type instance Element (WrappedArrow a b c) = c
type instance Element (MaybeApply f a) = a
type instance Element (WrappedApplicative f a) = a
type instance Element (Cokleisli w a b) = b
type instance Element (MaybeT m a) = a
type instance Element (ListT m a) = a
type instance Element (IdentityT m a) = a
type instance Element (WriterT w m a) = a
type instance Element (Strict.WriterT w m a) = a
type instance Element (StateT s m a) = a
type instance Element (Strict.StateT s m a) = a
type instance Element (RWST r w s m a) = a
type instance Element (Strict.RWST r w s m a) = a
type instance Element (ReaderT r m a) = a
type instance Element (ErrorT e m a) = a
type instance Element (ContT r m a) = a
type instance Element (Compose f g a) = a
type instance Element (Product f g a) = a
type instance Element (Static f a b) = b
type instance Element (U.Vector a) = a
type instance Element (VS.Vector a) = a
type instance Element (Arg a b) = b
type instance Element (EnvT e w a) = a
type instance Element (StoreT s w a) = a
type instance Element (TracedT m w a) = a
#if !MIN_VERSION_comonad(5,0,0)
type instance Element (Coproduct f g a) = a
#endif
class MonoFunctor mono where
omap :: (Element mono -> Element mono) -> mono -> mono
default omap :: (Functor f, Element (f a) ~ a, f a ~ mono) => (a -> a) -> f a -> f a
omap = fmap
instance MonoFunctor S.ByteString where
omap = S.map
instance MonoFunctor L.ByteString where
omap = L.map
instance MonoFunctor T.Text where
omap = T.map
instance MonoFunctor TL.Text where
omap = TL.map
instance MonoFunctor [a]
instance MonoFunctor (IO a)
instance MonoFunctor (ZipList a)
instance MonoFunctor (Maybe a)
instance MonoFunctor (Tree a)
instance MonoFunctor (Seq a)
instance MonoFunctor (DList a)
instance MonoFunctor (ViewL a)
instance MonoFunctor (ViewR a)
instance MonoFunctor (IntMap a)
instance MonoFunctor (Option a)
instance MonoFunctor (NonEmpty a)
instance MonoFunctor (Identity a)
instance MonoFunctor (r -> a)
instance MonoFunctor (Either a b)
instance MonoFunctor (a, b)
instance MonoFunctor (Const m a)
instance Monad m => MonoFunctor (WrappedMonad m a)
instance MonoFunctor (Map k v)
instance MonoFunctor (HashMap k v)
instance MonoFunctor (Vector a)
instance MonoFunctor (Arg a b)
instance Functor w => MonoFunctor (EnvT e w a)
instance Functor w => MonoFunctor (StoreT s w a)
instance Functor w => MonoFunctor (TracedT m w a)
#if !MIN_VERSION_comonad(5,0,0)
instance (Functor f, Functor g) => MonoFunctor (Coproduct f g a)
#endif
instance Arrow a => MonoFunctor (WrappedArrow a b c)
instance Functor f => MonoFunctor (MaybeApply f a)
instance Functor f => MonoFunctor (WrappedApplicative f a)
instance MonoFunctor (Cokleisli w a b)
instance Functor m => MonoFunctor (MaybeT m a)
instance Functor m => MonoFunctor (ListT m a)
instance Functor m => MonoFunctor (IdentityT m a)
instance Functor m => MonoFunctor (WriterT w m a)
instance Functor m => MonoFunctor (Strict.WriterT w m a)
instance Functor m => MonoFunctor (StateT s m a)
instance Functor m => MonoFunctor (Strict.StateT s m a)
instance Functor m => MonoFunctor (RWST r w s m a)
instance Functor m => MonoFunctor (Strict.RWST r w s m a)
instance Functor m => MonoFunctor (ReaderT r m a)
instance Functor m => MonoFunctor (ErrorT e m a)
instance Functor m => MonoFunctor (ContT r m a)
instance (Functor f, Functor g) => MonoFunctor (Compose f g a)
instance (Functor f, Functor g) => MonoFunctor (Product f g a)
instance Functor f => MonoFunctor (Static f a b)
instance U.Unbox a => MonoFunctor (U.Vector a) where
omap = U.map
instance VS.Storable a => MonoFunctor (VS.Vector a) where
omap = VS.map
class MonoFoldable mono where
ofoldMap :: Monoid m => (Element mono -> m) -> mono -> m
default ofoldMap :: (t a ~ mono, a ~ Element (t a), F.Foldable t, Monoid m) => (Element mono -> m) -> mono -> m
ofoldMap = F.foldMap
ofoldr :: (Element mono -> b -> b) -> b -> mono -> b
default ofoldr :: (t a ~ mono, a ~ Element (t a), F.Foldable t) => (Element mono -> b -> b) -> b -> mono -> b
ofoldr = F.foldr
ofoldl' :: (a -> Element mono -> a) -> a -> mono -> a
default ofoldl' :: (t b ~ mono, b ~ Element (t b), F.Foldable t) => (a -> Element mono -> a) -> a -> mono -> a
ofoldl' = F.foldl'
otoList :: mono -> [Element mono]
otoList t = build (\ mono n -> ofoldr mono n t)
oall :: (Element mono -> Bool) -> mono -> Bool
oall f = getAll . ofoldMap (All . f)
oany :: (Element mono -> Bool) -> mono -> Bool
oany f = getAny . ofoldMap (Any . f)
onull :: mono -> Bool
onull = oall (const False)
olength :: mono -> Int
olength = ofoldl' (\i _ -> i + 1) 0
olength64 :: mono -> Int64
olength64 = ofoldl' (\i _ -> i + 1) 0
ocompareLength :: Integral i => mono -> i -> Ordering
ocompareLength c0 i0 = olength c0 `compare` fromIntegral i0
otraverse_ :: (MonoFoldable mono, Applicative f) => (Element mono -> f b) -> mono -> f ()
otraverse_ f = ofoldr ((*>) . f) (pure ())
ofor_ :: (MonoFoldable mono, Applicative f) => mono -> (Element mono -> f b) -> f ()
ofor_ = flip otraverse_
omapM_ :: (MonoFoldable mono, Monad m) => (Element mono -> m ()) -> mono -> m ()
omapM_ f = ofoldr ((>>) . f) (return ())
oforM_ :: (MonoFoldable mono, Monad m) => mono -> (Element mono -> m ()) -> m ()
oforM_ = flip omapM_
ofoldlM :: (MonoFoldable mono, Monad m) => (a -> Element mono -> m a) -> a -> mono -> m a
ofoldlM f z0 xs = ofoldr f' return xs z0
where f' x k z = f z x >>= k
ofoldMap1Ex :: Semigroup m => (Element mono -> m) -> mono -> m
ofoldMap1Ex f = fromMaybe (Prelude.error "Data.MonoTraversable.ofoldMap1Ex")
. getOption . ofoldMap (Option . Just . f)
ofoldr1Ex :: (Element mono -> Element mono -> Element mono) -> mono -> Element mono
default ofoldr1Ex :: (t a ~ mono, a ~ Element (t a), F.Foldable t)
=> (a -> a -> a) -> mono -> a
ofoldr1Ex = F.foldr1
ofoldl1Ex' :: (Element mono -> Element mono -> Element mono) -> mono -> Element mono
default ofoldl1Ex' :: (t a ~ mono, a ~ Element (t a), F.Foldable t)
=> (a -> a -> a) -> mono -> a
ofoldl1Ex' = F.foldl1
headEx :: mono -> Element mono
headEx = ofoldr const (Prelude.error "Data.MonoTraversable.headEx: empty")
lastEx :: mono -> Element mono
lastEx = ofoldl1Ex' (flip const)
unsafeHead :: mono -> Element mono
unsafeHead = headEx
unsafeLast :: mono -> Element mono
unsafeLast = lastEx
maximumByEx :: (Element mono -> Element mono -> Ordering) -> mono -> Element mono
maximumByEx f =
ofoldl1Ex' go
where
go x y =
case f x y of
LT -> y
_ -> x
minimumByEx :: (Element mono -> Element mono -> Ordering) -> mono -> Element mono
minimumByEx f =
ofoldl1Ex' go
where
go x y =
case f x y of
GT -> y
_ -> x
instance MonoFoldable S.ByteString where
ofoldMap f = ofoldr (mappend . f) mempty
ofoldr = S.foldr
ofoldl' = S.foldl'
otoList = S.unpack
oall = S.all
oany = S.any
onull = S.null
olength = S.length
omapM_ f (Unsafe.PS fptr offset len) = do
let start = Unsafe.unsafeForeignPtrToPtr fptr `plusPtr` offset
end = start `plusPtr` len
loop ptr
| ptr >= end = Unsafe.inlinePerformIO (touchForeignPtr fptr) `seq` return ()
| otherwise = do
_ <- f (Unsafe.inlinePerformIO (peek ptr))
loop (ptr `plusPtr` 1)
loop start
ofoldr1Ex = S.foldr1
ofoldl1Ex' = S.foldl1'
headEx = S.head
lastEx = S.last
unsafeHead = SU.unsafeHead
instance MonoFoldable L.ByteString where
ofoldMap f = ofoldr (mappend . f) mempty
ofoldr = L.foldr
ofoldl' = L.foldl'
otoList = L.unpack
oall = L.all
oany = L.any
onull = L.null
olength64 = L.length
omapM_ f = omapM_ (omapM_ f) . L.toChunks
ofoldr1Ex = L.foldr1
ofoldl1Ex' = L.foldl1'
headEx = L.head
lastEx = L.last
instance MonoFoldable T.Text where
ofoldMap f = ofoldr (mappend . f) mempty
ofoldr = T.foldr
ofoldl' = T.foldl'
otoList = T.unpack
oall = T.all
oany = T.any
onull = T.null
olength = T.length
ofoldr1Ex = T.foldr1
ofoldl1Ex' = T.foldl1'
headEx = T.head
lastEx = T.last
instance MonoFoldable TL.Text where
ofoldMap f = ofoldr (mappend . f) mempty
ofoldr = TL.foldr
ofoldl' = TL.foldl'
otoList = TL.unpack
oall = TL.all
oany = TL.any
onull = TL.null
olength64 = TL.length
ofoldr1Ex = TL.foldr1
ofoldl1Ex' = TL.foldl1'
headEx = TL.head
lastEx = TL.last
instance MonoFoldable IntSet where
ofoldMap f = ofoldr (mappend . f) mempty
ofoldr = IntSet.foldr
ofoldl' = IntSet.foldl'
otoList = IntSet.toList
onull = IntSet.null
olength = IntSet.size
ofoldr1Ex f = ofoldr1Ex f . IntSet.toList
ofoldl1Ex' f = ofoldl1Ex' f . IntSet.toList
instance MonoFoldable [a] where
otoList = id
ocompareLength [] i = 0 `compare` i
ocompareLength (_:xs) i
| i Prelude.<= 0 = GT
| otherwise = ocompareLength xs (i 1)
instance MonoFoldable (Maybe a) where
omapM_ _ Nothing = return ()
omapM_ f (Just x) = f x
instance MonoFoldable (Tree a)
instance MonoFoldable (Seq a) where
headEx = flip Seq.index 0
lastEx xs = Seq.index xs (Seq.length xs 1)
instance MonoFoldable (ViewL a)
instance MonoFoldable (ViewR a)
instance MonoFoldable (IntMap a)
instance MonoFoldable (Option a)
instance MonoFoldable (NonEmpty a)
instance MonoFoldable (Identity a)
instance MonoFoldable (Map k v)
instance MonoFoldable (HashMap k v)
instance MonoFoldable (Vector a) where
ofoldr = V.foldr
ofoldl' = V.foldl'
otoList = V.toList
oall = V.all
oany = V.any
onull = V.null
olength = V.length
ofoldr1Ex = V.foldr1
ofoldl1Ex' = V.foldl1'
headEx = V.head
lastEx = V.last
unsafeHead = V.unsafeHead
unsafeLast = V.unsafeLast
maximumByEx = V.maximumBy
minimumByEx = V.minimumBy
instance MonoFoldable (Set e)
instance MonoFoldable (HashSet e)
instance MonoFoldable (DList a) where
otoList = DL.toList
headEx = DL.head
instance U.Unbox a => MonoFoldable (U.Vector a) where
ofoldMap f = ofoldr (mappend . f) mempty
ofoldr = U.foldr
ofoldl' = U.foldl'
otoList = U.toList
oall = U.all
oany = U.any
onull = U.null
olength = U.length
ofoldr1Ex = U.foldr1
ofoldl1Ex' = U.foldl1'
headEx = U.head
lastEx = U.last
unsafeHead = U.unsafeHead
unsafeLast = U.unsafeLast
maximumByEx = U.maximumBy
minimumByEx = U.minimumBy
instance VS.Storable a => MonoFoldable (VS.Vector a) where
ofoldMap f = ofoldr (mappend . f) mempty
ofoldr = VS.foldr
ofoldl' = VS.foldl'
otoList = VS.toList
oall = VS.all
oany = VS.any
onull = VS.null
olength = VS.length
ofoldr1Ex = VS.foldr1
ofoldl1Ex' = VS.foldl1'
headEx = VS.head
lastEx = VS.last
unsafeHead = VS.unsafeHead
unsafeLast = VS.unsafeLast
maximumByEx = VS.maximumBy
minimumByEx = VS.minimumBy
instance MonoFoldable (Either a b) where
ofoldMap f = ofoldr (mappend . f) mempty
ofoldr f b (Right a) = f a b
ofoldr _ b (Left _) = b
ofoldl' f a (Right b) = f a b
ofoldl' _ a (Left _) = a
otoList (Left _) = []
otoList (Right b) = [b]
oall _ (Left _) = True
oall f (Right b) = f b
oany _ (Left _) = False
oany f (Right b) = f b
onull (Left _) = True
onull (Right _) = False
olength (Left _) = 0
olength (Right _) = 1
ofoldr1Ex _ (Left _) = Prelude.error "ofoldr1Ex on Either"
ofoldr1Ex _ (Right x) = x
ofoldl1Ex' _ (Left _) = Prelude.error "ofoldl1Ex' on Either"
ofoldl1Ex' _ (Right x) = x
omapM_ _ (Left _) = return ()
omapM_ f (Right x) = f x
instance MonoFoldable (a, b)
instance MonoFoldable (Const m a)
instance F.Foldable f => MonoFoldable (MaybeT f a)
instance F.Foldable f => MonoFoldable (ListT f a)
instance F.Foldable f => MonoFoldable (IdentityT f a)
instance F.Foldable f => MonoFoldable (WriterT w f a)
instance F.Foldable f => MonoFoldable (Strict.WriterT w f a)
instance F.Foldable f => MonoFoldable (ErrorT e f a)
instance (F.Foldable f, F.Foldable g) => MonoFoldable (Compose f g a)
instance (F.Foldable f, F.Foldable g) => MonoFoldable (Product f g a)
headMay :: MonoFoldable mono => mono -> Maybe (Element mono)
headMay mono
| onull mono = Nothing
| otherwise = Just (headEx mono)
lastMay :: MonoFoldable mono => mono -> Maybe (Element mono)
lastMay mono
| onull mono = Nothing
| otherwise = Just (lastEx mono)
osum :: (MonoFoldable mono, Num (Element mono)) => mono -> Element mono
osum = ofoldl' (+) 0
oproduct :: (MonoFoldable mono, Num (Element mono)) => mono -> Element mono
oproduct = ofoldl' (*) 1
oand :: (Element mono ~ Bool, MonoFoldable mono) => mono -> Bool
oand = oall id
oor :: (Element mono ~ Bool, MonoFoldable mono) => mono -> Bool
oor = oany id
class (MonoFoldable mono, Monoid mono) => MonoFoldableMonoid mono where
oconcatMap :: (Element mono -> mono) -> mono -> mono
oconcatMap = ofoldMap
instance (MonoFoldable (t a), Monoid (t a)) => MonoFoldableMonoid (t a)
instance MonoFoldableMonoid S.ByteString where
oconcatMap = S.concatMap
instance MonoFoldableMonoid L.ByteString where
oconcatMap = L.concatMap
instance MonoFoldableMonoid T.Text where
oconcatMap = T.concatMap
instance MonoFoldableMonoid TL.Text where
oconcatMap = TL.concatMap
class (MonoFoldable mono, Eq (Element mono)) => MonoFoldableEq mono where
oelem :: Element mono -> mono -> Bool
oelem e = List.elem e . otoList
onotElem :: Element mono -> mono -> Bool
onotElem e = List.notElem e . otoList
instance Eq a => MonoFoldableEq (Seq.Seq a)
instance Eq a => MonoFoldableEq (V.Vector a)
instance (Eq a, U.Unbox a) => MonoFoldableEq (U.Vector a)
instance (Eq a, VS.Storable a) => MonoFoldableEq (VS.Vector a)
instance Eq a => MonoFoldableEq (NonEmpty a)
instance MonoFoldableEq T.Text
instance MonoFoldableEq TL.Text
instance MonoFoldableEq IntSet
instance Eq a => MonoFoldableEq (Maybe a)
instance Eq a => MonoFoldableEq (Tree a)
instance Eq a => MonoFoldableEq (ViewL a)
instance Eq a => MonoFoldableEq (ViewR a)
instance Eq a => MonoFoldableEq (IntMap a)
instance Eq a => MonoFoldableEq (Option a)
instance Eq a => MonoFoldableEq (Identity a)
instance Eq v => MonoFoldableEq (Map k v)
instance Eq v => MonoFoldableEq (HashMap k v)
instance Eq a => MonoFoldableEq (HashSet a)
instance Eq a => MonoFoldableEq (DList a)
instance Eq b => MonoFoldableEq (Either a b)
instance Eq b => MonoFoldableEq (a, b)
instance Eq a => MonoFoldableEq (Const m a)
instance (Eq a, F.Foldable f) => MonoFoldableEq (MaybeT f a)
instance (Eq a, F.Foldable f) => MonoFoldableEq (ListT f a)
instance (Eq a, F.Foldable f) => MonoFoldableEq (IdentityT f a)
instance (Eq a, F.Foldable f) => MonoFoldableEq (WriterT w f a)
instance (Eq a, F.Foldable f) => MonoFoldableEq (Strict.WriterT w f a)
instance (Eq a, F.Foldable f) => MonoFoldableEq (ErrorT e f a)
instance (Eq a, F.Foldable f, F.Foldable g) => MonoFoldableEq (Compose f g a)
instance (Eq a, F.Foldable f, F.Foldable g) => MonoFoldableEq (Product f g a)
instance Eq a => MonoFoldableEq [a] where
oelem = List.elem
onotElem = List.notElem
instance MonoFoldableEq S.ByteString where
oelem = S.elem
onotElem = S.notElem
instance MonoFoldableEq L.ByteString where
oelem = L.elem
onotElem = L.notElem
instance (Eq a, Ord a) => MonoFoldableEq (Set a) where
oelem = Set.member
onotElem = Set.notMember
class (MonoFoldable mono, Ord (Element mono)) => MonoFoldableOrd mono where
maximumEx :: mono -> Element mono
maximumEx = maximumByEx compare
minimumEx :: mono -> Element mono
minimumEx = minimumByEx compare
instance MonoFoldableOrd S.ByteString where
maximumEx = S.maximum
minimumEx = S.minimum
instance MonoFoldableOrd L.ByteString where
maximumEx = L.maximum
minimumEx = L.minimum
instance MonoFoldableOrd T.Text where
maximumEx = T.maximum
minimumEx = T.minimum
instance MonoFoldableOrd TL.Text where
maximumEx = TL.maximum
minimumEx = TL.minimum
instance MonoFoldableOrd IntSet
instance Ord a => MonoFoldableOrd [a]
instance Ord a => MonoFoldableOrd (Maybe a)
instance Ord a => MonoFoldableOrd (Tree a)
instance Ord a => MonoFoldableOrd (Seq a)
instance Ord a => MonoFoldableOrd (ViewL a)
instance Ord a => MonoFoldableOrd (ViewR a)
instance Ord a => MonoFoldableOrd (IntMap a)
instance Ord a => MonoFoldableOrd (Option a)
instance Ord a => MonoFoldableOrd (NonEmpty a)
instance Ord a => MonoFoldableOrd (Identity a)
instance Ord v => MonoFoldableOrd (Map k v)
instance Ord v => MonoFoldableOrd (HashMap k v)
instance Ord a => MonoFoldableOrd (Vector a) where
maximumEx = V.maximum
minimumEx = V.minimum
instance Ord e => MonoFoldableOrd (Set e)
instance Ord e => MonoFoldableOrd (HashSet e)
instance (U.Unbox a, Ord a) => MonoFoldableOrd (U.Vector a) where
maximumEx = U.maximum
minimumEx = U.minimum
instance (Ord a, VS.Storable a) => MonoFoldableOrd (VS.Vector a) where
maximumEx = VS.maximum
minimumEx = VS.minimum
instance Ord b => MonoFoldableOrd (Either a b) where
instance Ord a => MonoFoldableOrd (DList a)
instance Ord b => MonoFoldableOrd (a, b)
instance Ord a => MonoFoldableOrd (Const m a)
instance (Ord a, F.Foldable f) => MonoFoldableOrd (MaybeT f a)
instance (Ord a, F.Foldable f) => MonoFoldableOrd (ListT f a)
instance (Ord a, F.Foldable f) => MonoFoldableOrd (IdentityT f a)
instance (Ord a, F.Foldable f) => MonoFoldableOrd (WriterT w f a)
instance (Ord a, F.Foldable f) => MonoFoldableOrd (Strict.WriterT w f a)
instance (Ord a, F.Foldable f) => MonoFoldableOrd (ErrorT e f a)
instance (Ord a, F.Foldable f, F.Foldable g) => MonoFoldableOrd (Compose f g a)
instance (Ord a, F.Foldable f, F.Foldable g) => MonoFoldableOrd (Product f g a)
maximumMay :: MonoFoldableOrd mono => mono -> Maybe (Element mono)
maximumMay mono
| onull mono = Nothing
| otherwise = Just (maximumEx mono)
maximumByMay :: MonoFoldable mono
=> (Element mono -> Element mono -> Ordering)
-> mono
-> Maybe (Element mono)
maximumByMay f mono
| onull mono = Nothing
| otherwise = Just (maximumByEx f mono)
minimumMay :: MonoFoldableOrd mono => mono -> Maybe (Element mono)
minimumMay mono
| onull mono = Nothing
| otherwise = Just (minimumEx mono)
minimumByMay :: MonoFoldable mono
=> (Element mono -> Element mono -> Ordering)
-> mono
-> Maybe (Element mono)
minimumByMay f mono
| onull mono = Nothing
| otherwise = Just (minimumByEx f mono)
class (MonoFunctor mono, MonoFoldable mono) => MonoTraversable mono where
otraverse :: Applicative f => (Element mono -> f (Element mono)) -> mono -> f mono
default otraverse :: (Traversable t, mono ~ t a, a ~ Element mono, Applicative f) => (Element mono -> f (Element mono)) -> mono -> f mono
otraverse = traverse
omapM :: Monad m => (Element mono -> m (Element mono)) -> mono -> m mono
default omapM :: (Traversable t, mono ~ t a, a ~ Element mono, Monad m) => (Element mono -> m (Element mono)) -> mono -> m mono
omapM = mapM
instance MonoTraversable S.ByteString where
otraverse f = fmap S.pack . traverse f . S.unpack
omapM f = liftM S.pack . mapM f . S.unpack
instance MonoTraversable L.ByteString where
otraverse f = fmap L.pack . traverse f . L.unpack
omapM f = liftM L.pack . mapM f . L.unpack
instance MonoTraversable T.Text where
otraverse f = fmap T.pack . traverse f . T.unpack
omapM f = liftM T.pack . mapM f . T.unpack
instance MonoTraversable TL.Text where
otraverse f = fmap TL.pack . traverse f . TL.unpack
omapM f = liftM TL.pack . mapM f . TL.unpack
instance MonoTraversable [a]
instance MonoTraversable (Maybe a)
instance MonoTraversable (Tree a)
instance MonoTraversable (Seq a)
instance MonoTraversable (ViewL a)
instance MonoTraversable (ViewR a)
instance MonoTraversable (IntMap a)
instance MonoTraversable (Option a)
instance MonoTraversable (NonEmpty a)
instance MonoTraversable (DList a) where
otraverse f = fmap DL.fromList . traverse f . DL.toList
omapM f = liftM DL.fromList . mapM f . DL.toList
instance MonoTraversable (Identity a)
instance MonoTraversable (Map k v)
instance MonoTraversable (HashMap k v)
instance MonoTraversable (Vector a)
instance U.Unbox a => MonoTraversable (U.Vector a) where
otraverse f = fmap U.fromList . traverse f . U.toList
omapM = U.mapM
instance VS.Storable a => MonoTraversable (VS.Vector a) where
otraverse f = fmap VS.fromList . traverse f . VS.toList
omapM = VS.mapM
instance MonoTraversable (Either a b) where
otraverse _ (Left a) = pure (Left a)
otraverse f (Right b) = fmap Right (f b)
omapM _ (Left a) = return (Left a)
omapM f (Right b) = liftM Right (f b)
instance MonoTraversable (a, b)
instance MonoTraversable (Const m a)
instance Traversable f => MonoTraversable (MaybeT f a)
instance Traversable f => MonoTraversable (ListT f a)
instance Traversable f => MonoTraversable (IdentityT f a)
instance Traversable f => MonoTraversable (WriterT w f a)
instance Traversable f => MonoTraversable (Strict.WriterT w f a)
instance Traversable f => MonoTraversable (ErrorT e f a)
instance (Traversable f, Traversable g) => MonoTraversable (Compose f g a)
instance (Traversable f, Traversable g) => MonoTraversable (Product f g a)
ofor :: (MonoTraversable mono, Applicative f) => mono -> (Element mono -> f (Element mono)) -> f mono
ofor = flip otraverse
oforM :: (MonoTraversable mono, Monad f) => mono -> (Element mono -> f (Element mono)) -> f mono
oforM = flip omapM
ofoldlUnwrap :: MonoFoldable mono
=> (x -> Element mono -> x) -> x -> (x -> b) -> mono -> b
ofoldlUnwrap f x unwrap mono = unwrap (ofoldl' f x mono)
ofoldMUnwrap :: (Monad m, MonoFoldable mono)
=> (x -> Element mono -> m x) -> m x -> (x -> m b) -> mono -> m b
ofoldMUnwrap f mx unwrap mono = do
x <- mx
x' <- ofoldlM f x mono
unwrap x'
class MonoPointed mono where
opoint :: Element mono -> mono
default opoint :: (Applicative f, (f a) ~ mono, Element (f a) ~ a)
=> Element mono -> mono
opoint = pure
instance MonoPointed S.ByteString where
opoint = S.singleton
instance MonoPointed L.ByteString where
opoint = L.singleton
instance MonoPointed T.Text where
opoint = T.singleton
instance MonoPointed TL.Text where
opoint = TL.singleton
instance MonoPointed [a]
instance MonoPointed (Maybe a)
instance MonoPointed (Option a)
instance MonoPointed (NonEmpty a)
instance MonoPointed (Identity a)
instance MonoPointed (Vector a)
instance MonoPointed (DList a)
instance MonoPointed (IO a)
instance MonoPointed (ZipList a)
instance MonoPointed (r -> a)
instance Monoid a => MonoPointed (a, b)
instance Monoid m => MonoPointed (Const m a)
instance Monad m => MonoPointed (WrappedMonad m a)
instance Applicative m => MonoPointed (ListT m a)
instance Applicative m => MonoPointed (IdentityT m a)
instance Applicative f => MonoPointed (WrappedApplicative f a)
instance Arrow a => MonoPointed (WrappedArrow a b c)
instance (Monoid w, Applicative m) => MonoPointed (WriterT w m a)
instance (Monoid w, Applicative m) => MonoPointed (Strict.WriterT w m a)
instance Applicative m => MonoPointed (ReaderT r m a)
instance MonoPointed (ContT r m a)
instance (Applicative f, Applicative g) => MonoPointed (Compose f g a)
instance (Applicative f, Applicative g) => MonoPointed (Product f g a)
instance MonoPointed (Cokleisli w a b)
instance Applicative f => MonoPointed (Static f a b)
instance MonoPointed (Seq a) where
opoint = Seq.singleton
instance U.Unbox a => MonoPointed (U.Vector a) where
opoint = U.singleton
instance VS.Storable a => MonoPointed (VS.Vector a) where
opoint = VS.singleton
instance MonoPointed (Either a b) where
opoint = Right
instance MonoPointed IntSet.IntSet where
opoint = IntSet.singleton
instance MonoPointed (Set a) where
opoint = Set.singleton
instance Hashable a => MonoPointed (HashSet a) where
opoint = HashSet.singleton
instance Applicative m => MonoPointed (ErrorT e m a) where
opoint = ErrorT . pure . Right
instance MonoPointed (MaybeApply f a) where
opoint = MaybeApply . Right
instance Applicative f => MonoPointed (MaybeT f a) where
opoint = MaybeT . fmap Just . pure
instance (Monoid w, Applicative m) => MonoPointed (RWST r w s m a) where
opoint a = RWST (\_ s -> pure (a, s, mempty))
instance (Monoid w, Applicative m) => MonoPointed (Strict.RWST r w s m a) where
opoint a = Strict.RWST (\_ s -> pure (a, s, mempty))
instance Applicative m => MonoPointed (StateT s m a) where
opoint a = StateT (\s -> pure (a, s))
instance Applicative m => MonoPointed (Strict.StateT s m a) where
opoint a = Strict.StateT (\s -> pure (a, s))
instance MonoPointed (ViewL a) where
opoint a = a :< Seq.empty
instance MonoPointed (ViewR a) where
opoint a = Seq.empty :> a
instance MonoPointed (Tree a) where
opoint a = Node a []
class MonoFunctor mono => MonoComonad mono where
oextract :: mono -> Element mono
oextend :: (mono -> Element mono) -> mono -> mono
default oextract :: (Comonad w, (w a) ~ mono, Element (w a) ~ a)
=> mono -> Element mono
oextract = extract
default oextend :: (Comonad w, (w a) ~ mono, Element (w a) ~ a)
=> (mono -> Element mono) -> mono -> mono
oextend = extend
instance MonoComonad (Tree a)
instance MonoComonad (NonEmpty a)
instance MonoComonad (Identity a)
instance Monoid m => MonoComonad (m -> a)
instance MonoComonad (e, a)
instance MonoComonad (Arg a b)
instance Comonad w => MonoComonad (IdentityT w a)
instance Comonad w => MonoComonad (EnvT e w a)
instance Comonad w => MonoComonad (StoreT s w a)
instance (Comonad w, Monoid m) => MonoComonad (TracedT m w a)
#if !MIN_VERSION_comonad(5,0,0)
instance (Comonad f, Comonad g) => MonoComonad (Coproduct f g a)
#endif
instance MonoComonad (ViewL a) where
oextract ~(x :< _) = x
oextend f w@ ~(_ :< xxs) =
f w :< case Seq.viewl xxs of
EmptyL -> Seq.empty
xs -> case oextend f xs of
EmptyL -> Seq.empty
y :< ys -> y Seq.<| ys
instance MonoComonad (ViewR a) where
oextract ~(_ :> x) = x
oextend f w@ ~(xxs :> _) =
(case Seq.viewr xxs of
EmptyR -> Seq.empty
xs -> case oextend f xs of
EmptyR -> Seq.empty
ys :> y -> ys Seq.|> y
) :> f w