{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.MonoTraversable.Keys
( MonoKey
, MonoKeyed(..)
, MonoFoldableWithKey(..)
, MonoTraversableWithKey(..)
, MonoAdjustable(..)
, MonoZip(..)
, MonoZipWithKey(..)
, MonoIndexable(..)
, MonoLookup(..)
, ofoldlWithKeyUnwrap
, ofoldWithKeyMUnwrap
) where
import Control.Applicative
import Control.Arrow (Arrow)
#if MIN_VERSION_base(4,13,0)
#else
import Control.Monad (Monad (..))
#endif
import Control.Monad.Trans.Cont (ContT)
import Control.Monad.Trans.Identity (IdentityT)
import Control.Monad.Trans.List (ListT(..))
import Control.Monad.Trans.Maybe (MaybeT(..))
import Control.Monad.Trans.Reader (ReaderT)
import Control.Monad.Trans.RWS (RWST(..))
import qualified Control.Monad.Trans.RWS.Strict as S (RWST(..))
import Control.Monad.Trans.State (StateT(..))
import qualified Control.Monad.Trans.State.Strict as S (StateT(..), evalState, get, modify)
import Control.Monad.Trans.Writer (WriterT)
import qualified Control.Monad.Trans.Writer.Strict as S (WriterT)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Foldable
import Data.Functor.Compose (Compose(..))
import Data.Functor.Identity (Identity)
import Data.Functor.Product (Product(..))
import Data.Hashable
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.HashSet (HashSet)
import qualified Data.HashSet as HS
#if MIN_VERSION_base(4,13,0)
#else
import Data.Int (Int)
#endif
import Data.IntMap (IntMap)
import qualified Data.IntMap as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import Data.Key
import Data.List.NonEmpty (NonEmpty(..))
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
#if MIN_VERSION_base(4,13,0)
#else
import Data.Monoid (Monoid(..))
#endif
import Data.MonoTraversable (Element, MonoFoldable(..), MonoFunctor(..), MonoTraversable(..))
import Data.Semigroup (
#if MIN_VERSION_base(4,11,0)
#else
Semigroup(..),
#endif
Arg(..), Dual(..), Endo(..)
#if MIN_VERSION_base(4,16,0)
#else
, Option(..)
#endif
)
import Data.Sequence (Seq, ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Tree (Tree(..))
import Data.Vector (Vector)
import qualified Data.Vector as V
import Data.Vector.Instances ()
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Storable.Mutable as VSM
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import Prelude hiding (lookup, zipWith)
type family MonoKey key
type instance MonoKey (r -> a) = ()
type instance MonoKey [a] = Int
type instance MonoKey (a, b) = ()
type instance MonoKey (Arg a b) = ()
type instance MonoKey BS.ByteString = Int
type instance MonoKey BSL.ByteString = Int
type instance MonoKey (Compose f g a) = (MonoKey (f a), MonoKey (g a))
type instance MonoKey (Const m a) = ()
type instance MonoKey (ContT r m a) = ()
type instance MonoKey (Either a b) = ()
type instance MonoKey (HashMap k v) = k
type instance MonoKey (HashSet e) = Int
type instance MonoKey (Identity a) = ()
type instance MonoKey (IdentityT m a) = ()
type instance MonoKey (IntMap a) = Int
type instance MonoKey IntSet = Int
type instance MonoKey (IO a) = ()
type instance MonoKey (ListT m a) = Int
type instance MonoKey (Map k v) = k
type instance MonoKey (Maybe a) = ()
type instance MonoKey (MaybeT m a) = ()
type instance MonoKey (NonEmpty a) = Int
#if MIN_VERSION_base(4,16,0)
#else
type instance MonoKey (Option a) = ()
#endif
type instance MonoKey (Product f g a) = Either (Key f) (Key g)
type instance MonoKey (ReaderT r m a) = (r, Key m)
type instance MonoKey (RWST r w s m a) = ()
type instance MonoKey (S.RWST r w s m a) = ()
type instance MonoKey (Seq a) = Int
type instance MonoKey (Set e) = Int
type instance MonoKey (StateT s m a) = ()
type instance MonoKey (S.StateT s m a) = ()
type instance MonoKey T.Text = Int
type instance MonoKey TL.Text = Int
type instance MonoKey (Tree a) = Seq Int
type instance MonoKey (Vector a) = Int
type instance MonoKey (VU.Vector a) = Int
type instance MonoKey (VS.Vector a) = Int
type instance MonoKey (ViewL a) = ()
type instance MonoKey (ViewR a) = ()
type instance MonoKey (WrappedArrow a b c) = ()
type instance MonoKey (WrappedMonad m a) = ()
type instance MonoKey (WriterT w m a) = ()
type instance MonoKey (S.WriterT w m a) = ()
type instance MonoKey (ZipList a) = Int
class MonoFunctor mono => MonoKeyed mono where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey mono -> Element mono -> Element mono) -> mono -> mono
default omapWithKey :: (Keyed f, Element (f a) ~ a, MonoKey (f a) ~ Key f, f a ~ mono)
=> (MonoKey mono -> Element mono -> Element mono) -> mono -> mono
omapWithKey = (MonoKey mono -> Element mono -> Element mono) -> mono -> mono
forall (f :: * -> *) a b.
Keyed f =>
(Key f -> a -> b) -> f a -> f b
mapWithKey
class MonoFoldable mono => MonoFoldableWithKey mono where
{-# MINIMAL ofoldMapWithKey | ofoldlWithKey #-}
otoKeyedList :: mono -> [(MonoKey mono, Element mono)]
otoKeyedList = (MonoKey mono
-> Element mono
-> [(MonoKey mono, Element mono)]
-> [(MonoKey mono, Element mono)])
-> [(MonoKey mono, Element mono)]
-> mono
-> [(MonoKey mono, Element mono)]
forall mono a.
MonoFoldableWithKey mono =>
(MonoKey mono -> Element mono -> a -> a) -> a -> mono -> a
ofoldrWithKey (\MonoKey mono
k Element mono
v [(MonoKey mono, Element mono)]
t -> (MonoKey mono
k,Element mono
v)(MonoKey mono, Element mono)
-> [(MonoKey mono, Element mono)] -> [(MonoKey mono, Element mono)]
forall a. a -> [a] -> [a]
:[(MonoKey mono, Element mono)]
t) []
ofoldMapWithKey :: Monoid m => (MonoKey mono -> Element mono -> m) -> mono -> m
ofoldMapWithKey MonoKey mono -> Element mono -> m
f = (m -> MonoKey mono -> Element mono -> m) -> m -> mono -> m
forall mono a.
MonoFoldableWithKey mono =>
(a -> MonoKey mono -> Element mono -> a) -> a -> mono -> a
ofoldlWithKey (\m
a MonoKey mono
k Element mono
v -> m -> m -> m
forall a. Monoid a => a -> a -> a
mappend (MonoKey mono -> Element mono -> m
f MonoKey mono
k Element mono
v) m
a) m
forall a. Monoid a => a
mempty
ofoldrWithKey :: (MonoKey mono -> Element mono -> a -> a) -> a -> mono -> a
ofoldrWithKey MonoKey mono -> Element mono -> a -> a
f a
z mono
t = Endo a -> a -> a
forall a. Endo a -> a -> a
appEndo ((MonoKey mono -> Element mono -> Endo a) -> mono -> Endo a
forall mono m.
(MonoFoldableWithKey mono, Monoid m) =>
(MonoKey mono -> Element mono -> m) -> mono -> m
ofoldMapWithKey (\MonoKey mono
k Element mono
v -> (a -> a) -> Endo a
forall a. (a -> a) -> Endo a
Endo (MonoKey mono -> Element mono -> a -> a
f MonoKey mono
k Element mono
v)) mono
t) a
z
ofoldlWithKey :: (a -> MonoKey mono -> Element mono -> a) -> a -> mono -> a
ofoldlWithKey a -> MonoKey mono -> Element mono -> a
f a
z mono
t = Endo a -> a -> a
forall a. Endo a -> a -> a
appEndo (Dual (Endo a) -> Endo a
forall a. Dual a -> a
getDual ((MonoKey mono -> Element mono -> Dual (Endo a))
-> mono -> Dual (Endo a)
forall mono m.
(MonoFoldableWithKey mono, Monoid m) =>
(MonoKey mono -> Element mono -> m) -> mono -> m
ofoldMapWithKey (\MonoKey mono
k Element mono
a -> Endo a -> Dual (Endo a)
forall a. a -> Dual a
Dual ((a -> a) -> Endo a
forall a. (a -> a) -> Endo a
Endo (\a
b -> a -> MonoKey mono -> Element mono -> a
f a
b MonoKey mono
k Element mono
a))) mono
t)) a
z
class (MonoKeyed mono, MonoFoldableWithKey mono, MonoTraversable mono) => MonoTraversableWithKey mono where
{-# MINIMAL otraverseWithKey #-}
otraverseWithKey :: Applicative f => (MonoKey mono -> Element mono -> f (Element mono)) -> mono -> f mono
default otraverseWithKey :: (Applicative f, TraversableWithKey t, Element (t a) ~ a, MonoKey (t a) ~ Key t, t a ~ mono)
=> (MonoKey mono -> Element mono -> f (Element mono)) -> mono -> f mono
otraverseWithKey = (MonoKey mono -> Element mono -> f (Element mono))
-> mono -> f mono
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey
{-# INLINE omapWithKeyM #-}
omapWithKeyM :: Monad m => (MonoKey mono -> Element mono -> m (Element mono)) -> mono-> m mono
omapWithKeyM MonoKey mono -> Element mono -> m (Element mono)
f = WrappedMonad m mono -> m mono
forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad (WrappedMonad m mono -> m mono)
-> (mono -> WrappedMonad m mono) -> mono -> m mono
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MonoKey mono -> Element mono -> WrappedMonad m (Element mono))
-> mono -> WrappedMonad m mono
forall mono (f :: * -> *).
(MonoTraversableWithKey mono, Applicative f) =>
(MonoKey mono -> Element mono -> f (Element mono))
-> mono -> f mono
otraverseWithKey ((m (Element mono) -> WrappedMonad m (Element mono))
-> (Element mono -> m (Element mono))
-> Element mono
-> WrappedMonad m (Element mono)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m (Element mono) -> WrappedMonad m (Element mono)
forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad ((Element mono -> m (Element mono))
-> Element mono -> WrappedMonad m (Element mono))
-> (MonoKey mono -> Element mono -> m (Element mono))
-> MonoKey mono
-> Element mono
-> WrappedMonad m (Element mono)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonoKey mono -> Element mono -> m (Element mono)
f)
class MonoLookup mono where
{-# MINIMAL olookup #-}
olookup :: MonoKey mono -> mono -> Maybe (Element mono)
default olookup :: (Lookup f, Element (f a) ~ a, MonoKey (f a) ~ Key f, f a ~ mono)
=> MonoKey mono -> mono -> Maybe (Element mono)
olookup = MonoKey mono -> mono -> Maybe (Element mono)
forall (f :: * -> *) a. Lookup f => Key f -> f a -> Maybe a
lookup
class MonoLookup mono => MonoIndexable mono where
{-# MINIMAL oindex #-}
oindex :: mono -> MonoKey mono -> Element mono
default oindex :: (Indexable f, Element (f a) ~ a, MonoKey (f a) ~ Key f, f a ~ mono)
=> mono -> MonoKey mono -> Element mono
oindex = mono -> MonoKey mono -> Element mono
forall (f :: * -> *) a. Indexable f => f a -> Key f -> a
index
class MonoFunctor mono => MonoAdjustable mono where
{-# MINIMAL oadjust #-}
oadjust :: (Element mono -> Element mono) -> MonoKey mono -> mono -> mono
default oadjust :: (Adjustable f, Element (f a) ~ a, MonoKey (f a) ~ Key f, f a ~ mono)
=> (Element mono -> Element mono) -> MonoKey mono -> mono -> mono
oadjust = (Element mono -> Element mono) -> MonoKey mono -> mono -> mono
forall (f :: * -> *) a.
Adjustable f =>
(a -> a) -> Key f -> f a -> f a
adjust
oreplace :: MonoKey mono -> Element mono -> mono -> mono
oreplace MonoKey mono
k Element mono
v = (Element mono -> Element mono) -> MonoKey mono -> mono -> mono
forall mono.
MonoAdjustable mono =>
(Element mono -> Element mono) -> MonoKey mono -> mono -> mono
oadjust (Element mono -> Element mono -> Element mono
forall a b. a -> b -> a
const Element mono
v) MonoKey mono
k
class MonoFunctor mono => MonoZip mono where
{-# MINIMAL ozipWith #-}
ozipWith :: (Element mono -> Element mono -> Element mono) -> mono -> mono -> mono
class (MonoKeyed mono, MonoZip mono) => MonoZipWithKey mono where
{-# MINIMAL ozipWithKey #-}
ozipWithKey :: (MonoKey mono -> Element mono -> Element mono -> Element mono) -> mono -> mono -> mono
instance MonoKeyed (r -> a) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (r -> a) -> Element (r -> a) -> Element (r -> a))
-> (r -> a) -> r -> a
omapWithKey = (MonoKey (r -> a) -> Element (r -> a) -> Element (r -> a))
-> (r -> a) -> r -> a
forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey
instance MonoKeyed [a]
instance MonoKeyed (a, b) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (a, b) -> Element (a, b) -> Element (a, b))
-> (a, b) -> (a, b)
omapWithKey = (MonoKey (a, b) -> Element (a, b) -> Element (a, b))
-> (a, b) -> (a, b)
forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey
instance MonoKeyed (Arg a b) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (Arg a b) -> Element (Arg a b) -> Element (Arg a b))
-> Arg a b -> Arg a b
omapWithKey = (MonoKey (Arg a b) -> Element (Arg a b) -> Element (Arg a b))
-> Arg a b -> Arg a b
forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey
instance MonoKeyed BS.ByteString where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey ByteString -> Element ByteString -> Element ByteString)
-> ByteString -> ByteString
omapWithKey MonoKey ByteString -> Element ByteString -> Element ByteString
f = (Int, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((Int, ByteString) -> ByteString)
-> (ByteString -> (Int, ByteString)) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Word8 -> (Int, Word8))
-> Int -> ByteString -> (Int, ByteString)
forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
BS.mapAccumL Int -> Word8 -> (Int, Word8)
g Int
0
where
g :: Int -> Word8 -> (Int, Word8)
g Int
k Word8
v = (Int -> Int
forall a. Enum a => a -> a
succ Int
k, MonoKey ByteString -> Element ByteString -> Element ByteString
f Int
MonoKey ByteString
k Word8
Element ByteString
v)
instance MonoKeyed BSL.ByteString where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey ByteString -> Element ByteString -> Element ByteString)
-> ByteString -> ByteString
omapWithKey MonoKey ByteString -> Element ByteString -> Element ByteString
f = (Int, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((Int, ByteString) -> ByteString)
-> (ByteString -> (Int, ByteString)) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Word8 -> (Int, Word8))
-> Int -> ByteString -> (Int, ByteString)
forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
BSL.mapAccumL Int -> Word8 -> (Int, Word8)
g Int
0
where
g :: Int -> Word8 -> (Int, Word8)
g Int
k Word8
v = (Int -> Int
forall a. Enum a => a -> a
succ Int
k, MonoKey ByteString -> Element ByteString -> Element ByteString
f Int
MonoKey ByteString
k Word8
Element ByteString
v)
instance ( Keyed f
, Keyed g
, MonoKey (f a) ~ Key f
, MonoKey (g a) ~ Key g
) => MonoKeyed (Compose f g a)
instance MonoKeyed (Const m a) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (Const m a) -> Element (Const m a) -> Element (Const m a))
-> Const m a -> Const m a
omapWithKey = (MonoKey (Const m a) -> Element (Const m a) -> Element (Const m a))
-> Const m a -> Const m a
forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey
instance Functor m => MonoKeyed (ContT r m a) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (ContT r m a)
-> Element (ContT r m a) -> Element (ContT r m a))
-> ContT r m a -> ContT r m a
omapWithKey = (MonoKey (ContT r m a)
-> Element (ContT r m a) -> Element (ContT r m a))
-> ContT r m a -> ContT r m a
forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey
instance MonoKeyed (Either a b) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (Either a b)
-> Element (Either a b) -> Element (Either a b))
-> Either a b -> Either a b
omapWithKey = (MonoKey (Either a b)
-> Element (Either a b) -> Element (Either a b))
-> Either a b -> Either a b
forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey
instance MonoKeyed (HashMap k v)
instance MonoKeyed (Identity a)
instance Functor m => MonoKeyed (IdentityT m a) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (IdentityT m a)
-> Element (IdentityT m a) -> Element (IdentityT m a))
-> IdentityT m a -> IdentityT m a
omapWithKey = (MonoKey (IdentityT m a)
-> Element (IdentityT m a) -> Element (IdentityT m a))
-> IdentityT m a -> IdentityT m a
forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey
instance MonoKeyed (IntMap a)
instance MonoKeyed (IO a) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (IO a) -> Element (IO a) -> Element (IO a))
-> IO a -> IO a
omapWithKey = (MonoKey (IO a) -> Element (IO a) -> Element (IO a))
-> IO a -> IO a
forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey
instance Functor m => MonoKeyed (ListT m a) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (ListT m a) -> Element (ListT m a) -> Element (ListT m a))
-> ListT m a -> ListT m a
omapWithKey MonoKey (ListT m a) -> Element (ListT m a) -> Element (ListT m a)
f = m [a] -> ListT m a
forall (m :: * -> *) a. m [a] -> ListT m a
ListT (m [a] -> ListT m a)
-> (ListT m a -> m [a]) -> ListT m a -> ListT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((MonoKey [a] -> Element [a] -> Element [a]) -> [a] -> [a]
forall mono.
MonoKeyed mono =>
(MonoKey mono -> Element mono -> Element mono) -> mono -> mono
omapWithKey MonoKey [a] -> Element [a] -> Element [a]
MonoKey (ListT m a) -> Element (ListT m a) -> Element (ListT m a)
f) (m [a] -> m [a]) -> (ListT m a -> m [a]) -> ListT m a -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListT m a -> m [a]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT
instance MonoKeyed (Map k v)
instance MonoKeyed (Maybe a)
instance Functor m => MonoKeyed (MaybeT m a) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (MaybeT m a)
-> Element (MaybeT m a) -> Element (MaybeT m a))
-> MaybeT m a -> MaybeT m a
omapWithKey = (MonoKey (MaybeT m a)
-> Element (MaybeT m a) -> Element (MaybeT m a))
-> MaybeT m a -> MaybeT m a
forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey
instance MonoKeyed (NonEmpty a)
#if MIN_VERSION_base(4,16,0)
#else
instance MonoKeyed (Option a) where
{-# INLINE omapWithKey #-}
omapWithKey = omapWithUnitKey
#endif
instance ( Keyed f
, Keyed g
, MonoKey (f a) ~ Key f
, MonoKey (g a) ~ Key g
) => MonoKeyed (Product f g a)
instance Keyed m => MonoKeyed (ReaderT r m a)
instance Functor m => MonoKeyed (RWST r w s m a) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (RWST r w s m a)
-> Element (RWST r w s m a) -> Element (RWST r w s m a))
-> RWST r w s m a -> RWST r w s m a
omapWithKey = (MonoKey (RWST r w s m a)
-> Element (RWST r w s m a) -> Element (RWST r w s m a))
-> RWST r w s m a -> RWST r w s m a
forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey
instance Functor m => MonoKeyed (S.RWST r w s m a) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (RWST r w s m a)
-> Element (RWST r w s m a) -> Element (RWST r w s m a))
-> RWST r w s m a -> RWST r w s m a
omapWithKey = (MonoKey (RWST r w s m a)
-> Element (RWST r w s m a) -> Element (RWST r w s m a))
-> RWST r w s m a -> RWST r w s m a
forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey
instance MonoKeyed (Seq a)
instance Functor m => MonoKeyed (StateT s m a) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (StateT s m a)
-> Element (StateT s m a) -> Element (StateT s m a))
-> StateT s m a -> StateT s m a
omapWithKey = (MonoKey (StateT s m a)
-> Element (StateT s m a) -> Element (StateT s m a))
-> StateT s m a -> StateT s m a
forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey
instance Functor m => MonoKeyed (S.StateT s m a) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (StateT s m a)
-> Element (StateT s m a) -> Element (StateT s m a))
-> StateT s m a -> StateT s m a
omapWithKey = (MonoKey (StateT s m a)
-> Element (StateT s m a) -> Element (StateT s m a))
-> StateT s m a -> StateT s m a
forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey
instance MonoKeyed T.Text where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey Text -> Element Text -> Element Text) -> Text -> Text
omapWithKey MonoKey Text -> Element Text -> Element Text
f = (Int, Text) -> Text
forall a b. (a, b) -> b
snd ((Int, Text) -> Text) -> (Text -> (Int, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char -> (Int, Char)) -> Int -> Text -> (Int, Text)
forall a. (a -> Char -> (a, Char)) -> a -> Text -> (a, Text)
T.mapAccumL Int -> Char -> (Int, Char)
g Int
0
where
g :: Int -> Char -> (Int, Char)
g Int
k Char
v = (Int -> Int
forall a. Enum a => a -> a
succ Int
k, MonoKey Text -> Element Text -> Element Text
f Int
MonoKey Text
k Char
Element Text
v)
instance MonoKeyed TL.Text where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey Text -> Element Text -> Element Text) -> Text -> Text
omapWithKey MonoKey Text -> Element Text -> Element Text
f = (Int, Text) -> Text
forall a b. (a, b) -> b
snd ((Int, Text) -> Text) -> (Text -> (Int, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Char -> (Int, Char)) -> Int -> Text -> (Int, Text)
forall a. (a -> Char -> (a, Char)) -> a -> Text -> (a, Text)
TL.mapAccumL Int -> Char -> (Int, Char)
g Int
0
where
g :: Int -> Char -> (Int, Char)
g Int
k Char
v = (Int -> Int
forall a. Enum a => a -> a
succ Int
k, MonoKey Text -> Element Text -> Element Text
f Int
MonoKey Text
k Char
Element Text
v)
instance MonoKeyed (Tree a)
instance MonoKeyed (Vector a)
instance VU.Unbox a => MonoKeyed (VU.Vector a) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (Vector a) -> Element (Vector a) -> Element (Vector a))
-> Vector a -> Vector a
omapWithKey = (MonoKey (Vector a) -> Element (Vector a) -> Element (Vector a))
-> Vector a -> Vector a
forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> Vector a -> Vector b
VU.imap
instance VS.Storable a => MonoKeyed (VS.Vector a) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (Vector a) -> Element (Vector a) -> Element (Vector a))
-> Vector a -> Vector a
omapWithKey = (MonoKey (Vector a) -> Element (Vector a) -> Element (Vector a))
-> Vector a -> Vector a
forall a b.
(Storable a, Storable b) =>
(Int -> a -> b) -> Vector a -> Vector b
VS.imap
instance MonoKeyed (ViewL a) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (ViewL a) -> Element (ViewL a) -> Element (ViewL a))
-> ViewL a -> ViewL a
omapWithKey = (MonoKey (ViewL a) -> Element (ViewL a) -> Element (ViewL a))
-> ViewL a -> ViewL a
forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey
instance MonoKeyed (ViewR a) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (ViewR a) -> Element (ViewR a) -> Element (ViewR a))
-> ViewR a -> ViewR a
omapWithKey = (MonoKey (ViewR a) -> Element (ViewR a) -> Element (ViewR a))
-> ViewR a -> ViewR a
forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey
instance Arrow a => MonoKeyed (WrappedArrow a b c) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (WrappedArrow a b c)
-> Element (WrappedArrow a b c) -> Element (WrappedArrow a b c))
-> WrappedArrow a b c -> WrappedArrow a b c
omapWithKey = (MonoKey (WrappedArrow a b c)
-> Element (WrappedArrow a b c) -> Element (WrappedArrow a b c))
-> WrappedArrow a b c -> WrappedArrow a b c
forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey
instance Monad m => MonoKeyed (WrappedMonad m a) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (WrappedMonad m a)
-> Element (WrappedMonad m a) -> Element (WrappedMonad m a))
-> WrappedMonad m a -> WrappedMonad m a
omapWithKey = (MonoKey (WrappedMonad m a)
-> Element (WrappedMonad m a) -> Element (WrappedMonad m a))
-> WrappedMonad m a -> WrappedMonad m a
forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey
instance Functor m => MonoKeyed (WriterT w m a) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (WriterT w m a)
-> Element (WriterT w m a) -> Element (WriterT w m a))
-> WriterT w m a -> WriterT w m a
omapWithKey = (MonoKey (WriterT w m a)
-> Element (WriterT w m a) -> Element (WriterT w m a))
-> WriterT w m a -> WriterT w m a
forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey
instance Functor m => MonoKeyed (S.WriterT w m a) where
{-# INLINE omapWithKey #-}
omapWithKey :: (MonoKey (WriterT w m a)
-> Element (WriterT w m a) -> Element (WriterT w m a))
-> WriterT w m a -> WriterT w m a
omapWithKey = (MonoKey (WriterT w m a)
-> Element (WriterT w m a) -> Element (WriterT w m a))
-> WriterT w m a -> WriterT w m a
forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey
instance MonoKeyed (ZipList a)
instance MonoFoldableWithKey [a] where
{-# INLINE ofoldlWithKey #-}
ofoldlWithKey :: forall a. (a -> MonoKey [a] -> Element [a] -> a) -> a -> [a] -> a
ofoldlWithKey = (a -> MonoKey [a] -> Element [a] -> a) -> a -> [a] -> a
forall i mono a.
(Integral i, MonoFoldable mono) =>
(a -> i -> Element mono -> a) -> a -> mono -> a
monoFoldableWithIntegralKey
instance MonoFoldableWithKey (a, b) where
{-# INLINE ofoldMapWithKey #-}
ofoldMapWithKey :: forall m.
Monoid m =>
(MonoKey (a, b) -> Element (a, b) -> m) -> (a, b) -> m
ofoldMapWithKey = (MonoKey (a, b) -> Element (a, b) -> m) -> (a, b) -> m
forall m mono.
(Monoid m, MonoFoldable mono) =>
(() -> Element mono -> m) -> mono -> m
monoFoldableWithUnitKey
instance MonoFoldableWithKey BS.ByteString where
{-# INLINE ofoldlWithKey #-}
ofoldlWithKey :: forall a.
(a -> MonoKey ByteString -> Element ByteString -> a)
-> a -> ByteString -> a
ofoldlWithKey = (a -> MonoKey ByteString -> Element ByteString -> a)
-> a -> ByteString -> a
forall i mono a.
(Integral i, MonoFoldable mono) =>
(a -> i -> Element mono -> a) -> a -> mono -> a
monoFoldableWithIntegralKey
instance MonoFoldableWithKey BSL.ByteString where
{-# INLINE ofoldlWithKey #-}
ofoldlWithKey :: forall a.
(a -> MonoKey ByteString -> Element ByteString -> a)
-> a -> ByteString -> a
ofoldlWithKey = (a -> MonoKey ByteString -> Element ByteString -> a)
-> a -> ByteString -> a
forall i mono a.
(Integral i, MonoFoldable mono) =>
(a -> i -> Element mono -> a) -> a -> mono -> a
monoFoldableWithIntegralKey
instance ( FoldableWithKey f
, FoldableWithKey g
, MonoKey (f a) ~ Key f
, MonoKey (g a) ~ Key g
) => MonoFoldableWithKey (Compose f g a) where
{-# INLINE ofoldMapWithKey #-}
{-# INLINE ofoldrWithKey #-}
{-# INLINE ofoldlWithKey #-}
ofoldMapWithKey :: forall m.
Monoid m =>
(MonoKey (Compose f g a) -> Element (Compose f g a) -> m)
-> Compose f g a -> m
ofoldMapWithKey = (MonoKey (Compose f g a) -> Element (Compose f g a) -> m)
-> Compose f g a -> m
forall (t :: * -> *) m a.
(FoldableWithKey t, Monoid m) =>
(Key t -> a -> m) -> t a -> m
foldMapWithKey
ofoldrWithKey :: forall a.
(MonoKey (Compose f g a) -> Element (Compose f g a) -> a -> a)
-> a -> Compose f g a -> a
ofoldrWithKey = (MonoKey (Compose f g a) -> Element (Compose f g a) -> a -> a)
-> a -> Compose f g a -> a
forall (t :: * -> *) a b.
FoldableWithKey t =>
(Key t -> a -> b -> b) -> b -> t a -> b
foldrWithKey
ofoldlWithKey :: forall a.
(a -> MonoKey (Compose f g a) -> Element (Compose f g a) -> a)
-> a -> Compose f g a -> a
ofoldlWithKey = (a -> MonoKey (Compose f g a) -> Element (Compose f g a) -> a)
-> a -> Compose f g a -> a
forall (t :: * -> *) b a.
FoldableWithKey t =>
(b -> Key t -> a -> b) -> b -> t a -> b
foldlWithKey
instance MonoFoldableWithKey (Const m a) where
{-# INLINE ofoldMapWithKey #-}
ofoldMapWithKey :: forall m.
Monoid m =>
(MonoKey (Const m a) -> Element (Const m a) -> m) -> Const m a -> m
ofoldMapWithKey = (MonoKey (Const m a) -> Element (Const m a) -> m) -> Const m a -> m
forall m mono.
(Monoid m, MonoFoldable mono) =>
(() -> Element mono -> m) -> mono -> m
monoFoldableWithUnitKey
instance MonoFoldableWithKey (Either a b) where
{-# INLINE ofoldMapWithKey #-}
ofoldMapWithKey :: forall m.
Monoid m =>
(MonoKey (Either a b) -> Element (Either a b) -> m)
-> Either a b -> m
ofoldMapWithKey = (MonoKey (Either a b) -> Element (Either a b) -> m)
-> Either a b -> m
forall m mono.
(Monoid m, MonoFoldable mono) =>
(() -> Element mono -> m) -> mono -> m
monoFoldableWithUnitKey
instance MonoFoldableWithKey (HashMap k v) where
{-# INLINE ofoldrWithKey #-}
{-# INLINE ofoldlWithKey #-}
ofoldrWithKey :: forall a.
(MonoKey (HashMap k v) -> Element (HashMap k v) -> a -> a)
-> a -> HashMap k v -> a
ofoldrWithKey = (MonoKey (HashMap k v) -> Element (HashMap k v) -> a -> a)
-> a -> HashMap k v -> a
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HM.foldrWithKey
ofoldlWithKey :: forall a.
(a -> MonoKey (HashMap k v) -> Element (HashMap k v) -> a)
-> a -> HashMap k v -> a
ofoldlWithKey = (a -> MonoKey (HashMap k v) -> Element (HashMap k v) -> a)
-> a -> HashMap k v -> a
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
HM.foldlWithKey'
instance MonoFoldableWithKey (HashSet v) where
{-# INLINE ofoldlWithKey #-}
ofoldlWithKey :: forall a.
(a -> MonoKey (HashSet v) -> Element (HashSet v) -> a)
-> a -> HashSet v -> a
ofoldlWithKey = (a -> MonoKey (HashSet v) -> Element (HashSet v) -> a)
-> a -> HashSet v -> a
forall i mono a.
(Integral i, MonoFoldable mono) =>
(a -> i -> Element mono -> a) -> a -> mono -> a
monoFoldableWithIntegralKey
instance MonoFoldableWithKey (Identity a) where
{-# INLINE ofoldMapWithKey #-}
ofoldMapWithKey :: forall m.
Monoid m =>
(MonoKey (Identity a) -> Element (Identity a) -> m)
-> Identity a -> m
ofoldMapWithKey = (MonoKey (Identity a) -> Element (Identity a) -> m)
-> Identity a -> m
forall m mono.
(Monoid m, MonoFoldable mono) =>
(() -> Element mono -> m) -> mono -> m
monoFoldableWithUnitKey
instance Foldable f => MonoFoldableWithKey (IdentityT f a) where
{-# INLINE ofoldMapWithKey #-}
ofoldMapWithKey :: forall m.
Monoid m =>
(MonoKey (IdentityT f a) -> Element (IdentityT f a) -> m)
-> IdentityT f a -> m
ofoldMapWithKey = (MonoKey (IdentityT f a) -> Element (IdentityT f a) -> m)
-> IdentityT f a -> m
forall m mono.
(Monoid m, MonoFoldable mono) =>
(() -> Element mono -> m) -> mono -> m
monoFoldableWithUnitKey
instance MonoFoldableWithKey (IntMap a) where
{-# INLINE ofoldMapWithKey #-}
{-# INLINE ofoldrWithKey #-}
{-# INLINE ofoldlWithKey #-}
ofoldMapWithKey :: forall m.
Monoid m =>
(MonoKey (IntMap a) -> Element (IntMap a) -> m) -> IntMap a -> m
ofoldMapWithKey = (MonoKey (IntMap a) -> Element (IntMap a) -> m) -> IntMap a -> m
forall m a. Monoid m => (Int -> a -> m) -> IntMap a -> m
IM.foldMapWithKey
ofoldrWithKey :: forall a.
(MonoKey (IntMap a) -> Element (IntMap a) -> a -> a)
-> a -> IntMap a -> a
ofoldrWithKey = (MonoKey (IntMap a) -> Element (IntMap a) -> a -> a)
-> a -> IntMap a -> a
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
IM.foldrWithKey
ofoldlWithKey :: forall a.
(a -> MonoKey (IntMap a) -> Element (IntMap a) -> a)
-> a -> IntMap a -> a
ofoldlWithKey = (a -> MonoKey (IntMap a) -> Element (IntMap a) -> a)
-> a -> IntMap a -> a
forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
IM.foldlWithKey'
instance MonoFoldableWithKey IntSet where
{-# INLINE ofoldlWithKey #-}
ofoldlWithKey :: forall a.
(a -> MonoKey IntSet -> Element IntSet -> a) -> a -> IntSet -> a
ofoldlWithKey = (a -> MonoKey IntSet -> Element IntSet -> a) -> a -> IntSet -> a
forall i mono a.
(Integral i, MonoFoldable mono) =>
(a -> i -> Element mono -> a) -> a -> mono -> a
monoFoldableWithIntegralKey
instance Foldable f => MonoFoldableWithKey (ListT f a) where
{-# INLINE ofoldlWithKey #-}
ofoldlWithKey :: forall a.
(a -> MonoKey (ListT f a) -> Element (ListT f a) -> a)
-> a -> ListT f a -> a
ofoldlWithKey = (a -> MonoKey (ListT f a) -> Element (ListT f a) -> a)
-> a -> ListT f a -> a
forall i mono a.
(Integral i, MonoFoldable mono) =>
(a -> i -> Element mono -> a) -> a -> mono -> a
monoFoldableWithIntegralKey
instance MonoFoldableWithKey (Map k v) where
{-# INLINE ofoldMapWithKey #-}
{-# INLINE ofoldrWithKey #-}
{-# INLINE ofoldlWithKey #-}
ofoldMapWithKey :: forall m.
Monoid m =>
(MonoKey (Map k v) -> Element (Map k v) -> m) -> Map k v -> m
ofoldMapWithKey = (MonoKey (Map k v) -> Element (Map k v) -> m) -> Map k v -> m
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey
ofoldrWithKey :: forall a.
(MonoKey (Map k v) -> Element (Map k v) -> a -> a)
-> a -> Map k v -> a
ofoldrWithKey = (MonoKey (Map k v) -> Element (Map k v) -> a -> a)
-> a -> Map k v -> a
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey
ofoldlWithKey :: forall a.
(a -> MonoKey (Map k v) -> Element (Map k v) -> a)
-> a -> Map k v -> a
ofoldlWithKey = (a -> MonoKey (Map k v) -> Element (Map k v) -> a)
-> a -> Map k v -> a
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey'
instance MonoFoldableWithKey (Maybe a) where
{-# INLINE ofoldMapWithKey #-}
ofoldMapWithKey :: forall m.
Monoid m =>
(MonoKey (Maybe a) -> Element (Maybe a) -> m) -> Maybe a -> m
ofoldMapWithKey = (MonoKey (Maybe a) -> Element (Maybe a) -> m) -> Maybe a -> m
forall m mono.
(Monoid m, MonoFoldable mono) =>
(() -> Element mono -> m) -> mono -> m
monoFoldableWithUnitKey
instance Foldable f => MonoFoldableWithKey (MaybeT f a) where
{-# INLINE ofoldMapWithKey #-}
ofoldMapWithKey :: forall m.
Monoid m =>
(MonoKey (MaybeT f a) -> Element (MaybeT f a) -> m)
-> MaybeT f a -> m
ofoldMapWithKey = (MonoKey (MaybeT f a) -> Element (MaybeT f a) -> m)
-> MaybeT f a -> m
forall m mono.
(Monoid m, MonoFoldable mono) =>
(() -> Element mono -> m) -> mono -> m
monoFoldableWithUnitKey
instance MonoFoldableWithKey (NonEmpty a) where
{-# INLINE ofoldlWithKey #-}
ofoldlWithKey :: forall a.
(a -> MonoKey (NonEmpty a) -> Element (NonEmpty a) -> a)
-> a -> NonEmpty a -> a
ofoldlWithKey = (a -> MonoKey (NonEmpty a) -> Element (NonEmpty a) -> a)
-> a -> NonEmpty a -> a
forall i mono a.
(Integral i, MonoFoldable mono) =>
(a -> i -> Element mono -> a) -> a -> mono -> a
monoFoldableWithIntegralKey
#if MIN_VERSION_base(4,16,0)
#else
instance MonoFoldableWithKey (Option a) where
{-# INLINE ofoldMapWithKey #-}
ofoldMapWithKey = monoFoldableWithUnitKey
#endif
instance ( FoldableWithKey f
, FoldableWithKey g
, MonoKey (f a) ~ Key f
, MonoKey (g a) ~ Key g
) => MonoFoldableWithKey (Product f g a) where
{-# INLINE ofoldMapWithKey #-}
{-# INLINE ofoldrWithKey #-}
{-# INLINE ofoldlWithKey #-}
ofoldMapWithKey :: forall m.
Monoid m =>
(MonoKey (Product f g a) -> Element (Product f g a) -> m)
-> Product f g a -> m
ofoldMapWithKey = (MonoKey (Product f g a) -> Element (Product f g a) -> m)
-> Product f g a -> m
forall (t :: * -> *) m a.
(FoldableWithKey t, Monoid m) =>
(Key t -> a -> m) -> t a -> m
foldMapWithKey
ofoldrWithKey :: forall a.
(MonoKey (Product f g a) -> Element (Product f g a) -> a -> a)
-> a -> Product f g a -> a
ofoldrWithKey = (MonoKey (Product f g a) -> Element (Product f g a) -> a -> a)
-> a -> Product f g a -> a
forall (t :: * -> *) a b.
FoldableWithKey t =>
(Key t -> a -> b -> b) -> b -> t a -> b
foldrWithKey
ofoldlWithKey :: forall a.
(a -> MonoKey (Product f g a) -> Element (Product f g a) -> a)
-> a -> Product f g a -> a
ofoldlWithKey = (a -> MonoKey (Product f g a) -> Element (Product f g a) -> a)
-> a -> Product f g a -> a
forall (t :: * -> *) b a.
FoldableWithKey t =>
(b -> Key t -> a -> b) -> b -> t a -> b
foldlWithKey
instance MonoFoldableWithKey (Seq a) where
{-# INLINE ofoldMapWithKey #-}
{-# INLINE ofoldrWithKey #-}
{-# INLINE ofoldlWithKey #-}
ofoldMapWithKey :: forall m.
Monoid m =>
(MonoKey (Seq a) -> Element (Seq a) -> m) -> Seq a -> m
ofoldMapWithKey = (MonoKey (Seq a) -> Element (Seq a) -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(FoldableWithKey t, Monoid m) =>
(Key t -> a -> m) -> t a -> m
foldMapWithKey
ofoldrWithKey :: forall a.
(MonoKey (Seq a) -> Element (Seq a) -> a -> a) -> a -> Seq a -> a
ofoldrWithKey = (MonoKey (Seq a) -> Element (Seq a) -> a -> a) -> a -> Seq a -> a
forall a b. (Int -> a -> b -> b) -> b -> Seq a -> b
Seq.foldrWithIndex
ofoldlWithKey :: forall a.
(a -> MonoKey (Seq a) -> Element (Seq a) -> a) -> a -> Seq a -> a
ofoldlWithKey = (a -> MonoKey (Seq a) -> Element (Seq a) -> a) -> a -> Seq a -> a
forall b a. (b -> Int -> a -> b) -> b -> Seq a -> b
Seq.foldlWithIndex
instance Ord e => MonoFoldableWithKey (Set e) where
{-# INLINE ofoldlWithKey #-}
ofoldlWithKey :: forall a.
(a -> MonoKey (Set e) -> Element (Set e) -> a) -> a -> Set e -> a
ofoldlWithKey = (a -> MonoKey (Set e) -> Element (Set e) -> a) -> a -> Set e -> a
forall i mono a.
(Integral i, MonoFoldable mono) =>
(a -> i -> Element mono -> a) -> a -> mono -> a
monoFoldableWithIntegralKey
instance MonoFoldableWithKey T.Text where
{-# INLINE ofoldlWithKey #-}
ofoldlWithKey :: forall a.
(a -> MonoKey Text -> Element Text -> a) -> a -> Text -> a
ofoldlWithKey = (a -> MonoKey Text -> Element Text -> a) -> a -> Text -> a
forall i mono a.
(Integral i, MonoFoldable mono) =>
(a -> i -> Element mono -> a) -> a -> mono -> a
monoFoldableWithIntegralKey
instance MonoFoldableWithKey TL.Text where
{-# INLINE ofoldlWithKey #-}
ofoldlWithKey :: forall a.
(a -> MonoKey Text -> Element Text -> a) -> a -> Text -> a
ofoldlWithKey = (a -> MonoKey Text -> Element Text -> a) -> a -> Text -> a
forall i mono a.
(Integral i, MonoFoldable mono) =>
(a -> i -> Element mono -> a) -> a -> mono -> a
monoFoldableWithIntegralKey
instance MonoFoldableWithKey (Tree a) where
{-# INLINE ofoldMapWithKey #-}
{-# INLINE ofoldrWithKey #-}
{-# INLINE ofoldlWithKey #-}
ofoldMapWithKey :: forall m.
Monoid m =>
(MonoKey (Tree a) -> Element (Tree a) -> m) -> Tree a -> m
ofoldMapWithKey = (MonoKey (Tree a) -> Element (Tree a) -> m) -> Tree a -> m
forall (t :: * -> *) m a.
(FoldableWithKey t, Monoid m) =>
(Key t -> a -> m) -> t a -> m
foldMapWithKey
ofoldrWithKey :: forall a.
(MonoKey (Tree a) -> Element (Tree a) -> a -> a)
-> a -> Tree a -> a
ofoldrWithKey = (MonoKey (Tree a) -> Element (Tree a) -> a -> a)
-> a -> Tree a -> a
forall (t :: * -> *) a b.
FoldableWithKey t =>
(Key t -> a -> b -> b) -> b -> t a -> b
foldrWithKey
ofoldlWithKey :: forall a.
(a -> MonoKey (Tree a) -> Element (Tree a) -> a)
-> a -> Tree a -> a
ofoldlWithKey = (a -> MonoKey (Tree a) -> Element (Tree a) -> a)
-> a -> Tree a -> a
forall (t :: * -> *) b a.
FoldableWithKey t =>
(b -> Key t -> a -> b) -> b -> t a -> b
foldlWithKey
instance MonoFoldableWithKey (Vector a) where
{-# INLINE ofoldrWithKey #-}
{-# INLINE ofoldlWithKey #-}
ofoldrWithKey :: forall a.
(MonoKey (Vector a) -> Element (Vector a) -> a -> a)
-> a -> Vector a -> a
ofoldrWithKey = (MonoKey (Vector a) -> Element (Vector a) -> a -> a)
-> a -> Vector a -> a
forall a b. (Int -> a -> b -> b) -> b -> Vector a -> b
V.ifoldr
ofoldlWithKey :: forall a.
(a -> MonoKey (Vector a) -> Element (Vector a) -> a)
-> a -> Vector a -> a
ofoldlWithKey = (a -> MonoKey (Vector a) -> Element (Vector a) -> a)
-> a -> Vector a -> a
forall a b. (a -> Int -> b -> a) -> a -> Vector b -> a
V.ifoldl'
instance VU.Unbox a => MonoFoldableWithKey (VU.Vector a) where
{-# INLINE ofoldrWithKey #-}
{-# INLINE ofoldlWithKey #-}
ofoldrWithKey :: forall a.
(MonoKey (Vector a) -> Element (Vector a) -> a -> a)
-> a -> Vector a -> a
ofoldrWithKey = (MonoKey (Vector a) -> Element (Vector a) -> a -> a)
-> a -> Vector a -> a
forall a b. Unbox a => (Int -> a -> b -> b) -> b -> Vector a -> b
VU.ifoldr
ofoldlWithKey :: forall a.
(a -> MonoKey (Vector a) -> Element (Vector a) -> a)
-> a -> Vector a -> a
ofoldlWithKey = (a -> MonoKey (Vector a) -> Element (Vector a) -> a)
-> a -> Vector a -> a
forall b a. Unbox b => (a -> Int -> b -> a) -> a -> Vector b -> a
VU.ifoldl'
instance VS.Storable a => MonoFoldableWithKey (VS.Vector a) where
{-# INLINE ofoldrWithKey #-}
{-# INLINE ofoldlWithKey #-}
ofoldrWithKey :: forall a.
(MonoKey (Vector a) -> Element (Vector a) -> a -> a)
-> a -> Vector a -> a
ofoldrWithKey = (MonoKey (Vector a) -> Element (Vector a) -> a -> a)
-> a -> Vector a -> a
forall a b.
Storable a =>
(Int -> a -> b -> b) -> b -> Vector a -> b
VS.ifoldr
ofoldlWithKey :: forall a.
(a -> MonoKey (Vector a) -> Element (Vector a) -> a)
-> a -> Vector a -> a
ofoldlWithKey = (a -> MonoKey (Vector a) -> Element (Vector a) -> a)
-> a -> Vector a -> a
forall b a.
Storable b =>
(a -> Int -> b -> a) -> a -> Vector b -> a
VS.ifoldl'
instance MonoFoldableWithKey (ViewL a) where
{-# INLINE ofoldMapWithKey #-}
ofoldMapWithKey :: forall m.
Monoid m =>
(MonoKey (ViewL a) -> Element (ViewL a) -> m) -> ViewL a -> m
ofoldMapWithKey = (MonoKey (ViewL a) -> Element (ViewL a) -> m) -> ViewL a -> m
forall m mono.
(Monoid m, MonoFoldable mono) =>
(() -> Element mono -> m) -> mono -> m
monoFoldableWithUnitKey
instance MonoFoldableWithKey (ViewR a) where
{-# INLINE ofoldMapWithKey #-}
ofoldMapWithKey :: forall m.
Monoid m =>
(MonoKey (ViewR a) -> Element (ViewR a) -> m) -> ViewR a -> m
ofoldMapWithKey = (MonoKey (ViewR a) -> Element (ViewR a) -> m) -> ViewR a -> m
forall m mono.
(Monoid m, MonoFoldable mono) =>
(() -> Element mono -> m) -> mono -> m
monoFoldableWithUnitKey
instance Foldable f => MonoFoldableWithKey (WriterT w f a) where
{-# INLINE ofoldMapWithKey #-}
ofoldMapWithKey :: forall m.
Monoid m =>
(MonoKey (WriterT w f a) -> Element (WriterT w f a) -> m)
-> WriterT w f a -> m
ofoldMapWithKey = (MonoKey (WriterT w f a) -> Element (WriterT w f a) -> m)
-> WriterT w f a -> m
forall m mono.
(Monoid m, MonoFoldable mono) =>
(() -> Element mono -> m) -> mono -> m
monoFoldableWithUnitKey
instance Foldable f => MonoFoldableWithKey (S.WriterT w f a) where
{-# INLINE ofoldMapWithKey #-}
ofoldMapWithKey :: forall m.
Monoid m =>
(MonoKey (WriterT w f a) -> Element (WriterT w f a) -> m)
-> WriterT w f a -> m
ofoldMapWithKey = (MonoKey (WriterT w f a) -> Element (WriterT w f a) -> m)
-> WriterT w f a -> m
forall m mono.
(Monoid m, MonoFoldable mono) =>
(() -> Element mono -> m) -> mono -> m
monoFoldableWithUnitKey
instance MonoTraversableWithKey [a] where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey [a] -> Element [a] -> f (Element [a])) -> [a] -> f [a]
otraverseWithKey = (MonoKey [a] -> Element [a] -> f (Element [a])) -> [a] -> f [a]
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey
instance MonoTraversableWithKey (a, b) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (a, b) -> Element (a, b) -> f (Element (a, b)))
-> (a, b) -> f (a, b)
otraverseWithKey = (MonoKey (a, b) -> Element (a, b) -> f (Element (a, b)))
-> (a, b) -> f (a, b)
forall (f :: * -> *) mono.
(Applicative f, MonoTraversable mono) =>
(() -> Element mono -> f (Element mono)) -> mono -> f mono
monoTraversableWithUnitKey
instance MonoTraversableWithKey BS.ByteString where
{-# INLINE otraverseWithKey #-}
{-# INLINE omapWithKeyM #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey ByteString
-> Element ByteString -> f (Element ByteString))
-> ByteString -> f ByteString
otraverseWithKey MonoKey ByteString -> Element ByteString -> f (Element ByteString)
f = ([Word8] -> ByteString) -> f [Word8] -> f ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
BS.pack (f [Word8] -> f ByteString)
-> (ByteString -> f [Word8]) -> ByteString -> f ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key [] -> Word8 -> f Word8) -> [Word8] -> f [Word8]
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey Key [] -> Word8 -> f Word8
MonoKey ByteString -> Element ByteString -> f (Element ByteString)
f ([Word8] -> f [Word8])
-> (ByteString -> [Word8]) -> ByteString -> f [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack
omapWithKeyM :: forall (m :: * -> *).
Monad m =>
(MonoKey ByteString
-> Element ByteString -> m (Element ByteString))
-> ByteString -> m ByteString
omapWithKeyM MonoKey ByteString -> Element ByteString -> m (Element ByteString)
f = ([Word8] -> ByteString) -> m [Word8] -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
BS.pack (m [Word8] -> m ByteString)
-> (ByteString -> m [Word8]) -> ByteString -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key [] -> Word8 -> m Word8) -> [Word8] -> m [Word8]
forall (t :: * -> *) (m :: * -> *) a b.
(TraversableWithKey t, Monad m) =>
(Key t -> a -> m b) -> t a -> m (t b)
mapWithKeyM Key [] -> Word8 -> m Word8
MonoKey ByteString -> Element ByteString -> m (Element ByteString)
f ([Word8] -> m [Word8])
-> (ByteString -> [Word8]) -> ByteString -> m [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack
instance MonoTraversableWithKey BSL.ByteString where
{-# INLINE otraverseWithKey #-}
{-# INLINE omapWithKeyM #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey ByteString
-> Element ByteString -> f (Element ByteString))
-> ByteString -> f ByteString
otraverseWithKey MonoKey ByteString -> Element ByteString -> f (Element ByteString)
f = ([Word8] -> ByteString) -> f [Word8] -> f ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
BSL.pack (f [Word8] -> f ByteString)
-> (ByteString -> f [Word8]) -> ByteString -> f ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key [] -> Word8 -> f Word8) -> [Word8] -> f [Word8]
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey Key [] -> Word8 -> f Word8
MonoKey ByteString -> Element ByteString -> f (Element ByteString)
f ([Word8] -> f [Word8])
-> (ByteString -> [Word8]) -> ByteString -> f [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BSL.unpack
omapWithKeyM :: forall (m :: * -> *).
Monad m =>
(MonoKey ByteString
-> Element ByteString -> m (Element ByteString))
-> ByteString -> m ByteString
omapWithKeyM MonoKey ByteString -> Element ByteString -> m (Element ByteString)
f = ([Word8] -> ByteString) -> m [Word8] -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
BSL.pack (m [Word8] -> m ByteString)
-> (ByteString -> m [Word8]) -> ByteString -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key [] -> Word8 -> m Word8) -> [Word8] -> m [Word8]
forall (t :: * -> *) (m :: * -> *) a b.
(TraversableWithKey t, Monad m) =>
(Key t -> a -> m b) -> t a -> m (t b)
mapWithKeyM Key [] -> Word8 -> m Word8
MonoKey ByteString -> Element ByteString -> m (Element ByteString)
f ([Word8] -> m [Word8])
-> (ByteString -> [Word8]) -> ByteString -> m [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BSL.unpack
instance ( MonoKey (f a) ~ Key f
, MonoKey (g a) ~ Key g
, TraversableWithKey f
, TraversableWithKey g
) => MonoTraversableWithKey (Compose f g a) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (Compose f g a)
-> Element (Compose f g a) -> f (Element (Compose f g a)))
-> Compose f g a -> f (Compose f g a)
otraverseWithKey = (MonoKey (Compose f g a)
-> Element (Compose f g a) -> f (Element (Compose f g a)))
-> Compose f g a -> f (Compose f g a)
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey
instance MonoTraversableWithKey (Const m a) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (Const m a)
-> Element (Const m a) -> f (Element (Const m a)))
-> Const m a -> f (Const m a)
otraverseWithKey = (MonoKey (Const m a)
-> Element (Const m a) -> f (Element (Const m a)))
-> Const m a -> f (Const m a)
forall (f :: * -> *) mono.
(Applicative f, MonoTraversable mono) =>
(() -> Element mono -> f (Element mono)) -> mono -> f mono
monoTraversableWithUnitKey
instance MonoTraversableWithKey (Either a b) where
{-# INLINE otraverseWithKey #-}
{-# INLINE omapWithKeyM #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (Either a b)
-> Element (Either a b) -> f (Element (Either a b)))
-> Either a b -> f (Either a b)
otraverseWithKey MonoKey (Either a b)
-> Element (Either a b) -> f (Element (Either a b))
_ (Left a
a) = Either a b -> f (Either a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a b -> f (Either a b)) -> Either a b -> f (Either a b)
forall a b. (a -> b) -> a -> b
$ a -> Either a b
forall a b. a -> Either a b
Left a
a
otraverseWithKey MonoKey (Either a b)
-> Element (Either a b) -> f (Element (Either a b))
f (Right b
b) = b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> f b -> f (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MonoKey (Either a b)
-> Element (Either a b) -> f (Element (Either a b))
f () b
Element (Either a b)
b
omapWithKeyM :: forall (m :: * -> *).
Monad m =>
(MonoKey (Either a b)
-> Element (Either a b) -> m (Element (Either a b)))
-> Either a b -> m (Either a b)
omapWithKeyM = (MonoKey (Either a b)
-> Element (Either a b) -> m (Element (Either a b)))
-> Either a b -> m (Either a b)
forall mono (f :: * -> *).
(MonoTraversableWithKey mono, Applicative f) =>
(MonoKey mono -> Element mono -> f (Element mono))
-> mono -> f mono
otraverseWithKey
instance MonoTraversableWithKey (HashMap k v) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (HashMap k v)
-> Element (HashMap k v) -> f (Element (HashMap k v)))
-> HashMap k v -> f (HashMap k v)
otraverseWithKey = (MonoKey (HashMap k v)
-> Element (HashMap k v) -> f (Element (HashMap k v)))
-> HashMap k v -> f (HashMap k v)
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey
instance MonoTraversableWithKey (Identity a) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (Identity a)
-> Element (Identity a) -> f (Element (Identity a)))
-> Identity a -> f (Identity a)
otraverseWithKey = (MonoKey (Identity a)
-> Element (Identity a) -> f (Element (Identity a)))
-> Identity a -> f (Identity a)
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey
instance Traversable f => MonoTraversableWithKey (IdentityT f a) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (IdentityT f a)
-> Element (IdentityT f a) -> f (Element (IdentityT f a)))
-> IdentityT f a -> f (IdentityT f a)
otraverseWithKey = (MonoKey (IdentityT f a)
-> Element (IdentityT f a) -> f (Element (IdentityT f a)))
-> IdentityT f a -> f (IdentityT f a)
forall (f :: * -> *) mono.
(Applicative f, MonoTraversable mono) =>
(() -> Element mono -> f (Element mono)) -> mono -> f mono
monoTraversableWithUnitKey
instance MonoTraversableWithKey (IntMap a) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (IntMap a)
-> Element (IntMap a) -> f (Element (IntMap a)))
-> IntMap a -> f (IntMap a)
otraverseWithKey = (MonoKey (IntMap a)
-> Element (IntMap a) -> f (Element (IntMap a)))
-> IntMap a -> f (IntMap a)
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey
instance Traversable f => MonoTraversableWithKey (ListT f a) where
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (ListT f a)
-> Element (ListT f a) -> f (Element (ListT f a)))
-> ListT f a -> f (ListT f a)
otraverseWithKey MonoKey (ListT f a)
-> Element (ListT f a) -> f (Element (ListT f a))
f = (f [a] -> ListT f a) -> f (f [a]) -> f (ListT f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f [a] -> ListT f a
forall (m :: * -> *) a. m [a] -> ListT m a
ListT (f (f [a]) -> f (ListT f a))
-> (ListT f a -> f (f [a])) -> ListT f a -> f (ListT f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> f [a]) -> f [a] -> f (f [a])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Key [] -> a -> f a) -> [a] -> f [a]
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey Key [] -> a -> f a
MonoKey (ListT f a)
-> Element (ListT f a) -> f (Element (ListT f a))
f) (f [a] -> f (f [a]))
-> (ListT f a -> f [a]) -> ListT f a -> f (f [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListT f a -> f [a]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT
instance MonoTraversableWithKey (Map k v) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (Map k v) -> Element (Map k v) -> f (Element (Map k v)))
-> Map k v -> f (Map k v)
otraverseWithKey = (MonoKey (Map k v) -> Element (Map k v) -> f (Element (Map k v)))
-> Map k v -> f (Map k v)
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey
instance MonoTraversableWithKey (Maybe a) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (Maybe a) -> Element (Maybe a) -> f (Element (Maybe a)))
-> Maybe a -> f (Maybe a)
otraverseWithKey = (MonoKey (Maybe a) -> Element (Maybe a) -> f (Element (Maybe a)))
-> Maybe a -> f (Maybe a)
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey
instance Traversable f => MonoTraversableWithKey (MaybeT f a) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (MaybeT f a)
-> Element (MaybeT f a) -> f (Element (MaybeT f a)))
-> MaybeT f a -> f (MaybeT f a)
otraverseWithKey = (MonoKey (MaybeT f a)
-> Element (MaybeT f a) -> f (Element (MaybeT f a)))
-> MaybeT f a -> f (MaybeT f a)
forall (f :: * -> *) mono.
(Applicative f, MonoTraversable mono) =>
(() -> Element mono -> f (Element mono)) -> mono -> f mono
monoTraversableWithUnitKey
instance MonoTraversableWithKey (NonEmpty a) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (NonEmpty a)
-> Element (NonEmpty a) -> f (Element (NonEmpty a)))
-> NonEmpty a -> f (NonEmpty a)
otraverseWithKey = (MonoKey (NonEmpty a)
-> Element (NonEmpty a) -> f (Element (NonEmpty a)))
-> NonEmpty a -> f (NonEmpty a)
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey
#if MIN_VERSION_base(4,16,0)
#else
instance MonoTraversableWithKey (Option a) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey = monoTraversableWithUnitKey
#endif
instance ( MonoKey (f a) ~ Key f
, MonoKey (g a) ~ Key g
, TraversableWithKey f
, TraversableWithKey g
) => MonoTraversableWithKey (Product f g a) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (Product f g a)
-> Element (Product f g a) -> f (Element (Product f g a)))
-> Product f g a -> f (Product f g a)
otraverseWithKey = (MonoKey (Product f g a)
-> Element (Product f g a) -> f (Element (Product f g a)))
-> Product f g a -> f (Product f g a)
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey
instance MonoTraversableWithKey (Seq a) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (Seq a) -> Element (Seq a) -> f (Element (Seq a)))
-> Seq a -> f (Seq a)
otraverseWithKey = (MonoKey (Seq a) -> Element (Seq a) -> f (Element (Seq a)))
-> Seq a -> f (Seq a)
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey
instance MonoTraversableWithKey T.Text where
{-# INLINE otraverseWithKey #-}
{-# INLINE omapWithKeyM #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey Text -> Element Text -> f (Element Text))
-> Text -> f Text
otraverseWithKey MonoKey Text -> Element Text -> f (Element Text)
f = (String -> Text) -> f String -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (f String -> f Text) -> (Text -> f String) -> Text -> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key [] -> Char -> f Char) -> String -> f String
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey Key [] -> Char -> f Char
MonoKey Text -> Element Text -> f (Element Text)
f (String -> f String) -> (Text -> String) -> Text -> f String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
omapWithKeyM :: forall (m :: * -> *).
Monad m =>
(MonoKey Text -> Element Text -> m (Element Text))
-> Text -> m Text
omapWithKeyM MonoKey Text -> Element Text -> m (Element Text)
f = (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (m String -> m Text) -> (Text -> m String) -> Text -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key [] -> Char -> m Char) -> String -> m String
forall (t :: * -> *) (m :: * -> *) a b.
(TraversableWithKey t, Monad m) =>
(Key t -> a -> m b) -> t a -> m (t b)
mapWithKeyM Key [] -> Char -> m Char
MonoKey Text -> Element Text -> m (Element Text)
f (String -> m String) -> (Text -> String) -> Text -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
instance MonoTraversableWithKey TL.Text where
{-# INLINE otraverseWithKey #-}
{-# INLINE omapWithKeyM #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey Text -> Element Text -> f (Element Text))
-> Text -> f Text
otraverseWithKey MonoKey Text -> Element Text -> f (Element Text)
f = (String -> Text) -> f String -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
TL.pack (f String -> f Text) -> (Text -> f String) -> Text -> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key [] -> Char -> f Char) -> String -> f String
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey Key [] -> Char -> f Char
MonoKey Text -> Element Text -> f (Element Text)
f (String -> f String) -> (Text -> String) -> Text -> f String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack
omapWithKeyM :: forall (m :: * -> *).
Monad m =>
(MonoKey Text -> Element Text -> m (Element Text))
-> Text -> m Text
omapWithKeyM MonoKey Text -> Element Text -> m (Element Text)
f = (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
TL.pack (m String -> m Text) -> (Text -> m String) -> Text -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key [] -> Char -> m Char) -> String -> m String
forall (t :: * -> *) (m :: * -> *) a b.
(TraversableWithKey t, Monad m) =>
(Key t -> a -> m b) -> t a -> m (t b)
mapWithKeyM Key [] -> Char -> m Char
MonoKey Text -> Element Text -> m (Element Text)
f (String -> m String) -> (Text -> String) -> Text -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack
instance MonoTraversableWithKey (Tree a) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (Tree a) -> Element (Tree a) -> f (Element (Tree a)))
-> Tree a -> f (Tree a)
otraverseWithKey = (MonoKey (Tree a) -> Element (Tree a) -> f (Element (Tree a)))
-> Tree a -> f (Tree a)
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey
instance MonoTraversableWithKey (Vector a) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (Vector a)
-> Element (Vector a) -> f (Element (Vector a)))
-> Vector a -> f (Vector a)
otraverseWithKey = (MonoKey (Vector a)
-> Element (Vector a) -> f (Element (Vector a)))
-> Vector a -> f (Vector a)
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey
instance VU.Unbox a => MonoTraversableWithKey (VU.Vector a) where
{-# INLINE otraverseWithKey #-}
{-# INLINE omapWithKeyM #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (Vector a)
-> Element (Vector a) -> f (Element (Vector a)))
-> Vector a -> f (Vector a)
otraverseWithKey MonoKey (Vector a) -> Element (Vector a) -> f (Element (Vector a))
f Vector a
v = ([a] -> Vector a) -> f [a] -> f (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [a] -> Vector a
forall a. Unbox a => Int -> [a] -> Vector a
VU.fromListN (Vector a -> Int
forall a. Unbox a => Vector a -> Int
VU.length Vector a
v)) (f [a] -> f (Vector a)) -> ([a] -> f [a]) -> [a] -> f (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key [] -> a -> f a) -> [a] -> f [a]
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey Key [] -> a -> f a
MonoKey (Vector a) -> Element (Vector a) -> f (Element (Vector a))
f ([a] -> f (Vector a)) -> [a] -> f (Vector a)
forall a b. (a -> b) -> a -> b
$ Vector a -> [a]
forall a. Unbox a => Vector a -> [a]
VU.toList Vector a
v
omapWithKeyM :: forall (m :: * -> *).
Monad m =>
(MonoKey (Vector a)
-> Element (Vector a) -> m (Element (Vector a)))
-> Vector a -> m (Vector a)
omapWithKeyM = (MonoKey (Vector a)
-> Element (Vector a) -> m (Element (Vector a)))
-> Vector a -> m (Vector a)
forall mono (f :: * -> *).
(MonoTraversableWithKey mono, Applicative f) =>
(MonoKey mono -> Element mono -> f (Element mono))
-> mono -> f mono
otraverseWithKey
instance VS.Storable a => MonoTraversableWithKey (VS.Vector a) where
{-# INLINE otraverseWithKey #-}
{-# INLINE omapWithKeyM #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (Vector a)
-> Element (Vector a) -> f (Element (Vector a)))
-> Vector a -> f (Vector a)
otraverseWithKey MonoKey (Vector a) -> Element (Vector a) -> f (Element (Vector a))
f Vector a
v = ([a] -> Vector a) -> f [a] -> f (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [a] -> Vector a
forall a. Storable a => Int -> [a] -> Vector a
VS.fromListN (Vector a -> Int
forall a. Storable a => Vector a -> Int
VS.length Vector a
v)) (f [a] -> f (Vector a)) -> ([a] -> f [a]) -> [a] -> f (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key [] -> a -> f a) -> [a] -> f [a]
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableWithKey t, Applicative f) =>
(Key t -> a -> f b) -> t a -> f (t b)
traverseWithKey Key [] -> a -> f a
MonoKey (Vector a) -> Element (Vector a) -> f (Element (Vector a))
f ([a] -> f (Vector a)) -> [a] -> f (Vector a)
forall a b. (a -> b) -> a -> b
$ Vector a -> [a]
forall a. Storable a => Vector a -> [a]
VS.toList Vector a
v
omapWithKeyM :: forall (m :: * -> *).
Monad m =>
(MonoKey (Vector a)
-> Element (Vector a) -> m (Element (Vector a)))
-> Vector a -> m (Vector a)
omapWithKeyM = (MonoKey (Vector a)
-> Element (Vector a) -> m (Element (Vector a)))
-> Vector a -> m (Vector a)
forall mono (f :: * -> *).
(MonoTraversableWithKey mono, Applicative f) =>
(MonoKey mono -> Element mono -> f (Element mono))
-> mono -> f mono
otraverseWithKey
instance MonoTraversableWithKey (ViewL a) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (ViewL a) -> Element (ViewL a) -> f (Element (ViewL a)))
-> ViewL a -> f (ViewL a)
otraverseWithKey = (MonoKey (ViewL a) -> Element (ViewL a) -> f (Element (ViewL a)))
-> ViewL a -> f (ViewL a)
forall (f :: * -> *) mono.
(Applicative f, MonoTraversable mono) =>
(() -> Element mono -> f (Element mono)) -> mono -> f mono
monoTraversableWithUnitKey
instance MonoTraversableWithKey (ViewR a) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (ViewR a) -> Element (ViewR a) -> f (Element (ViewR a)))
-> ViewR a -> f (ViewR a)
otraverseWithKey = (MonoKey (ViewR a) -> Element (ViewR a) -> f (Element (ViewR a)))
-> ViewR a -> f (ViewR a)
forall (f :: * -> *) mono.
(Applicative f, MonoTraversable mono) =>
(() -> Element mono -> f (Element mono)) -> mono -> f mono
monoTraversableWithUnitKey
instance Traversable f => MonoTraversableWithKey (WriterT w f a) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (WriterT w f a)
-> Element (WriterT w f a) -> f (Element (WriterT w f a)))
-> WriterT w f a -> f (WriterT w f a)
otraverseWithKey = (MonoKey (WriterT w f a)
-> Element (WriterT w f a) -> f (Element (WriterT w f a)))
-> WriterT w f a -> f (WriterT w f a)
forall (f :: * -> *) mono.
(Applicative f, MonoTraversable mono) =>
(() -> Element mono -> f (Element mono)) -> mono -> f mono
monoTraversableWithUnitKey
instance Traversable f => MonoTraversableWithKey (S.WriterT w f a) where
{-# INLINE otraverseWithKey #-}
otraverseWithKey :: forall (f :: * -> *).
Applicative f =>
(MonoKey (WriterT w f a)
-> Element (WriterT w f a) -> f (Element (WriterT w f a)))
-> WriterT w f a -> f (WriterT w f a)
otraverseWithKey = (MonoKey (WriterT w f a)
-> Element (WriterT w f a) -> f (Element (WriterT w f a)))
-> WriterT w f a -> f (WriterT w f a)
forall (f :: * -> *) mono.
(Applicative f, MonoTraversable mono) =>
(() -> Element mono -> f (Element mono)) -> mono -> f mono
monoTraversableWithUnitKey
instance MonoLookup [a] where
{-# INLINE olookup #-}
olookup :: MonoKey [a] -> [a] -> Maybe (Element [a])
olookup = MonoKey [a] -> [a] -> Maybe (Element [a])
forall (f :: * -> *) a. Lookup f => Key f -> f a -> Maybe a
lookup
instance MonoLookup (a, b) where
{-# INLINE olookup #-}
olookup :: MonoKey (a, b) -> (a, b) -> Maybe (Element (a, b))
olookup MonoKey (a, b)
_ (a
_, b
v) = b -> Maybe b
forall a. a -> Maybe a
Just b
v
instance MonoLookup (Arg a b) where
{-# INLINE olookup #-}
olookup :: MonoKey (Arg a b) -> Arg a b -> Maybe (Element (Arg a b))
olookup MonoKey (Arg a b)
_ (Arg a
_ b
v) = b -> Maybe b
forall a. a -> Maybe a
Just b
v
instance MonoLookup BS.ByteString where
{-# INLINE olookup #-}
olookup :: MonoKey ByteString -> ByteString -> Maybe (Element ByteString)
olookup MonoKey ByteString
i ByteString
bs
| Int
MonoKey ByteString
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
Bool -> Bool -> Bool
|| Int
MonoKey ByteString
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteString -> Int
BS.length ByteString
bs = Maybe (Element ByteString)
forall a. Maybe a
Nothing
| Bool
otherwise = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Word8
BS.index ByteString
bs Int
MonoKey ByteString
i
instance MonoLookup BSL.ByteString where
{-# INLINE olookup #-}
olookup :: MonoKey ByteString -> ByteString -> Maybe (Element ByteString)
olookup MonoKey ByteString
i ByteString
bs
| Int
MonoKey ByteString
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
Bool -> Bool -> Bool
|| Int
MonoKey ByteString
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (ByteString -> Int64
BSL.length ByteString
bs) = Maybe (Element ByteString)
forall a. Maybe a
Nothing
| Bool
otherwise = Word8 -> Maybe (Element ByteString)
forall a. a -> Maybe a
Just (Word8 -> Maybe (Element ByteString))
-> (Int64 -> Word8) -> Int64 -> Maybe (Element ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64 -> Word8
BSL.index ByteString
bs (Int64 -> Maybe (Element ByteString))
-> Int64 -> Maybe (Element ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a. Enum a => Int -> a
toEnum Int
MonoKey ByteString
i
instance ( Lookup f
, Lookup g
, MonoKey (f a) ~ Key f
, MonoKey (g a) ~ Key g
) => MonoLookup (Compose f g a) where
{-# INLINE olookup #-}
olookup :: MonoKey (Compose f g a)
-> Compose f g a -> Maybe (Element (Compose f g a))
olookup = MonoKey (Compose f g a)
-> Compose f g a -> Maybe (Element (Compose f g a))
forall (f :: * -> *) a. Lookup f => Key f -> f a -> Maybe a
lookup
instance MonoLookup (Either a b) where
{-# INLINE olookup #-}
olookup :: MonoKey (Either a b) -> Either a b -> Maybe (Element (Either a b))
olookup MonoKey (Either a b)
_ (Left a
_) = Maybe (Element (Either a b))
forall a. Maybe a
Nothing
olookup MonoKey (Either a b)
_ (Right b
v) = b -> Maybe b
forall a. a -> Maybe a
Just b
v
instance (Eq k, Hashable k) => MonoLookup (HashMap k v) where
{-# INLINE olookup #-}
olookup :: MonoKey (HashMap k v)
-> HashMap k v -> Maybe (Element (HashMap k v))
olookup = MonoKey (HashMap k v)
-> HashMap k v -> Maybe (Element (HashMap k v))
forall (f :: * -> *) a. Lookup f => Key f -> f a -> Maybe a
lookup
instance MonoLookup (HashSet v) where
{-# INLINE olookup #-}
olookup :: MonoKey (HashSet v) -> HashSet v -> Maybe (Element (HashSet v))
olookup = MonoKey (HashSet v) -> HashSet v -> Maybe (Element (HashSet v))
forall i mono.
(Integral i, MonoFoldable mono) =>
i -> mono -> Maybe (Element mono)
monoLookupFoldable
instance MonoLookup (Identity a) where
{-# INLINE olookup #-}
olookup :: MonoKey (Identity a) -> Identity a -> Maybe (Element (Identity a))
olookup = MonoKey (Identity a) -> Identity a -> Maybe (Element (Identity a))
forall (f :: * -> *) a. Lookup f => Key f -> f a -> Maybe a
lookup
instance MonoLookup (IntMap a) where
{-# INLINE olookup #-}
olookup :: MonoKey (IntMap a) -> IntMap a -> Maybe (Element (IntMap a))
olookup = MonoKey (IntMap a) -> IntMap a -> Maybe (Element (IntMap a))
forall (f :: * -> *) a. Lookup f => Key f -> f a -> Maybe a
lookup
instance MonoLookup IntSet where
{-# INLINE olookup #-}
olookup :: MonoKey IntSet -> IntSet -> Maybe (Element IntSet)
olookup = MonoKey IntSet -> IntSet -> Maybe (Element IntSet)
forall i mono.
(Integral i, MonoFoldable mono) =>
i -> mono -> Maybe (Element mono)
monoLookupFoldable
instance Ord k => MonoLookup (Map k v) where
{-# INLINE olookup #-}
olookup :: MonoKey (Map k v) -> Map k v -> Maybe (Element (Map k v))
olookup = MonoKey (Map k v) -> Map k v -> Maybe (Element (Map k v))
forall (f :: * -> *) a. Lookup f => Key f -> f a -> Maybe a
lookup
instance MonoLookup (Maybe a) where
{-# INLINE olookup #-}
olookup :: MonoKey (Maybe a) -> Maybe a -> Maybe (Element (Maybe a))
olookup = MonoKey (Maybe a) -> Maybe a -> Maybe (Element (Maybe a))
forall (f :: * -> *) a. Lookup f => Key f -> f a -> Maybe a
lookup
instance MonoLookup (NonEmpty a) where
{-# INLINE olookup #-}
olookup :: MonoKey (NonEmpty a) -> NonEmpty a -> Maybe (Element (NonEmpty a))
olookup = MonoKey (NonEmpty a) -> NonEmpty a -> Maybe (Element (NonEmpty a))
forall (f :: * -> *) a. Lookup f => Key f -> f a -> Maybe a
lookup
#if MIN_VERSION_base(4,16,0)
#else
instance MonoLookup (Option a) where
{-# INLINE olookup #-}
olookup = const getOption
#endif
instance ( Lookup f
, Lookup g
, MonoKey (f a) ~ Key f
, MonoKey (g a) ~ Key g
) => MonoLookup (Product f g a) where
{-# INLINE olookup #-}
olookup :: MonoKey (Product f g a)
-> Product f g a -> Maybe (Element (Product f g a))
olookup = MonoKey (Product f g a)
-> Product f g a -> Maybe (Element (Product f g a))
forall (f :: * -> *) a. Lookup f => Key f -> f a -> Maybe a
lookup
instance Lookup m => MonoLookup (ReaderT r m a) where
{-# INLINE olookup #-}
olookup :: MonoKey (ReaderT r m a)
-> ReaderT r m a -> Maybe (Element (ReaderT r m a))
olookup = MonoKey (ReaderT r m a)
-> ReaderT r m a -> Maybe (Element (ReaderT r m a))
forall (f :: * -> *) a. Lookup f => Key f -> f a -> Maybe a
lookup
instance MonoLookup (Seq a) where
{-# INLINE olookup #-}
olookup :: MonoKey (Seq a) -> Seq a -> Maybe (Element (Seq a))
olookup = MonoKey (Seq a) -> Seq a -> Maybe (Element (Seq a))
forall (f :: * -> *) a. Lookup f => Key f -> f a -> Maybe a
lookup
instance Ord a => MonoLookup (Set a) where
{-# INLINE olookup #-}
olookup :: MonoKey (Set a) -> Set a -> Maybe (Element (Set a))
olookup = MonoKey (Set a) -> Set a -> Maybe (Element (Set a))
forall i mono.
(Integral i, MonoFoldable mono) =>
i -> mono -> Maybe (Element mono)
monoLookupFoldable
instance MonoLookup T.Text where
{-# INLINE olookup #-}
olookup :: MonoKey Text -> Text -> Maybe (Element Text)
olookup MonoKey Text
i Text
ts
| Int
MonoKey Text
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
Bool -> Bool -> Bool
|| Int
MonoKey Text
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Text -> Int
T.length Text
ts = Maybe (Element Text)
forall a. Maybe a
Nothing
| Bool
otherwise = Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char) -> Char -> Maybe Char
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Char
T.index Text
ts Int
MonoKey Text
i
instance MonoLookup TL.Text where
{-# INLINE olookup #-}
olookup :: MonoKey Text -> Text -> Maybe (Element Text)
olookup MonoKey Text
i Text
ts
| Int
MonoKey Text
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
Bool -> Bool -> Bool
|| Int
MonoKey Text
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Text -> Int64
TL.length Text
ts) = Maybe (Element Text)
forall a. Maybe a
Nothing
| Bool
otherwise = Char -> Maybe (Element Text)
forall a. a -> Maybe a
Just (Char -> Maybe (Element Text))
-> (Int64 -> Char) -> Int64 -> Maybe (Element Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int64 -> Char
TL.index Text
ts (Int64 -> Maybe (Element Text)) -> Int64 -> Maybe (Element Text)
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a. Enum a => Int -> a
toEnum Int
MonoKey Text
i
instance MonoLookup (Tree a) where
{-# INLINE olookup #-}
olookup :: MonoKey (Tree a) -> Tree a -> Maybe (Element (Tree a))
olookup = MonoKey (Tree a) -> Tree a -> Maybe (Element (Tree a))
forall (f :: * -> *) a. Lookup f => Key f -> f a -> Maybe a
lookup
instance MonoLookup (Vector a) where
{-# INLINE olookup #-}
olookup :: MonoKey (Vector a) -> Vector a -> Maybe (Element (Vector a))
olookup = MonoKey (Vector a) -> Vector a -> Maybe (Element (Vector a))
forall (f :: * -> *) a. Lookup f => Key f -> f a -> Maybe a
lookup
instance VU.Unbox a => MonoLookup (VU.Vector a) where
{-# INLINE olookup #-}
olookup :: MonoKey (Vector a) -> Vector a -> Maybe (Element (Vector a))
olookup = (Vector a -> Int -> Maybe a) -> Int -> Vector a -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Vector a -> Int -> Maybe a
forall a. Unbox a => Vector a -> Int -> Maybe a
(VU.!?)
instance VS.Storable a => MonoLookup (VS.Vector a) where
{-# INLINE olookup #-}
olookup :: MonoKey (Vector a) -> Vector a -> Maybe (Element (Vector a))
olookup = (Vector a -> Int -> Maybe a) -> Int -> Vector a -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Vector a -> Int -> Maybe a
forall a. Storable a => Vector a -> Int -> Maybe a
(VS.!?)
instance MonoLookup (ViewL a) where
{-# INLINE olookup #-}
olookup :: MonoKey (ViewL a) -> ViewL a -> Maybe (Element (ViewL a))
olookup MonoKey (ViewL a)
_ ViewL a
EmptyL = Maybe (Element (ViewL a))
forall a. Maybe a
Nothing
olookup MonoKey (ViewL a)
_ (a
v:<Seq a
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
v
instance MonoLookup (ViewR a) where
{-# INLINE olookup #-}
olookup :: MonoKey (ViewR a) -> ViewR a -> Maybe (Element (ViewR a))
olookup MonoKey (ViewR a)
_ ViewR a
EmptyR = Maybe (Element (ViewR a))
forall a. Maybe a
Nothing
olookup MonoKey (ViewR a)
_ (Seq a
_:>a
v) = a -> Maybe a
forall a. a -> Maybe a
Just a
v
instance MonoLookup (ZipList a) where
{-# INLINE olookup #-}
olookup :: MonoKey (ZipList a) -> ZipList a -> Maybe (Element (ZipList a))
olookup = MonoKey (ZipList a) -> ZipList a -> Maybe (Element (ZipList a))
forall (f :: * -> *) a. Lookup f => Key f -> f a -> Maybe a
lookup
instance MonoIndexable [a] where
{-# INLINE oindex #-}
oindex :: [a] -> MonoKey [a] -> Element [a]
oindex = [a] -> MonoKey [a] -> Element [a]
forall (f :: * -> *) a. Indexable f => f a -> Key f -> a
index
instance MonoIndexable (a, b) where
{-# INLINE oindex #-}
oindex :: (a, b) -> MonoKey (a, b) -> Element (a, b)
oindex (a
_, b
v) = b -> () -> b
forall a b. a -> b -> a
const b
v
instance MonoIndexable (Arg a b) where
{-# INLINE oindex #-}
oindex :: Arg a b -> MonoKey (Arg a b) -> Element (Arg a b)
oindex (Arg a
_ b
v) = b -> () -> b
forall a b. a -> b -> a
const b
v
instance MonoIndexable BS.ByteString where
{-# INLINE oindex #-}
oindex :: ByteString -> MonoKey ByteString -> Element ByteString
oindex ByteString
bs MonoKey ByteString
i
| Int
MonoKey ByteString
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
Bool -> Bool -> Bool
|| Int
MonoKey ByteString
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteString -> Int
BS.length ByteString
bs = String -> Element ByteString
forall a. HasCallStack => String -> a
error (String -> Element ByteString) -> String -> Element ByteString
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat [ String
"oindex on ByteString at point ", Int -> String
forall a. Show a => a -> String
show Int
MonoKey ByteString
i, String
" is outside the range: [0, ", Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
BS.length ByteString
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1), String
"]."]
| Bool
otherwise = ByteString -> Int -> Word8
BS.index ByteString
bs Int
MonoKey ByteString
i
instance MonoIndexable BSL.ByteString where
{-# INLINE oindex #-}
oindex :: ByteString -> MonoKey ByteString -> Element ByteString
oindex ByteString
bs MonoKey ByteString
i
| Int
MonoKey ByteString
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
Bool -> Bool -> Bool
|| Int
MonoKey ByteString
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (ByteString -> Int64
BSL.length ByteString
bs) = String -> Element ByteString
forall a. HasCallStack => String -> a
error (String -> Element ByteString) -> String -> Element ByteString
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat [ String
"oindex on Lazy ByteString at point ", Int -> String
forall a. Show a => a -> String
show Int
MonoKey ByteString
i, String
" is outside the range: [0, ", Int64 -> String
forall a. Show a => a -> String
show (ByteString -> Int64
BSL.length ByteString
bs Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1), String
"]."]
| Bool
otherwise = ByteString -> Int64 -> Word8
BSL.index ByteString
bs (Int64 -> Word8) -> Int64 -> Word8
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a. Enum a => Int -> a
toEnum Int
MonoKey ByteString
i
instance ( Indexable f
, Indexable g
, MonoKey (f a) ~ Key f
, MonoKey (g a) ~ Key g
) => MonoIndexable (Compose f g a) where
{-# INLINE oindex #-}
oindex :: Compose f g a -> MonoKey (Compose f g a) -> Element (Compose f g a)
oindex = Compose f g a -> MonoKey (Compose f g a) -> Element (Compose f g a)
forall (f :: * -> *) a. Indexable f => f a -> Key f -> a
index
instance MonoIndexable (Either a b) where
{-# INLINE oindex #-}
oindex :: Either a b -> MonoKey (Either a b) -> Element (Either a b)
oindex (Right b
v) = b -> () -> b
forall a b. a -> b -> a
const b
v
oindex (Left a
_) = String -> () -> b
forall a. HasCallStack => String -> a
error
String
"oindex on Either is Left, cannot retreive a value. Consider using olookup instead."
instance (Eq k, Hashable k) => MonoIndexable (HashMap k v) where
{-# INLINE oindex #-}
oindex :: HashMap k v -> MonoKey (HashMap k v) -> Element (HashMap k v)
oindex = HashMap k v -> MonoKey (HashMap k v) -> Element (HashMap k v)
forall (f :: * -> *) a. Indexable f => f a -> Key f -> a
index
instance MonoIndexable (HashSet v) where
{-# INLINE oindex #-}
oindex :: HashSet v -> MonoKey (HashSet v) -> Element (HashSet v)
oindex HashSet v
hs MonoKey (HashSet v)
i = Element (HashSet v)
-> Maybe (Element (HashSet v)) -> Element (HashSet v)
forall a. a -> Maybe a -> a
fromMaybe v
Element (HashSet v)
errorMessage (Maybe (Element (HashSet v)) -> Element (HashSet v))
-> Maybe (Element (HashSet v)) -> Element (HashSet v)
forall a b. (a -> b) -> a -> b
$ MonoKey (HashSet v) -> HashSet v -> Maybe (Element (HashSet v))
forall mono.
MonoLookup mono =>
MonoKey mono -> mono -> Maybe (Element mono)
olookup MonoKey (HashSet v)
i HashSet v
hs
where
errorMessage :: v
errorMessage = String -> v
forall a. HasCallStack => String -> a
error (String -> v) -> String -> v
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
[ String
"oindex on HashSet at point "
, Int -> String
forall a. Show a => a -> String
show Int
MonoKey (HashSet v)
i
, String
" is outside the range: [0, "
, Int -> String
forall a. Show a => a -> String
show (HashSet v -> Int
forall a. HashSet a -> Int
HS.size HashSet v
hs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
, String
"]."
]
instance MonoIndexable (Identity a) where
{-# INLINE oindex #-}
oindex :: Identity a -> MonoKey (Identity a) -> Element (Identity a)
oindex = Identity a -> MonoKey (Identity a) -> Element (Identity a)
forall (f :: * -> *) a. Indexable f => f a -> Key f -> a
index
instance MonoIndexable (IntMap a) where
{-# INLINE oindex #-}
oindex :: IntMap a -> MonoKey (IntMap a) -> Element (IntMap a)
oindex = IntMap a -> MonoKey (IntMap a) -> Element (IntMap a)
forall (f :: * -> *) a. Indexable f => f a -> Key f -> a
index
instance MonoIndexable IntSet where
{-# INLINE oindex #-}
oindex :: IntSet -> MonoKey IntSet -> Element IntSet
oindex IntSet
is MonoKey IntSet
i = Element IntSet -> Maybe (Element IntSet) -> Element IntSet
forall a. a -> Maybe a -> a
fromMaybe Int
Element IntSet
errorMessage (Maybe (Element IntSet) -> Element IntSet)
-> Maybe (Element IntSet) -> Element IntSet
forall a b. (a -> b) -> a -> b
$ MonoKey IntSet -> IntSet -> Maybe (Element IntSet)
forall mono.
MonoLookup mono =>
MonoKey mono -> mono -> Maybe (Element mono)
olookup MonoKey IntSet
i IntSet
is
where
errorMessage :: Int
errorMessage = String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
[ String
"oindex on IntSet at point "
, Int -> String
forall a. Show a => a -> String
show Int
MonoKey IntSet
i
, String
" is outside the range: [0, "
, Int -> String
forall a. Show a => a -> String
show (IntSet -> Int
IS.size IntSet
is Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
, String
"]."
]
instance Ord k => MonoIndexable (Map k v) where
{-# INLINE oindex #-}
oindex :: Map k v -> MonoKey (Map k v) -> Element (Map k v)
oindex = Map k v -> MonoKey (Map k v) -> Element (Map k v)
forall (f :: * -> *) a. Indexable f => f a -> Key f -> a
index
instance MonoIndexable (Maybe a) where
{-# INLINE oindex #-}
oindex :: Maybe a -> MonoKey (Maybe a) -> Element (Maybe a)
oindex = Maybe a -> MonoKey (Maybe a) -> Element (Maybe a)
forall (f :: * -> *) a. Indexable f => f a -> Key f -> a
index
instance MonoIndexable (NonEmpty a) where
{-# INLINE oindex #-}
oindex :: NonEmpty a -> MonoKey (NonEmpty a) -> Element (NonEmpty a)
oindex = NonEmpty a -> MonoKey (NonEmpty a) -> Element (NonEmpty a)
forall (f :: * -> *) a. Indexable f => f a -> Key f -> a
index
#if MIN_VERSION_base(4,16,0)
#else
instance MonoIndexable (Option a) where
{-# INLINE oindex #-}
oindex = flip . const $ fromMaybe errorMessage . getOption
where
errorMessage = error
"oindex on empty Option, cannot retreive a value. Consider using olookup instead."
#endif
instance ( Indexable f
, Indexable g
, MonoKey (f a) ~ Key f
, MonoKey (g a) ~ Key g
) => MonoIndexable (Product f g a) where
{-# INLINE oindex #-}
oindex :: Product f g a -> MonoKey (Product f g a) -> Element (Product f g a)
oindex = Product f g a -> MonoKey (Product f g a) -> Element (Product f g a)
forall (f :: * -> *) a. Indexable f => f a -> Key f -> a
index
instance Indexable m => MonoIndexable (ReaderT r m a) where
{-# INLINE oindex #-}
oindex :: ReaderT r m a -> MonoKey (ReaderT r m a) -> Element (ReaderT r m a)
oindex = ReaderT r m a -> MonoKey (ReaderT r m a) -> Element (ReaderT r m a)
forall (f :: * -> *) a. Indexable f => f a -> Key f -> a
index
instance MonoIndexable (Seq a) where
{-# INLINE oindex #-}
oindex :: Seq a -> MonoKey (Seq a) -> Element (Seq a)
oindex = Seq a -> MonoKey (Seq a) -> Element (Seq a)
forall (f :: * -> *) a. Indexable f => f a -> Key f -> a
index
instance Ord a => MonoIndexable (Set a) where
{-# INLINE oindex #-}
oindex :: Set a -> MonoKey (Set a) -> Element (Set a)
oindex Set a
s MonoKey (Set a)
i = Element (Set a) -> Maybe (Element (Set a)) -> Element (Set a)
forall a. a -> Maybe a -> a
fromMaybe a
Element (Set a)
errorMessage (Maybe (Element (Set a)) -> Element (Set a))
-> Maybe (Element (Set a)) -> Element (Set a)
forall a b. (a -> b) -> a -> b
$ MonoKey (Set a) -> Set a -> Maybe (Element (Set a))
forall mono.
MonoLookup mono =>
MonoKey mono -> mono -> Maybe (Element mono)
olookup MonoKey (Set a)
i Set a
s
where
errorMessage :: a
errorMessage = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
[ String
"oindex on Set at point "
, Int -> String
forall a. Show a => a -> String
show Int
MonoKey (Set a)
i
, String
" is outside the range: [0, "
, Int -> String
forall a. Show a => a -> String
show (Set a -> Int
forall a. Set a -> Int
Set.size Set a
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
, String
"]."
]
instance MonoIndexable T.Text where
{-# INLINE oindex #-}
oindex :: Text -> MonoKey Text -> Element Text
oindex Text
ts MonoKey Text
i
| Int
MonoKey Text
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
Bool -> Bool -> Bool
|| Int
MonoKey Text
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Text -> Int
T.length Text
ts = String -> Element Text
forall a. HasCallStack => String -> a
error (String -> Element Text) -> String -> Element Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat [ String
"oindex on Text at point ", Int -> String
forall a. Show a => a -> String
show Int
MonoKey Text
i, String
" is outside the range: [0, ", Int -> String
forall a. Show a => a -> String
show (Text -> Int
T.length Text
ts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1), String
"]."]
| Bool
otherwise = Text -> Int -> Char
T.index Text
ts Int
MonoKey Text
i
instance MonoIndexable TL.Text where
{-# INLINE oindex #-}
oindex :: Text -> MonoKey Text -> Element Text
oindex Text
ts MonoKey Text
i
| Int
MonoKey Text
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
Bool -> Bool -> Bool
|| Int
MonoKey Text
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Text -> Int64
TL.length Text
ts) = String -> Element Text
forall a. HasCallStack => String -> a
error (String -> Element Text) -> String -> Element Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat [ String
"oindex on Lazy Text at point ", Int -> String
forall a. Show a => a -> String
show Int
MonoKey Text
i, String
" is outside the range: [0, ", Int64 -> String
forall a. Show a => a -> String
show (Text -> Int64
TL.length Text
ts Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1), String
"]."]
| Bool
otherwise = Text -> Int64 -> Char
TL.index Text
ts (Int64 -> Char) -> Int64 -> Char
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a. Enum a => Int -> a
toEnum Int
MonoKey Text
i
instance MonoIndexable (Tree a) where
{-# INLINE oindex #-}
oindex :: Tree a -> MonoKey (Tree a) -> Element (Tree a)
oindex = Tree a -> MonoKey (Tree a) -> Element (Tree a)
forall (f :: * -> *) a. Indexable f => f a -> Key f -> a
index
instance MonoIndexable (Vector a) where
{-# INLINE oindex #-}
oindex :: Vector a -> MonoKey (Vector a) -> Element (Vector a)
oindex = Vector a -> MonoKey (Vector a) -> Element (Vector a)
forall (f :: * -> *) a. Indexable f => f a -> Key f -> a
index
instance VU.Unbox a => MonoIndexable (VU.Vector a) where
{-# INLINE oindex #-}
oindex :: Vector a -> MonoKey (Vector a) -> Element (Vector a)
oindex = Vector a -> MonoKey (Vector a) -> Element (Vector a)
forall a. Unbox a => Vector a -> Int -> a
(VU.!)
instance VS.Storable a => MonoIndexable (VS.Vector a) where
{-# INLINE oindex #-}
oindex :: Vector a -> MonoKey (Vector a) -> Element (Vector a)
oindex = Vector a -> MonoKey (Vector a) -> Element (Vector a)
forall a. Storable a => Vector a -> Int -> a
(VS.!)
instance MonoIndexable (ViewL a) where
{-# INLINE oindex #-}
oindex :: ViewL a -> MonoKey (ViewL a) -> Element (ViewL a)
oindex (a
v:<Seq a
_) = a -> () -> a
forall a b. a -> b -> a
const a
v
oindex ViewL a
EmptyL = String -> () -> a
forall a. HasCallStack => String -> a
error
String
"oindex on ViewL is EmptyL, cannot retreive a value. Consider using olookup instead."
instance MonoIndexable (ViewR a) where
{-# INLINE oindex #-}
oindex :: ViewR a -> MonoKey (ViewR a) -> Element (ViewR a)
oindex (Seq a
_:>a
v) = a -> () -> a
forall a b. a -> b -> a
const a
v
oindex ViewR a
EmptyR = String -> () -> a
forall a. HasCallStack => String -> a
error
String
"oindex on ViewR is EmptyR, cannot retreive a value. Consider using olookup instead."
instance MonoIndexable (ZipList a) where
{-# INLINE oindex #-}
oindex :: ZipList a -> MonoKey (ZipList a) -> Element (ZipList a)
oindex = ZipList a -> MonoKey (ZipList a) -> Element (ZipList a)
forall (f :: * -> *) a. Indexable f => f a -> Key f -> a
index
instance MonoAdjustable (r -> a) where
{-# INLINE oadjust #-}
oadjust :: (Element (r -> a) -> Element (r -> a))
-> MonoKey (r -> a) -> (r -> a) -> r -> a
oadjust Element (r -> a) -> Element (r -> a)
f MonoKey (r -> a)
_ r -> a
g = a -> a
Element (r -> a) -> Element (r -> a)
f (a -> a) -> (r -> a) -> r -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> a
g
instance MonoAdjustable [a] where
{-# INLINE oadjust #-}
oadjust :: (Element [a] -> Element [a]) -> MonoKey [a] -> [a] -> [a]
oadjust = (Element [a] -> Element [a]) -> MonoKey [a] -> [a] -> [a]
forall (f :: * -> *) a.
Adjustable f =>
(a -> a) -> Key f -> f a -> f a
adjust
instance MonoAdjustable (a, b) where
{-# INLINE oadjust #-}
oadjust :: (Element (a, b) -> Element (a, b))
-> MonoKey (a, b) -> (a, b) -> (a, b)
oadjust Element (a, b) -> Element (a, b)
f = ((a, b) -> (a, b)) -> MonoKey (a, b) -> (a, b) -> (a, b)
forall a b. a -> b -> a
const (((a, b) -> (a, b)) -> MonoKey (a, b) -> (a, b) -> (a, b))
-> ((a, b) -> (a, b)) -> MonoKey (a, b) -> (a, b) -> (a, b)
forall a b. (a -> b) -> a -> b
$ (b -> b) -> (a, b) -> (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
Element (a, b) -> Element (a, b)
f
instance MonoAdjustable (Arg a b) where
{-# INLINE oadjust #-}
oadjust :: (Element (Arg a b) -> Element (Arg a b))
-> MonoKey (Arg a b) -> Arg a b -> Arg a b
oadjust Element (Arg a b) -> Element (Arg a b)
f = (Arg a b -> Arg a b) -> MonoKey (Arg a b) -> Arg a b -> Arg a b
forall a b. a -> b -> a
const ((Arg a b -> Arg a b) -> MonoKey (Arg a b) -> Arg a b -> Arg a b)
-> (Arg a b -> Arg a b) -> MonoKey (Arg a b) -> Arg a b -> Arg a b
forall a b. (a -> b) -> a -> b
$ (b -> b) -> Arg a b -> Arg a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
Element (Arg a b) -> Element (Arg a b)
f
instance MonoAdjustable BS.ByteString where
{-# INLINE oadjust #-}
oadjust :: (Element ByteString -> Element ByteString)
-> MonoKey ByteString -> ByteString -> ByteString
oadjust Element ByteString -> Element ByteString
f MonoKey ByteString
i ByteString
bs
| Int
MonoKey ByteString
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
Bool -> Bool -> Bool
|| Int
MonoKey ByteString
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteString -> Int
BS.length ByteString
bs = ByteString
bs
| Bool
otherwise = (Int, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((Int, ByteString) -> ByteString)
-> (Int, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ (Int -> Word8 -> (Int, Word8))
-> Int -> ByteString -> (Int, ByteString)
forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
BS.mapAccumL Int -> Word8 -> (Int, Word8)
g Int
0 ByteString
bs
where
g :: Int -> Word8 -> (Int, Word8)
g Int
k Word8
v = (Int -> Int
forall a. Enum a => a -> a
succ Int
k, if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
MonoKey ByteString
i then Element ByteString -> Element ByteString
f Word8
Element ByteString
v else Word8
v)
instance MonoAdjustable BSL.ByteString where
{-# INLINE oadjust #-}
oadjust :: (Element ByteString -> Element ByteString)
-> MonoKey ByteString -> ByteString -> ByteString
oadjust Element ByteString -> Element ByteString
f MonoKey ByteString
i ByteString
bs
| Int
MonoKey ByteString
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
Bool -> Bool -> Bool
|| Int
MonoKey ByteString
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (ByteString -> Int64
BSL.length ByteString
bs) = ByteString
bs
| Bool
otherwise = (Int, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((Int, ByteString) -> ByteString)
-> (Int, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ (Int -> Word8 -> (Int, Word8))
-> Int -> ByteString -> (Int, ByteString)
forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
BSL.mapAccumL Int -> Word8 -> (Int, Word8)
g Int
0 ByteString
bs
where
g :: Int -> Word8 -> (Int, Word8)
g Int
k Word8
v = (Int -> Int
forall a. Enum a => a -> a
succ Int
k, if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
MonoKey ByteString
i then Element ByteString -> Element ByteString
f Word8
Element ByteString
v else Word8
v)
instance MonoAdjustable (Const m a) where
{-# INLINE oadjust #-}
oadjust :: (Element (Const m a) -> Element (Const m a))
-> MonoKey (Const m a) -> Const m a -> Const m a
oadjust = (MonoKey (Const m a) -> Const m a -> Const m a)
-> (Element (Const m a) -> Element (Const m a))
-> MonoKey (Const m a)
-> Const m a
-> Const m a
forall a b. a -> b -> a
const ((MonoKey (Const m a) -> Const m a -> Const m a)
-> (Element (Const m a) -> Element (Const m a))
-> MonoKey (Const m a)
-> Const m a
-> Const m a)
-> (MonoKey (Const m a) -> Const m a -> Const m a)
-> (Element (Const m a) -> Element (Const m a))
-> MonoKey (Const m a)
-> Const m a
-> Const m a
forall a b. (a -> b) -> a -> b
$ (Const m a -> Const m a) -> () -> Const m a -> Const m a
forall a b. a -> b -> a
const Const m a -> Const m a
forall a. a -> a
id
instance Functor m => MonoAdjustable (ContT r m a) where
{-# INLINE oadjust #-}
oadjust :: (Element (ContT r m a) -> Element (ContT r m a))
-> MonoKey (ContT r m a) -> ContT r m a -> ContT r m a
oadjust Element (ContT r m a) -> Element (ContT r m a)
f = (ContT r m a -> ContT r m a)
-> MonoKey (ContT r m a) -> ContT r m a -> ContT r m a
forall a b. a -> b -> a
const ((ContT r m a -> ContT r m a)
-> MonoKey (ContT r m a) -> ContT r m a -> ContT r m a)
-> (ContT r m a -> ContT r m a)
-> MonoKey (ContT r m a)
-> ContT r m a
-> ContT r m a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> ContT r m a -> ContT r m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
Element (ContT r m a) -> Element (ContT r m a)
f
instance MonoAdjustable (Either a b) where
{-# INLINE oadjust #-}
oadjust :: (Element (Either a b) -> Element (Either a b))
-> MonoKey (Either a b) -> Either a b -> Either a b
oadjust Element (Either a b) -> Element (Either a b)
f = (Either a b -> Either a b)
-> MonoKey (Either a b) -> Either a b -> Either a b
forall a b. a -> b -> a
const ((Either a b -> Either a b)
-> MonoKey (Either a b) -> Either a b -> Either a b)
-> (Either a b -> Either a b)
-> MonoKey (Either a b)
-> Either a b
-> Either a b
forall a b. (a -> b) -> a -> b
$ (b -> b) -> Either a b -> Either a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
Element (Either a b) -> Element (Either a b)
f
instance (Eq k, Hashable k) => MonoAdjustable (HashMap k v) where
{-# INLINE oadjust #-}
oadjust :: (Element (HashMap k v) -> Element (HashMap k v))
-> MonoKey (HashMap k v) -> HashMap k v -> HashMap k v
oadjust = (Element (HashMap k v) -> Element (HashMap k v))
-> MonoKey (HashMap k v) -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
HM.adjust
instance MonoAdjustable (Identity a) where
{-# INLINE oadjust #-}
oadjust :: (Element (Identity a) -> Element (Identity a))
-> MonoKey (Identity a) -> Identity a -> Identity a
oadjust = (Element (Identity a) -> Element (Identity a))
-> MonoKey (Identity a) -> Identity a -> Identity a
forall (f :: * -> *) a.
Adjustable f =>
(a -> a) -> Key f -> f a -> f a
adjust
instance Functor m => MonoAdjustable (IdentityT m a) where
{-# INLINE oadjust #-}
oadjust :: (Element (IdentityT m a) -> Element (IdentityT m a))
-> MonoKey (IdentityT m a) -> IdentityT m a -> IdentityT m a
oadjust Element (IdentityT m a) -> Element (IdentityT m a)
f = (IdentityT m a -> IdentityT m a)
-> MonoKey (IdentityT m a) -> IdentityT m a -> IdentityT m a
forall a b. a -> b -> a
const ((IdentityT m a -> IdentityT m a)
-> MonoKey (IdentityT m a) -> IdentityT m a -> IdentityT m a)
-> (IdentityT m a -> IdentityT m a)
-> MonoKey (IdentityT m a)
-> IdentityT m a
-> IdentityT m a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> IdentityT m a -> IdentityT m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
Element (IdentityT m a) -> Element (IdentityT m a)
f
instance MonoAdjustable (IntMap a) where
{-# INLINE oadjust #-}
oadjust :: (Element (IntMap a) -> Element (IntMap a))
-> MonoKey (IntMap a) -> IntMap a -> IntMap a
oadjust = (Element (IntMap a) -> Element (IntMap a))
-> MonoKey (IntMap a) -> IntMap a -> IntMap a
forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IM.adjust
instance MonoAdjustable (IO a) where
{-# INLINE oadjust #-}
oadjust :: (Element (IO a) -> Element (IO a))
-> MonoKey (IO a) -> IO a -> IO a
oadjust Element (IO a) -> Element (IO a)
f = (IO a -> IO a) -> MonoKey (IO a) -> IO a -> IO a
forall a b. a -> b -> a
const ((IO a -> IO a) -> MonoKey (IO a) -> IO a -> IO a)
-> (IO a -> IO a) -> MonoKey (IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> IO a -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
Element (IO a) -> Element (IO a)
f
instance Functor m => MonoAdjustable (ListT m a) where
{-# INLINE oadjust #-}
oadjust :: (Element (ListT m a) -> Element (ListT m a))
-> MonoKey (ListT m a) -> ListT m a -> ListT m a
oadjust Element (ListT m a) -> Element (ListT m a)
f MonoKey (ListT m a)
i = m [a] -> ListT m a
forall (m :: * -> *) a. m [a] -> ListT m a
ListT (m [a] -> ListT m a)
-> (ListT m a -> m [a]) -> ListT m a -> ListT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> Key [] -> [a] -> [a]
forall (f :: * -> *) a.
Adjustable f =>
(a -> a) -> Key f -> f a -> f a
adjust a -> a
Element (ListT m a) -> Element (ListT m a)
f Key []
MonoKey (ListT m a)
i) (m [a] -> m [a]) -> (ListT m a -> m [a]) -> ListT m a -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListT m a -> m [a]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT
instance Ord k => MonoAdjustable (Map k v) where
{-# INLINE oadjust #-}
oadjust :: (Element (Map k v) -> Element (Map k v))
-> MonoKey (Map k v) -> Map k v -> Map k v
oadjust = (Element (Map k v) -> Element (Map k v))
-> MonoKey (Map k v) -> Map k v -> Map k v
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust
instance MonoAdjustable (Maybe a) where
{-# INLINE oadjust #-}
oadjust :: (Element (Maybe a) -> Element (Maybe a))
-> MonoKey (Maybe a) -> Maybe a -> Maybe a
oadjust Element (Maybe a) -> Element (Maybe a)
f = (Maybe a -> Maybe a) -> MonoKey (Maybe a) -> Maybe a -> Maybe a
forall a b. a -> b -> a
const ((Maybe a -> Maybe a) -> MonoKey (Maybe a) -> Maybe a -> Maybe a)
-> (Maybe a -> Maybe a) -> MonoKey (Maybe a) -> Maybe a -> Maybe a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> Maybe a -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
Element (Maybe a) -> Element (Maybe a)
f
instance Functor m => MonoAdjustable (MaybeT m a) where
{-# INLINE oadjust #-}
oadjust :: (Element (MaybeT m a) -> Element (MaybeT m a))
-> MonoKey (MaybeT m a) -> MaybeT m a -> MaybeT m a
oadjust Element (MaybeT m a) -> Element (MaybeT m a)
f = (MaybeT m a -> MaybeT m a)
-> MonoKey (MaybeT m a) -> MaybeT m a -> MaybeT m a
forall a b. a -> b -> a
const ((MaybeT m a -> MaybeT m a)
-> MonoKey (MaybeT m a) -> MaybeT m a -> MaybeT m a)
-> (MaybeT m a -> MaybeT m a)
-> MonoKey (MaybeT m a)
-> MaybeT m a
-> MaybeT m a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> MaybeT m a -> MaybeT m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
Element (MaybeT m a) -> Element (MaybeT m a)
f
instance MonoAdjustable (NonEmpty a) where
{-# INLINE oadjust #-}
oadjust :: (Element (NonEmpty a) -> Element (NonEmpty a))
-> MonoKey (NonEmpty a) -> NonEmpty a -> NonEmpty a
oadjust = (Element (NonEmpty a) -> Element (NonEmpty a))
-> MonoKey (NonEmpty a) -> NonEmpty a -> NonEmpty a
forall (f :: * -> *) a.
Adjustable f =>
(a -> a) -> Key f -> f a -> f a
adjust
#if MIN_VERSION_base(4,16,0)
#else
instance MonoAdjustable (Option a) where
{-# INLINE oadjust #-}
oadjust f = const $ fmap f
#endif
instance ( Adjustable f
, Adjustable g
, MonoKey (f a) ~ Key f
, MonoKey (g a) ~ Key g
) => MonoAdjustable (Product f g a) where
{-# INLINE oadjust #-}
oadjust :: (Element (Product f g a) -> Element (Product f g a))
-> MonoKey (Product f g a) -> Product f g a -> Product f g a
oadjust = (Element (Product f g a) -> Element (Product f g a))
-> MonoKey (Product f g a) -> Product f g a -> Product f g a
forall (f :: * -> *) a.
Adjustable f =>
(a -> a) -> Key f -> f a -> f a
adjust
instance Functor m => MonoAdjustable (ReaderT r m a) where
{-# INLINE oadjust #-}
oadjust :: (Element (ReaderT r m a) -> Element (ReaderT r m a))
-> MonoKey (ReaderT r m a) -> ReaderT r m a -> ReaderT r m a
oadjust Element (ReaderT r m a) -> Element (ReaderT r m a)
f = (ReaderT r m a -> ReaderT r m a)
-> MonoKey (ReaderT r m a) -> ReaderT r m a -> ReaderT r m a
forall a b. a -> b -> a
const ((ReaderT r m a -> ReaderT r m a)
-> MonoKey (ReaderT r m a) -> ReaderT r m a -> ReaderT r m a)
-> (ReaderT r m a -> ReaderT r m a)
-> MonoKey (ReaderT r m a)
-> ReaderT r m a
-> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> ReaderT r m a -> ReaderT r m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
Element (ReaderT r m a) -> Element (ReaderT r m a)
f
instance Functor m => MonoAdjustable (RWST r w s m a) where
{-# INLINE oadjust #-}
oadjust :: (Element (RWST r w s m a) -> Element (RWST r w s m a))
-> MonoKey (RWST r w s m a) -> RWST r w s m a -> RWST r w s m a
oadjust Element (RWST r w s m a) -> Element (RWST r w s m a)
f = (RWST r w s m a -> RWST r w s m a)
-> MonoKey (RWST r w s m a) -> RWST r w s m a -> RWST r w s m a
forall a b. a -> b -> a
const ((RWST r w s m a -> RWST r w s m a)
-> MonoKey (RWST r w s m a) -> RWST r w s m a -> RWST r w s m a)
-> (RWST r w s m a -> RWST r w s m a)
-> MonoKey (RWST r w s m a)
-> RWST r w s m a
-> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> RWST r w s m a -> RWST r w s m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
Element (RWST r w s m a) -> Element (RWST r w s m a)
f
instance Functor m => MonoAdjustable (S.RWST r w s m a) where
{-# INLINE oadjust #-}
oadjust :: (Element (RWST r w s m a) -> Element (RWST r w s m a))
-> MonoKey (RWST r w s m a) -> RWST r w s m a -> RWST r w s m a
oadjust Element (RWST r w s m a) -> Element (RWST r w s m a)
f = (RWST r w s m a -> RWST r w s m a)
-> MonoKey (RWST r w s m a) -> RWST r w s m a -> RWST r w s m a
forall a b. a -> b -> a
const ((RWST r w s m a -> RWST r w s m a)
-> MonoKey (RWST r w s m a) -> RWST r w s m a -> RWST r w s m a)
-> (RWST r w s m a -> RWST r w s m a)
-> MonoKey (RWST r w s m a)
-> RWST r w s m a
-> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> RWST r w s m a -> RWST r w s m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
Element (RWST r w s m a) -> Element (RWST r w s m a)
f
instance MonoAdjustable (Seq a) where
{-# INLINE oadjust #-}
oadjust :: (Element (Seq a) -> Element (Seq a))
-> MonoKey (Seq a) -> Seq a -> Seq a
oadjust = (Element (Seq a) -> Element (Seq a))
-> MonoKey (Seq a) -> Seq a -> Seq a
forall (f :: * -> *) a.
Adjustable f =>
(a -> a) -> Key f -> f a -> f a
adjust
instance Functor m => MonoAdjustable (StateT s m a) where
{-# INLINE oadjust #-}
oadjust :: (Element (StateT s m a) -> Element (StateT s m a))
-> MonoKey (StateT s m a) -> StateT s m a -> StateT s m a
oadjust Element (StateT s m a) -> Element (StateT s m a)
f = (StateT s m a -> StateT s m a)
-> MonoKey (StateT s m a) -> StateT s m a -> StateT s m a
forall a b. a -> b -> a
const ((StateT s m a -> StateT s m a)
-> MonoKey (StateT s m a) -> StateT s m a -> StateT s m a)
-> (StateT s m a -> StateT s m a)
-> MonoKey (StateT s m a)
-> StateT s m a
-> StateT s m a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> StateT s m a -> StateT s m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
Element (StateT s m a) -> Element (StateT s m a)
f
instance Functor m => MonoAdjustable (S.StateT s m a) where
{-# INLINE oadjust #-}
oadjust :: (Element (StateT s m a) -> Element (StateT s m a))
-> MonoKey (StateT s m a) -> StateT s m a -> StateT s m a
oadjust Element (StateT s m a) -> Element (StateT s m a)
f = (StateT s m a -> StateT s m a)
-> MonoKey (StateT s m a) -> StateT s m a -> StateT s m a
forall a b. a -> b -> a
const ((StateT s m a -> StateT s m a)
-> MonoKey (StateT s m a) -> StateT s m a -> StateT s m a)
-> (StateT s m a -> StateT s m a)
-> MonoKey (StateT s m a)
-> StateT s m a
-> StateT s m a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> StateT s m a -> StateT s m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
Element (StateT s m a) -> Element (StateT s m a)
f
instance MonoAdjustable T.Text where
{-# INLINE oadjust #-}
oadjust :: (Element Text -> Element Text) -> MonoKey Text -> Text -> Text
oadjust Element Text -> Element Text
f MonoKey Text
i Text
ts
| Int
MonoKey Text
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
Bool -> Bool -> Bool
|| Int
MonoKey Text
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Text -> Int
T.length Text
ts = Text
ts
| Bool
otherwise = (Int, Text) -> Text
forall a b. (a, b) -> b
snd ((Int, Text) -> Text) -> (Int, Text) -> Text
forall a b. (a -> b) -> a -> b
$ (Int -> Char -> (Int, Char)) -> Int -> Text -> (Int, Text)
forall a. (a -> Char -> (a, Char)) -> a -> Text -> (a, Text)
T.mapAccumL Int -> Char -> (Int, Char)
g Int
0 Text
ts
where
g :: Int -> Char -> (Int, Char)
g Int
k Char
v = (Int -> Int
forall a. Enum a => a -> a
succ Int
k, if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
MonoKey Text
i then Element Text -> Element Text
f Char
Element Text
v else Char
v)
instance MonoAdjustable TL.Text where
{-# INLINE oadjust #-}
oadjust :: (Element Text -> Element Text) -> MonoKey Text -> Text -> Text
oadjust Element Text -> Element Text
f MonoKey Text
i Text
ts
| Int
MonoKey Text
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
Bool -> Bool -> Bool
|| Int
MonoKey Text
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Text -> Int64
TL.length Text
ts) = Text
ts
| Bool
otherwise = (Int, Text) -> Text
forall a b. (a, b) -> b
snd ((Int, Text) -> Text) -> (Int, Text) -> Text
forall a b. (a -> b) -> a -> b
$ (Int -> Char -> (Int, Char)) -> Int -> Text -> (Int, Text)
forall a. (a -> Char -> (a, Char)) -> a -> Text -> (a, Text)
TL.mapAccumL Int -> Char -> (Int, Char)
g Int
0 Text
ts
where
g :: Int -> Char -> (Int, Char)
g Int
k Char
v = (Int -> Int
forall a. Enum a => a -> a
succ Int
k, if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
MonoKey Text
i then Element Text -> Element Text
f Char
Element Text
v else Char
v)
instance MonoAdjustable (Tree a) where
{-# INLINE oadjust #-}
oadjust :: (Element (Tree a) -> Element (Tree a))
-> MonoKey (Tree a) -> Tree a -> Tree a
oadjust = (Element (Tree a) -> Element (Tree a))
-> MonoKey (Tree a) -> Tree a -> Tree a
forall (f :: * -> *) a.
Adjustable f =>
(a -> a) -> Key f -> f a -> f a
adjust
instance MonoAdjustable (Vector a) where
{-# INLINE oadjust #-}
oadjust :: (Element (Vector a) -> Element (Vector a))
-> MonoKey (Vector a) -> Vector a -> Vector a
oadjust = (Element (Vector a) -> Element (Vector a))
-> MonoKey (Vector a) -> Vector a -> Vector a
forall (f :: * -> *) a.
Adjustable f =>
(a -> a) -> Key f -> f a -> f a
adjust
instance VU.Unbox a => MonoAdjustable (VU.Vector a) where
{-# INLINE oadjust #-}
oadjust :: (Element (Vector a) -> Element (Vector a))
-> MonoKey (Vector a) -> Vector a -> Vector a
oadjust Element (Vector a) -> Element (Vector a)
f MonoKey (Vector a)
i = (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
forall a.
Unbox a =>
(forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
VU.modify ((forall s. MVector s a -> ST s ()) -> Vector a -> Vector a)
-> (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
forall a b. (a -> b) -> a -> b
$ \MVector s a
v -> MVector (PrimState (ST s)) a -> (a -> a) -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> (a -> a) -> Int -> m ()
VUM.modify MVector s a
MVector (PrimState (ST s)) a
v a -> a
Element (Vector a) -> Element (Vector a)
f Int
MonoKey (Vector a)
i
instance VS.Storable a => MonoAdjustable (VS.Vector a) where
{-# INLINE oadjust #-}
oadjust :: (Element (Vector a) -> Element (Vector a))
-> MonoKey (Vector a) -> Vector a -> Vector a
oadjust Element (Vector a) -> Element (Vector a)
f MonoKey (Vector a)
i = (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
forall a.
Storable a =>
(forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
VS.modify ((forall s. MVector s a -> ST s ()) -> Vector a -> Vector a)
-> (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a
forall a b. (a -> b) -> a -> b
$ \MVector s a
v -> MVector (PrimState (ST s)) a -> (a -> a) -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> (a -> a) -> Int -> m ()
VSM.modify MVector s a
MVector (PrimState (ST s)) a
v a -> a
Element (Vector a) -> Element (Vector a)
f Int
MonoKey (Vector a)
i
instance MonoAdjustable (ViewL a) where
{-# INLINE oadjust #-}
oadjust :: (Element (ViewL a) -> Element (ViewL a))
-> MonoKey (ViewL a) -> ViewL a -> ViewL a
oadjust Element (ViewL a) -> Element (ViewL a)
f = (ViewL a -> ViewL a) -> MonoKey (ViewL a) -> ViewL a -> ViewL a
forall a b. a -> b -> a
const ((ViewL a -> ViewL a) -> MonoKey (ViewL a) -> ViewL a -> ViewL a)
-> (ViewL a -> ViewL a) -> MonoKey (ViewL a) -> ViewL a -> ViewL a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> ViewL a -> ViewL a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
Element (ViewL a) -> Element (ViewL a)
f
instance MonoAdjustable (ViewR a) where
{-# INLINE oadjust #-}
oadjust :: (Element (ViewR a) -> Element (ViewR a))
-> MonoKey (ViewR a) -> ViewR a -> ViewR a
oadjust Element (ViewR a) -> Element (ViewR a)
f = (ViewR a -> ViewR a) -> MonoKey (ViewR a) -> ViewR a -> ViewR a
forall a b. a -> b -> a
const ((ViewR a -> ViewR a) -> MonoKey (ViewR a) -> ViewR a -> ViewR a)
-> (ViewR a -> ViewR a) -> MonoKey (ViewR a) -> ViewR a -> ViewR a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> ViewR a -> ViewR a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
Element (ViewR a) -> Element (ViewR a)
f
instance Arrow a => MonoAdjustable (WrappedArrow a b c) where
{-# INLINE oadjust #-}
oadjust :: (Element (WrappedArrow a b c) -> Element (WrappedArrow a b c))
-> MonoKey (WrappedArrow a b c)
-> WrappedArrow a b c
-> WrappedArrow a b c
oadjust Element (WrappedArrow a b c) -> Element (WrappedArrow a b c)
f = (WrappedArrow a b c -> WrappedArrow a b c)
-> MonoKey (WrappedArrow a b c)
-> WrappedArrow a b c
-> WrappedArrow a b c
forall a b. a -> b -> a
const ((WrappedArrow a b c -> WrappedArrow a b c)
-> MonoKey (WrappedArrow a b c)
-> WrappedArrow a b c
-> WrappedArrow a b c)
-> (WrappedArrow a b c -> WrappedArrow a b c)
-> MonoKey (WrappedArrow a b c)
-> WrappedArrow a b c
-> WrappedArrow a b c
forall a b. (a -> b) -> a -> b
$ (c -> c) -> WrappedArrow a b c -> WrappedArrow a b c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> c
Element (WrappedArrow a b c) -> Element (WrappedArrow a b c)
f
instance Monad m => MonoAdjustable (WrappedMonad m a) where
{-# INLINE oadjust #-}
oadjust :: (Element (WrappedMonad m a) -> Element (WrappedMonad m a))
-> MonoKey (WrappedMonad m a)
-> WrappedMonad m a
-> WrappedMonad m a
oadjust Element (WrappedMonad m a) -> Element (WrappedMonad m a)
f = (WrappedMonad m a -> WrappedMonad m a)
-> MonoKey (WrappedMonad m a)
-> WrappedMonad m a
-> WrappedMonad m a
forall a b. a -> b -> a
const ((WrappedMonad m a -> WrappedMonad m a)
-> MonoKey (WrappedMonad m a)
-> WrappedMonad m a
-> WrappedMonad m a)
-> (WrappedMonad m a -> WrappedMonad m a)
-> MonoKey (WrappedMonad m a)
-> WrappedMonad m a
-> WrappedMonad m a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> WrappedMonad m a -> WrappedMonad m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
Element (WrappedMonad m a) -> Element (WrappedMonad m a)
f
instance Functor m => MonoAdjustable (WriterT w m a) where
{-# INLINE oadjust #-}
oadjust :: (Element (WriterT w m a) -> Element (WriterT w m a))
-> MonoKey (WriterT w m a) -> WriterT w m a -> WriterT w m a
oadjust Element (WriterT w m a) -> Element (WriterT w m a)
f = (WriterT w m a -> WriterT w m a)
-> MonoKey (WriterT w m a) -> WriterT w m a -> WriterT w m a
forall a b. a -> b -> a
const ((WriterT w m a -> WriterT w m a)
-> MonoKey (WriterT w m a) -> WriterT w m a -> WriterT w m a)
-> (WriterT w m a -> WriterT w m a)
-> MonoKey (WriterT w m a)
-> WriterT w m a
-> WriterT w m a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> WriterT w m a -> WriterT w m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
Element (WriterT w m a) -> Element (WriterT w m a)
f
instance Functor m => MonoAdjustable (S.WriterT w m a) where
{-# INLINE oadjust #-}
oadjust :: (Element (WriterT w m a) -> Element (WriterT w m a))
-> MonoKey (WriterT w m a) -> WriterT w m a -> WriterT w m a
oadjust Element (WriterT w m a) -> Element (WriterT w m a)
f = (WriterT w m a -> WriterT w m a)
-> MonoKey (WriterT w m a) -> WriterT w m a -> WriterT w m a
forall a b. a -> b -> a
const ((WriterT w m a -> WriterT w m a)
-> MonoKey (WriterT w m a) -> WriterT w m a -> WriterT w m a)
-> (WriterT w m a -> WriterT w m a)
-> MonoKey (WriterT w m a)
-> WriterT w m a
-> WriterT w m a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> WriterT w m a -> WriterT w m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
Element (WriterT w m a) -> Element (WriterT w m a)
f
instance MonoAdjustable (ZipList a) where
{-# INLINE oadjust #-}
oadjust :: (Element (ZipList a) -> Element (ZipList a))
-> MonoKey (ZipList a) -> ZipList a -> ZipList a
oadjust = (Element (ZipList a) -> Element (ZipList a))
-> MonoKey (ZipList a) -> ZipList a -> ZipList a
forall (f :: * -> *) a.
Adjustable f =>
(a -> a) -> Key f -> f a -> f a
adjust
instance MonoZip (r -> a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (r -> a) -> Element (r -> a) -> Element (r -> a))
-> (r -> a) -> (r -> a) -> r -> a
ozipWith = (Element (r -> a) -> Element (r -> a) -> Element (r -> a))
-> (r -> a) -> (r -> a) -> r -> a
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith
instance MonoZip [a] where
{-# INLINE ozipWith #-}
ozipWith :: (Element [a] -> Element [a] -> Element [a]) -> [a] -> [a] -> [a]
ozipWith = (Element [a] -> Element [a] -> Element [a]) -> [a] -> [a] -> [a]
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith
instance MonoZip (a, b) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (a, b) -> Element (a, b) -> Element (a, b))
-> (a, b) -> (a, b) -> (a, b)
ozipWith Element (a, b) -> Element (a, b) -> Element (a, b)
f (a
_, b
b1) (a
a, b
b2) = (a
a, Element (a, b) -> Element (a, b) -> Element (a, b)
f b
Element (a, b)
b1 b
Element (a, b)
b2)
instance MonoZip (Arg a b) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (Arg a b) -> Element (Arg a b) -> Element (Arg a b))
-> Arg a b -> Arg a b -> Arg a b
ozipWith Element (Arg a b) -> Element (Arg a b) -> Element (Arg a b)
f (Arg a
_ b
b1) (Arg a
a b
b2) = a -> Element (Arg a b) -> Arg a (Element (Arg a b))
forall a b. a -> b -> Arg a b
Arg a
a (Element (Arg a b) -> Arg a (Element (Arg a b)))
-> Element (Arg a b) -> Arg a (Element (Arg a b))
forall a b. (a -> b) -> a -> b
$ Element (Arg a b) -> Element (Arg a b) -> Element (Arg a b)
f b
Element (Arg a b)
b1 b
Element (Arg a b)
b2
instance MonoZip BS.ByteString where
{-# INLINE ozipWith #-}
ozipWith :: (Element ByteString -> Element ByteString -> Element ByteString)
-> ByteString -> ByteString -> ByteString
ozipWith Element ByteString -> Element ByteString -> Element ByteString
f ByteString
bs = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> (ByteString -> [Word8]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> [Word8]
forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
BS.zipWith Word8 -> Word8 -> Word8
Element ByteString -> Element ByteString -> Element ByteString
f ByteString
bs
instance MonoZip BSL.ByteString where
{-# INLINE ozipWith #-}
ozipWith :: (Element ByteString -> Element ByteString -> Element ByteString)
-> ByteString -> ByteString -> ByteString
ozipWith Element ByteString -> Element ByteString -> Element ByteString
f ByteString
bs = [Word8] -> ByteString
BSL.pack ([Word8] -> ByteString)
-> (ByteString -> [Word8]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> [Word8]
forall a. (Word8 -> Word8 -> a) -> ByteString -> ByteString -> [a]
BSL.zipWith Word8 -> Word8 -> Word8
Element ByteString -> Element ByteString -> Element ByteString
f ByteString
bs
instance ( Zip f
, Zip g
, MonoKey (f a) ~ Key f
, MonoKey (g a) ~ Key g
) => MonoZip (Compose f g a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (Compose f g a)
-> Element (Compose f g a) -> Element (Compose f g a))
-> Compose f g a -> Compose f g a -> Compose f g a
ozipWith = (Element (Compose f g a)
-> Element (Compose f g a) -> Element (Compose f g a))
-> Compose f g a -> Compose f g a -> Compose f g a
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith
instance MonoZip (Const m a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (Const m a) -> Element (Const m a) -> Element (Const m a))
-> Const m a -> Const m a -> Const m a
ozipWith = (Const m a -> Const m a -> Const m a)
-> (Element (Const m a)
-> Element (Const m a) -> Element (Const m a))
-> Const m a
-> Const m a
-> Const m a
forall a b. a -> b -> a
const ((Const m a -> Const m a -> Const m a)
-> (Element (Const m a)
-> Element (Const m a) -> Element (Const m a))
-> Const m a
-> Const m a
-> Const m a)
-> (Const m a -> Const m a -> Const m a)
-> (Element (Const m a)
-> Element (Const m a) -> Element (Const m a))
-> Const m a
-> Const m a
-> Const m a
forall a b. (a -> b) -> a -> b
$ (Const m a -> Const m a) -> Const m a -> Const m a -> Const m a
forall a b. a -> b -> a
const Const m a -> Const m a
forall a. a -> a
id
instance Functor m => MonoZip (ContT r m a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (ContT r m a)
-> Element (ContT r m a) -> Element (ContT r m a))
-> ContT r m a -> ContT r m a -> ContT r m a
ozipWith = (Element (ContT r m a)
-> Element (ContT r m a) -> Element (ContT r m a))
-> ContT r m a -> ContT r m a -> ContT r m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
instance MonoZip (Either a b) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (Either a b)
-> Element (Either a b) -> Element (Either a b))
-> Either a b -> Either a b -> Either a b
ozipWith = (Element (Either a b)
-> Element (Either a b) -> Element (Either a b))
-> Either a b -> Either a b -> Either a b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
instance (Eq k, Hashable k) => MonoZip (HashMap k v) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (HashMap k v)
-> Element (HashMap k v) -> Element (HashMap k v))
-> HashMap k v -> HashMap k v -> HashMap k v
ozipWith Element (HashMap k v)
-> Element (HashMap k v) -> Element (HashMap k v)
f HashMap k v
x HashMap k v
y = (v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
forall k v1 v2 v3.
(Eq k, Hashable k) =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
HM.intersectionWith v -> v -> v
Element (HashMap k v)
-> Element (HashMap k v) -> Element (HashMap k v)
f HashMap k v
x HashMap k v
y HashMap k v -> HashMap k v -> HashMap k v
forall a. Semigroup a => a -> a -> a
<> HashMap k v -> HashMap k v -> HashMap k v
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HM.difference HashMap k v
x HashMap k v
y HashMap k v -> HashMap k v -> HashMap k v
forall a. Semigroup a => a -> a -> a
<> HashMap k v -> HashMap k v -> HashMap k v
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HM.difference HashMap k v
y HashMap k v
x
instance MonoZip (Identity a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (Identity a)
-> Element (Identity a) -> Element (Identity a))
-> Identity a -> Identity a -> Identity a
ozipWith = (Element (Identity a)
-> Element (Identity a) -> Element (Identity a))
-> Identity a -> Identity a -> Identity a
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith
instance Applicative m => MonoZip (IdentityT m a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (IdentityT m a)
-> Element (IdentityT m a) -> Element (IdentityT m a))
-> IdentityT m a -> IdentityT m a -> IdentityT m a
ozipWith = (Element (IdentityT m a)
-> Element (IdentityT m a) -> Element (IdentityT m a))
-> IdentityT m a -> IdentityT m a -> IdentityT m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
instance MonoZip (IntMap a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (IntMap a) -> Element (IntMap a) -> Element (IntMap a))
-> IntMap a -> IntMap a -> IntMap a
ozipWith Element (IntMap a) -> Element (IntMap a) -> Element (IntMap a)
f IntMap a
x IntMap a
y = (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith a -> a -> a
Element (IntMap a) -> Element (IntMap a) -> Element (IntMap a)
f IntMap a
x IntMap a
y IntMap a -> IntMap a -> IntMap a
forall a. Semigroup a => a -> a -> a
<> IntMap a -> IntMap a -> IntMap a
forall a b. IntMap a -> IntMap b -> IntMap a
IM.difference IntMap a
x IntMap a
y IntMap a -> IntMap a -> IntMap a
forall a. Semigroup a => a -> a -> a
<> IntMap a -> IntMap a -> IntMap a
forall a b. IntMap a -> IntMap b -> IntMap a
IM.difference IntMap a
y IntMap a
x
instance MonoZip (IO a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (IO a) -> Element (IO a) -> Element (IO a))
-> IO a -> IO a -> IO a
ozipWith = (Element (IO a) -> Element (IO a) -> Element (IO a))
-> IO a -> IO a -> IO a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
instance Applicative m => MonoZip (ListT m a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (ListT m a) -> Element (ListT m a) -> Element (ListT m a))
-> ListT m a -> ListT m a -> ListT m a
ozipWith Element (ListT m a) -> Element (ListT m a) -> Element (ListT m a)
f ListT m a
x ListT m a
y = m [a] -> ListT m a
forall (m :: * -> *) a. m [a] -> ListT m a
ListT (m [a] -> ListT m a) -> m [a] -> ListT m a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [a] -> [a] -> [a]
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith a -> a -> a
Element (ListT m a) -> Element (ListT m a) -> Element (ListT m a)
f ([a] -> [a] -> [a]) -> m [a] -> m ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListT m a -> m [a]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT ListT m a
x m ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ListT m a -> m [a]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT ListT m a
y
instance Ord k => MonoZip (Map k v) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (Map k v) -> Element (Map k v) -> Element (Map k v))
-> Map k v -> Map k v -> Map k v
ozipWith Element (Map k v) -> Element (Map k v) -> Element (Map k v)
f Map k v
x Map k v
y = (v -> v -> v) -> Map k v -> Map k v -> Map k v
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith v -> v -> v
Element (Map k v) -> Element (Map k v) -> Element (Map k v)
f Map k v
x Map k v
y Map k v -> Map k v -> Map k v
forall a. Semigroup a => a -> a -> a
<> Map k v -> Map k v -> Map k v
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map k v
x Map k v
y Map k v -> Map k v -> Map k v
forall a. Semigroup a => a -> a -> a
<> Map k v -> Map k v -> Map k v
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map k v
y Map k v
x
instance MonoZip (Maybe a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (Maybe a) -> Element (Maybe a) -> Element (Maybe a))
-> Maybe a -> Maybe a -> Maybe a
ozipWith = (Element (Maybe a) -> Element (Maybe a) -> Element (Maybe a))
-> Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
instance Applicative m => MonoZip (MaybeT m a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (MaybeT m a)
-> Element (MaybeT m a) -> Element (MaybeT m a))
-> MaybeT m a -> MaybeT m a -> MaybeT m a
ozipWith Element (MaybeT m a)
-> Element (MaybeT m a) -> Element (MaybeT m a)
f MaybeT m a
x MaybeT m a
y = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe a) -> MaybeT m a) -> m (Maybe a) -> MaybeT m a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
Element (MaybeT m a)
-> Element (MaybeT m a) -> Element (MaybeT m a)
f (Maybe a -> Maybe a -> Maybe a)
-> m (Maybe a) -> m (Maybe a -> Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT m a -> m (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT m a
x m (Maybe a -> Maybe a) -> m (Maybe a) -> m (Maybe a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MaybeT m a -> m (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT m a
y
instance MonoZip (NonEmpty a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (NonEmpty a)
-> Element (NonEmpty a) -> Element (NonEmpty a))
-> NonEmpty a -> NonEmpty a -> NonEmpty a
ozipWith Element (NonEmpty a)
-> Element (NonEmpty a) -> Element (NonEmpty a)
f (a
x:|[a]
xs) (a
y :|[a]
ys) = Element (NonEmpty a)
-> Element (NonEmpty a) -> Element (NonEmpty a)
f a
Element (NonEmpty a)
x a
Element (NonEmpty a)
y a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| (a -> a -> a) -> [a] -> [a] -> [a]
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith a -> a -> a
Element (NonEmpty a)
-> Element (NonEmpty a) -> Element (NonEmpty a)
f [a]
xs [a]
ys
#if MIN_VERSION_base(4,16,0)
#else
instance MonoZip (Option a) where
{-# INLINE ozipWith #-}
ozipWith = liftA2
#endif
instance ( Zip f
, Zip g
, MonoKey (f a) ~ Key f
, MonoKey (g a) ~ Key g
) => MonoZip (Product f g a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (Product f g a)
-> Element (Product f g a) -> Element (Product f g a))
-> Product f g a -> Product f g a -> Product f g a
ozipWith = (Element (Product f g a)
-> Element (Product f g a) -> Element (Product f g a))
-> Product f g a -> Product f g a -> Product f g a
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith
instance Applicative m => MonoZip (ReaderT r m a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (ReaderT r m a)
-> Element (ReaderT r m a) -> Element (ReaderT r m a))
-> ReaderT r m a -> ReaderT r m a -> ReaderT r m a
ozipWith = (Element (ReaderT r m a)
-> Element (ReaderT r m a) -> Element (ReaderT r m a))
-> ReaderT r m a -> ReaderT r m a -> ReaderT r m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
instance (Applicative m, Semigroup w) => MonoZip (RWST r w s m a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (RWST r w s m a)
-> Element (RWST r w s m a) -> Element (RWST r w s m a))
-> RWST r w s m a -> RWST r w s m a -> RWST r w s m a
ozipWith Element (RWST r w s m a)
-> Element (RWST r w s m a) -> Element (RWST r w s m a)
f (RWST r -> s -> m (a, s, w)
x) (RWST r -> s -> m (a, s, w)
y) = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s ->
let g :: (a, s, w) -> (a, s, w) -> (a, s, w)
g (a
a1, s
_, w
w1) (a
a2, s
_, w
w2) = (Element (RWST r w s m a)
-> Element (RWST r w s m a) -> Element (RWST r w s m a)
f a
Element (RWST r w s m a)
a1 a
Element (RWST r w s m a)
a2, s
s, w
w1 w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
w2)
in (a, s, w) -> (a, s, w) -> (a, s, w)
g ((a, s, w) -> (a, s, w) -> (a, s, w))
-> m (a, s, w) -> m ((a, s, w) -> (a, s, w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r -> s -> m (a, s, w)
x r
r s
s m ((a, s, w) -> (a, s, w)) -> m (a, s, w) -> m (a, s, w)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> r -> s -> m (a, s, w)
y r
r s
s
instance (Applicative m, Semigroup w) => MonoZip (S.RWST r w s m a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (RWST r w s m a)
-> Element (RWST r w s m a) -> Element (RWST r w s m a))
-> RWST r w s m a -> RWST r w s m a -> RWST r w s m a
ozipWith Element (RWST r w s m a)
-> Element (RWST r w s m a) -> Element (RWST r w s m a)
f (S.RWST r -> s -> m (a, s, w)
x) (S.RWST r -> s -> m (a, s, w)
y) = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
S.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s ->
let g :: (a, s, w) -> (a, s, w) -> (a, s, w)
g (a
a1, s
_, w
w1) (a
a2, s
_, w
w2) = (Element (RWST r w s m a)
-> Element (RWST r w s m a) -> Element (RWST r w s m a)
f a
Element (RWST r w s m a)
a1 a
Element (RWST r w s m a)
a2, s
s, w
w1 w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
w2)
in (a, s, w) -> (a, s, w) -> (a, s, w)
g ((a, s, w) -> (a, s, w) -> (a, s, w))
-> m (a, s, w) -> m ((a, s, w) -> (a, s, w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r -> s -> m (a, s, w)
x r
r s
s m ((a, s, w) -> (a, s, w)) -> m (a, s, w) -> m (a, s, w)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> r -> s -> m (a, s, w)
y r
r s
s
instance MonoZip (Seq a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (Seq a) -> Element (Seq a) -> Element (Seq a))
-> Seq a -> Seq a -> Seq a
ozipWith = (Element (Seq a) -> Element (Seq a) -> Element (Seq a))
-> Seq a -> Seq a -> Seq a
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith
instance Applicative m => MonoZip (StateT s m a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (StateT s m a)
-> Element (StateT s m a) -> Element (StateT s m a))
-> StateT s m a -> StateT s m a -> StateT s m a
ozipWith Element (StateT s m a)
-> Element (StateT s m a) -> Element (StateT s m a)
f (StateT s -> m (a, s)
x) (StateT s -> m (a, s)
y) = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \ s
s ->
let g :: (a, s) -> (a, s) -> (a, s)
g (a
a1, s
_) (a
a2, s
_) = (Element (StateT s m a)
-> Element (StateT s m a) -> Element (StateT s m a)
f a
Element (StateT s m a)
a1 a
Element (StateT s m a)
a2, s
s)
in (a, s) -> (a, s) -> (a, s)
g ((a, s) -> (a, s) -> (a, s)) -> m (a, s) -> m ((a, s) -> (a, s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (a, s)
x s
s m ((a, s) -> (a, s)) -> m (a, s) -> m (a, s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m (a, s)
y s
s
instance Applicative m => MonoZip (S.StateT s m a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (StateT s m a)
-> Element (StateT s m a) -> Element (StateT s m a))
-> StateT s m a -> StateT s m a -> StateT s m a
ozipWith Element (StateT s m a)
-> Element (StateT s m a) -> Element (StateT s m a)
f (S.StateT s -> m (a, s)
x) (S.StateT s -> m (a, s)
y) = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
S.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \ s
s ->
let g :: (a, s) -> (a, s) -> (a, s)
g (a
a1, s
_) (a
a2, s
_) = (Element (StateT s m a)
-> Element (StateT s m a) -> Element (StateT s m a)
f a
Element (StateT s m a)
a1 a
Element (StateT s m a)
a2, s
s)
in (a, s) -> (a, s) -> (a, s)
g ((a, s) -> (a, s) -> (a, s)) -> m (a, s) -> m ((a, s) -> (a, s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (a, s)
x s
s m ((a, s) -> (a, s)) -> m (a, s) -> m (a, s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m (a, s)
y s
s
instance MonoZip T.Text where
{-# INLINE ozipWith #-}
ozipWith :: (Element Text -> Element Text -> Element Text)
-> Text -> Text -> Text
ozipWith = (Char -> Char -> Char) -> Text -> Text -> Text
(Element Text -> Element Text -> Element Text)
-> Text -> Text -> Text
T.zipWith
instance MonoZip TL.Text where
{-# INLINE ozipWith #-}
ozipWith :: (Element Text -> Element Text -> Element Text)
-> Text -> Text -> Text
ozipWith = (Char -> Char -> Char) -> Text -> Text -> Text
(Element Text -> Element Text -> Element Text)
-> Text -> Text -> Text
TL.zipWith
instance MonoZip (Tree a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (Tree a) -> Element (Tree a) -> Element (Tree a))
-> Tree a -> Tree a -> Tree a
ozipWith = (Element (Tree a) -> Element (Tree a) -> Element (Tree a))
-> Tree a -> Tree a -> Tree a
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith
instance MonoZip (Vector a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (Vector a) -> Element (Vector a) -> Element (Vector a))
-> Vector a -> Vector a -> Vector a
ozipWith = (Element (Vector a) -> Element (Vector a) -> Element (Vector a))
-> Vector a -> Vector a -> Vector a
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith
instance VU.Unbox a => MonoZip (VU.Vector a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (Vector a) -> Element (Vector a) -> Element (Vector a))
-> Vector a -> Vector a -> Vector a
ozipWith = (Element (Vector a) -> Element (Vector a) -> Element (Vector a))
-> Vector a -> Vector a -> Vector a
forall a b c.
(Unbox a, Unbox b, Unbox c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
VU.zipWith
instance VS.Storable a => MonoZip (VS.Vector a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (Vector a) -> Element (Vector a) -> Element (Vector a))
-> Vector a -> Vector a -> Vector a
ozipWith = (Element (Vector a) -> Element (Vector a) -> Element (Vector a))
-> Vector a -> Vector a -> Vector a
forall a b c.
(Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
VS.zipWith
instance MonoZip (ViewL a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (ViewL a) -> Element (ViewL a) -> Element (ViewL a))
-> ViewL a -> ViewL a -> ViewL a
ozipWith Element (ViewL a) -> Element (ViewL a) -> Element (ViewL a)
_ ViewL a
EmptyL ViewL a
_ = ViewL a
forall a. ViewL a
EmptyL
ozipWith Element (ViewL a) -> Element (ViewL a) -> Element (ViewL a)
_ ViewL a
_ ViewL a
EmptyL = ViewL a
forall a. ViewL a
EmptyL
ozipWith Element (ViewL a) -> Element (ViewL a) -> Element (ViewL a)
f (a
x:<Seq a
xs) (a
y:<Seq a
ys) = Element (ViewL a) -> Element (ViewL a) -> Element (ViewL a)
f a
Element (ViewL a)
x a
Element (ViewL a)
y a -> Seq a -> ViewL a
forall a. a -> Seq a -> ViewL a
:< (a -> a -> a) -> Seq a -> Seq a -> Seq a
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith a -> a -> a
Element (ViewL a) -> Element (ViewL a) -> Element (ViewL a)
f Seq a
xs Seq a
ys
instance MonoZip (ViewR a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (ViewR a) -> Element (ViewR a) -> Element (ViewR a))
-> ViewR a -> ViewR a -> ViewR a
ozipWith Element (ViewR a) -> Element (ViewR a) -> Element (ViewR a)
_ ViewR a
EmptyR ViewR a
_ = ViewR a
forall a. ViewR a
EmptyR
ozipWith Element (ViewR a) -> Element (ViewR a) -> Element (ViewR a)
_ ViewR a
_ ViewR a
EmptyR = ViewR a
forall a. ViewR a
EmptyR
ozipWith Element (ViewR a) -> Element (ViewR a) -> Element (ViewR a)
f (Seq a
xs:>a
x) (Seq a
ys:>a
y) = (a -> a -> a) -> Seq a -> Seq a -> Seq a
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith a -> a -> a
Element (ViewR a) -> Element (ViewR a) -> Element (ViewR a)
f Seq a
xs Seq a
ys Seq a -> a -> ViewR a
forall a. Seq a -> a -> ViewR a
:> Element (ViewR a) -> Element (ViewR a) -> Element (ViewR a)
f a
Element (ViewR a)
x a
Element (ViewR a)
y
instance Arrow a => MonoZip (WrappedArrow a b c) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (WrappedArrow a b c)
-> Element (WrappedArrow a b c) -> Element (WrappedArrow a b c))
-> WrappedArrow a b c -> WrappedArrow a b c -> WrappedArrow a b c
ozipWith = (Element (WrappedArrow a b c)
-> Element (WrappedArrow a b c) -> Element (WrappedArrow a b c))
-> WrappedArrow a b c -> WrappedArrow a b c -> WrappedArrow a b c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
instance Monad m => MonoZip (WrappedMonad m a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (WrappedMonad m a)
-> Element (WrappedMonad m a) -> Element (WrappedMonad m a))
-> WrappedMonad m a -> WrappedMonad m a -> WrappedMonad m a
ozipWith = (Element (WrappedMonad m a)
-> Element (WrappedMonad m a) -> Element (WrappedMonad m a))
-> WrappedMonad m a -> WrappedMonad m a -> WrappedMonad m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
instance (Applicative m, Monoid w) => MonoZip (WriterT w m a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (WriterT w m a)
-> Element (WriterT w m a) -> Element (WriterT w m a))
-> WriterT w m a -> WriterT w m a -> WriterT w m a
ozipWith = (Element (WriterT w m a)
-> Element (WriterT w m a) -> Element (WriterT w m a))
-> WriterT w m a -> WriterT w m a -> WriterT w m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
instance (Applicative m, Monoid w) => MonoZip (S.WriterT w m a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (WriterT w m a)
-> Element (WriterT w m a) -> Element (WriterT w m a))
-> WriterT w m a -> WriterT w m a -> WriterT w m a
ozipWith = (Element (WriterT w m a)
-> Element (WriterT w m a) -> Element (WriterT w m a))
-> WriterT w m a -> WriterT w m a -> WriterT w m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
instance MonoZip (ZipList a) where
{-# INLINE ozipWith #-}
ozipWith :: (Element (ZipList a) -> Element (ZipList a) -> Element (ZipList a))
-> ZipList a -> ZipList a -> ZipList a
ozipWith = (Element (ZipList a) -> Element (ZipList a) -> Element (ZipList a))
-> ZipList a -> ZipList a -> ZipList a
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith
instance MonoZipWithKey (r -> a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (r -> a)
-> Element (r -> a) -> Element (r -> a) -> Element (r -> a))
-> (r -> a) -> (r -> a) -> r -> a
ozipWithKey MonoKey (r -> a)
-> Element (r -> a) -> Element (r -> a) -> Element (r -> a)
f = (a -> a -> a) -> (r -> a) -> (r -> a) -> r -> a
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith (MonoKey (r -> a)
-> Element (r -> a) -> Element (r -> a) -> Element (r -> a)
f ())
instance MonoZipWithKey [a] where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey [a] -> Element [a] -> Element [a] -> Element [a])
-> [a] -> [a] -> [a]
ozipWithKey = (MonoKey [a] -> Element [a] -> Element [a] -> Element [a])
-> [a] -> [a] -> [a]
forall (f :: * -> *) a b c.
ZipWithKey f =>
(Key f -> a -> b -> c) -> f a -> f b -> f c
zipWithKey
instance MonoZipWithKey (a, b) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (a, b)
-> Element (a, b) -> Element (a, b) -> Element (a, b))
-> (a, b) -> (a, b) -> (a, b)
ozipWithKey MonoKey (a, b)
-> Element (a, b) -> Element (a, b) -> Element (a, b)
f (a
_, b
b1) (a
a, b
b2) = (a
a, MonoKey (a, b)
-> Element (a, b) -> Element (a, b) -> Element (a, b)
f () b
Element (a, b)
b1 b
Element (a, b)
b2)
instance MonoZipWithKey (Arg a b) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (Arg a b)
-> Element (Arg a b) -> Element (Arg a b) -> Element (Arg a b))
-> Arg a b -> Arg a b -> Arg a b
ozipWithKey MonoKey (Arg a b)
-> Element (Arg a b) -> Element (Arg a b) -> Element (Arg a b)
f (Arg a
_ b
b1) (Arg a
a b
b2) = a -> Element (Arg a b) -> Arg a (Element (Arg a b))
forall a b. a -> b -> Arg a b
Arg a
a (Element (Arg a b) -> Arg a (Element (Arg a b)))
-> Element (Arg a b) -> Arg a (Element (Arg a b))
forall a b. (a -> b) -> a -> b
$ MonoKey (Arg a b)
-> Element (Arg a b) -> Element (Arg a b) -> Element (Arg a b)
f () b
Element (Arg a b)
b1 b
Element (Arg a b)
b2
instance MonoZipWithKey BS.ByteString where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey ByteString
-> Element ByteString -> Element ByteString -> Element ByteString)
-> ByteString -> ByteString -> ByteString
ozipWithKey MonoKey ByteString
-> Element ByteString -> Element ByteString -> Element ByteString
f ByteString
bs = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> (ByteString -> [Word8]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key [] -> Word8 -> Word8 -> Word8)
-> [Word8] -> [Word8] -> [Word8]
forall (f :: * -> *) a b c.
ZipWithKey f =>
(Key f -> a -> b -> c) -> f a -> f b -> f c
zipWithKey Key [] -> Word8 -> Word8 -> Word8
MonoKey ByteString
-> Element ByteString -> Element ByteString -> Element ByteString
f (ByteString -> [Word8]
BS.unpack ByteString
bs) ([Word8] -> [Word8])
-> (ByteString -> [Word8]) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack
instance MonoZipWithKey BSL.ByteString where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey ByteString
-> Element ByteString -> Element ByteString -> Element ByteString)
-> ByteString -> ByteString -> ByteString
ozipWithKey MonoKey ByteString
-> Element ByteString -> Element ByteString -> Element ByteString
f ByteString
bs = [Word8] -> ByteString
BSL.pack ([Word8] -> ByteString)
-> (ByteString -> [Word8]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key [] -> Word8 -> Word8 -> Word8)
-> [Word8] -> [Word8] -> [Word8]
forall (f :: * -> *) a b c.
ZipWithKey f =>
(Key f -> a -> b -> c) -> f a -> f b -> f c
zipWithKey Key [] -> Word8 -> Word8 -> Word8
MonoKey ByteString
-> Element ByteString -> Element ByteString -> Element ByteString
f (ByteString -> [Word8]
BSL.unpack ByteString
bs) ([Word8] -> [Word8])
-> (ByteString -> [Word8]) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BSL.unpack
instance ( ZipWithKey f
, ZipWithKey g
, MonoKey (f a) ~ Key f
, MonoKey (g a) ~ Key g
) => MonoZipWithKey (Compose f g a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (Compose f g a)
-> Element (Compose f g a)
-> Element (Compose f g a)
-> Element (Compose f g a))
-> Compose f g a -> Compose f g a -> Compose f g a
ozipWithKey = (MonoKey (Compose f g a)
-> Element (Compose f g a)
-> Element (Compose f g a)
-> Element (Compose f g a))
-> Compose f g a -> Compose f g a -> Compose f g a
forall (f :: * -> *) a b c.
ZipWithKey f =>
(Key f -> a -> b -> c) -> f a -> f b -> f c
zipWithKey
instance MonoZipWithKey (Const m a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (Const m a)
-> Element (Const m a)
-> Element (Const m a)
-> Element (Const m a))
-> Const m a -> Const m a -> Const m a
ozipWithKey = (Const m a -> Const m a -> Const m a)
-> (MonoKey (Const m a)
-> Element (Const m a)
-> Element (Const m a)
-> Element (Const m a))
-> Const m a
-> Const m a
-> Const m a
forall a b. a -> b -> a
const ((Const m a -> Const m a -> Const m a)
-> (MonoKey (Const m a)
-> Element (Const m a)
-> Element (Const m a)
-> Element (Const m a))
-> Const m a
-> Const m a
-> Const m a)
-> (Const m a -> Const m a -> Const m a)
-> (MonoKey (Const m a)
-> Element (Const m a)
-> Element (Const m a)
-> Element (Const m a))
-> Const m a
-> Const m a
-> Const m a
forall a b. (a -> b) -> a -> b
$ (Const m a -> Const m a) -> Const m a -> Const m a -> Const m a
forall a b. a -> b -> a
const Const m a -> Const m a
forall a. a -> a
id
instance Functor m => MonoZipWithKey (ContT r m a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (ContT r m a)
-> Element (ContT r m a)
-> Element (ContT r m a)
-> Element (ContT r m a))
-> ContT r m a -> ContT r m a -> ContT r m a
ozipWithKey MonoKey (ContT r m a)
-> Element (ContT r m a)
-> Element (ContT r m a)
-> Element (ContT r m a)
f = (a -> a -> a) -> ContT r m a -> ContT r m a -> ContT r m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (MonoKey (ContT r m a)
-> Element (ContT r m a)
-> Element (ContT r m a)
-> Element (ContT r m a)
f ())
instance MonoZipWithKey (Either a b) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (Either a b)
-> Element (Either a b)
-> Element (Either a b)
-> Element (Either a b))
-> Either a b -> Either a b -> Either a b
ozipWithKey MonoKey (Either a b)
-> Element (Either a b)
-> Element (Either a b)
-> Element (Either a b)
f = (b -> b -> b) -> Either a b -> Either a b -> Either a b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (MonoKey (Either a b)
-> Element (Either a b)
-> Element (Either a b)
-> Element (Either a b)
f ())
instance (Eq k, Hashable k) => MonoZipWithKey (HashMap k v) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (HashMap k v)
-> Element (HashMap k v)
-> Element (HashMap k v)
-> Element (HashMap k v))
-> HashMap k v -> HashMap k v -> HashMap k v
ozipWithKey MonoKey (HashMap k v)
-> Element (HashMap k v)
-> Element (HashMap k v)
-> Element (HashMap k v)
f HashMap k v
x HashMap k v
y = (k -> v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
forall k v1 v2 v3.
(Eq k, Hashable k) =>
(k -> v1 -> v2 -> v3)
-> HashMap k v1 -> HashMap k v2 -> HashMap k v3
HM.intersectionWithKey k -> v -> v -> v
MonoKey (HashMap k v)
-> Element (HashMap k v)
-> Element (HashMap k v)
-> Element (HashMap k v)
f HashMap k v
x HashMap k v
y HashMap k v -> HashMap k v -> HashMap k v
forall a. Semigroup a => a -> a -> a
<> HashMap k v -> HashMap k v -> HashMap k v
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HM.difference HashMap k v
x HashMap k v
y HashMap k v -> HashMap k v -> HashMap k v
forall a. Semigroup a => a -> a -> a
<> HashMap k v -> HashMap k v -> HashMap k v
forall k v w.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k w -> HashMap k v
HM.difference HashMap k v
y HashMap k v
x
instance MonoZipWithKey (Identity a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (Identity a)
-> Element (Identity a)
-> Element (Identity a)
-> Element (Identity a))
-> Identity a -> Identity a -> Identity a
ozipWithKey = (MonoKey (Identity a)
-> Element (Identity a)
-> Element (Identity a)
-> Element (Identity a))
-> Identity a -> Identity a -> Identity a
forall (f :: * -> *) a b c.
ZipWithKey f =>
(Key f -> a -> b -> c) -> f a -> f b -> f c
zipWithKey
instance Applicative m => MonoZipWithKey (IdentityT m a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (IdentityT m a)
-> Element (IdentityT m a)
-> Element (IdentityT m a)
-> Element (IdentityT m a))
-> IdentityT m a -> IdentityT m a -> IdentityT m a
ozipWithKey MonoKey (IdentityT m a)
-> Element (IdentityT m a)
-> Element (IdentityT m a)
-> Element (IdentityT m a)
f = (a -> a -> a) -> IdentityT m a -> IdentityT m a -> IdentityT m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (MonoKey (IdentityT m a)
-> Element (IdentityT m a)
-> Element (IdentityT m a)
-> Element (IdentityT m a)
f ())
instance MonoZipWithKey (IntMap a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (IntMap a)
-> Element (IntMap a) -> Element (IntMap a) -> Element (IntMap a))
-> IntMap a -> IntMap a -> IntMap a
ozipWithKey MonoKey (IntMap a)
-> Element (IntMap a) -> Element (IntMap a) -> Element (IntMap a)
f IntMap a
x IntMap a
y = (Int -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
forall a b c.
(Int -> a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWithKey Int -> a -> a -> a
MonoKey (IntMap a)
-> Element (IntMap a) -> Element (IntMap a) -> Element (IntMap a)
f IntMap a
x IntMap a
y IntMap a -> IntMap a -> IntMap a
forall a. Semigroup a => a -> a -> a
<> IntMap a -> IntMap a -> IntMap a
forall a b. IntMap a -> IntMap b -> IntMap a
IM.difference IntMap a
x IntMap a
y IntMap a -> IntMap a -> IntMap a
forall a. Semigroup a => a -> a -> a
<> IntMap a -> IntMap a -> IntMap a
forall a b. IntMap a -> IntMap b -> IntMap a
IM.difference IntMap a
y IntMap a
x
instance MonoZipWithKey (IO a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (IO a)
-> Element (IO a) -> Element (IO a) -> Element (IO a))
-> IO a -> IO a -> IO a
ozipWithKey MonoKey (IO a)
-> Element (IO a) -> Element (IO a) -> Element (IO a)
f = (a -> a -> a) -> IO a -> IO a -> IO a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (MonoKey (IO a)
-> Element (IO a) -> Element (IO a) -> Element (IO a)
f ())
instance Applicative m => MonoZipWithKey (ListT m a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (ListT m a)
-> Element (ListT m a)
-> Element (ListT m a)
-> Element (ListT m a))
-> ListT m a -> ListT m a -> ListT m a
ozipWithKey MonoKey (ListT m a)
-> Element (ListT m a)
-> Element (ListT m a)
-> Element (ListT m a)
f ListT m a
x ListT m a
y = m [a] -> ListT m a
forall (m :: * -> *) a. m [a] -> ListT m a
ListT (m [a] -> ListT m a) -> m [a] -> ListT m a
forall a b. (a -> b) -> a -> b
$ (Key [] -> a -> a -> a) -> [a] -> [a] -> [a]
forall (f :: * -> *) a b c.
ZipWithKey f =>
(Key f -> a -> b -> c) -> f a -> f b -> f c
zipWithKey Key [] -> a -> a -> a
MonoKey (ListT m a)
-> Element (ListT m a)
-> Element (ListT m a)
-> Element (ListT m a)
f ([a] -> [a] -> [a]) -> m [a] -> m ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListT m a -> m [a]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT ListT m a
x m ([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ListT m a -> m [a]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT ListT m a
y
instance Ord k => MonoZipWithKey (Map k v) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (Map k v)
-> Element (Map k v) -> Element (Map k v) -> Element (Map k v))
-> Map k v -> Map k v -> Map k v
ozipWithKey MonoKey (Map k v)
-> Element (Map k v) -> Element (Map k v) -> Element (Map k v)
f Map k v
x Map k v
y = (k -> v -> v -> v) -> Map k v -> Map k v -> Map k v
forall k a b c.
Ord k =>
(k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWithKey k -> v -> v -> v
MonoKey (Map k v)
-> Element (Map k v) -> Element (Map k v) -> Element (Map k v)
f Map k v
x Map k v
y Map k v -> Map k v -> Map k v
forall a. Semigroup a => a -> a -> a
<> Map k v -> Map k v -> Map k v
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map k v
x Map k v
y Map k v -> Map k v -> Map k v
forall a. Semigroup a => a -> a -> a
<> Map k v -> Map k v -> Map k v
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map k v
y Map k v
x
instance MonoZipWithKey (Maybe a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (Maybe a)
-> Element (Maybe a) -> Element (Maybe a) -> Element (Maybe a))
-> Maybe a -> Maybe a -> Maybe a
ozipWithKey MonoKey (Maybe a)
-> Element (Maybe a) -> Element (Maybe a) -> Element (Maybe a)
f = (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (MonoKey (Maybe a)
-> Element (Maybe a) -> Element (Maybe a) -> Element (Maybe a)
f ())
instance Monad m => MonoZipWithKey (MaybeT m a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (MaybeT m a)
-> Element (MaybeT m a)
-> Element (MaybeT m a)
-> Element (MaybeT m a))
-> MaybeT m a -> MaybeT m a -> MaybeT m a
ozipWithKey MonoKey (MaybeT m a)
-> Element (MaybeT m a)
-> Element (MaybeT m a)
-> Element (MaybeT m a)
f = (a -> a -> a) -> MaybeT m a -> MaybeT m a -> MaybeT m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (MonoKey (MaybeT m a)
-> Element (MaybeT m a)
-> Element (MaybeT m a)
-> Element (MaybeT m a)
f ())
instance MonoZipWithKey (NonEmpty a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (NonEmpty a)
-> Element (NonEmpty a)
-> Element (NonEmpty a)
-> Element (NonEmpty a))
-> NonEmpty a -> NonEmpty a -> NonEmpty a
ozipWithKey = (MonoKey (NonEmpty a)
-> Element (NonEmpty a)
-> Element (NonEmpty a)
-> Element (NonEmpty a))
-> NonEmpty a -> NonEmpty a -> NonEmpty a
forall (f :: * -> *) a b c.
ZipWithKey f =>
(Key f -> a -> b -> c) -> f a -> f b -> f c
zipWithKey
#if MIN_VERSION_base(4,16,0)
#else
instance MonoZipWithKey (Option a) where
{-# INLINE ozipWithKey #-}
ozipWithKey f = liftA2 (f ())
#endif
instance ( ZipWithKey f
, ZipWithKey g
, MonoKey (f a) ~ Key f
, MonoKey (g a) ~ Key g
) => MonoZipWithKey (Product f g a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (Product f g a)
-> Element (Product f g a)
-> Element (Product f g a)
-> Element (Product f g a))
-> Product f g a -> Product f g a -> Product f g a
ozipWithKey = (MonoKey (Product f g a)
-> Element (Product f g a)
-> Element (Product f g a)
-> Element (Product f g a))
-> Product f g a -> Product f g a -> Product f g a
forall (f :: * -> *) a b c.
ZipWithKey f =>
(Key f -> a -> b -> c) -> f a -> f b -> f c
zipWithKey
instance (Applicative m, ZipWithKey m) => MonoZipWithKey (ReaderT r m a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (ReaderT r m a)
-> Element (ReaderT r m a)
-> Element (ReaderT r m a)
-> Element (ReaderT r m a))
-> ReaderT r m a -> ReaderT r m a -> ReaderT r m a
ozipWithKey = (MonoKey (ReaderT r m a)
-> Element (ReaderT r m a)
-> Element (ReaderT r m a)
-> Element (ReaderT r m a))
-> ReaderT r m a -> ReaderT r m a -> ReaderT r m a
forall (f :: * -> *) a b c.
ZipWithKey f =>
(Key f -> a -> b -> c) -> f a -> f b -> f c
zipWithKey
instance (Applicative m, Semigroup w) => MonoZipWithKey (RWST r w s m a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (RWST r w s m a)
-> Element (RWST r w s m a)
-> Element (RWST r w s m a)
-> Element (RWST r w s m a))
-> RWST r w s m a -> RWST r w s m a -> RWST r w s m a
ozipWithKey MonoKey (RWST r w s m a)
-> Element (RWST r w s m a)
-> Element (RWST r w s m a)
-> Element (RWST r w s m a)
f (RWST r -> s -> m (a, s, w)
x) (RWST r -> s -> m (a, s, w)
y) = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s ->
let g :: (a, s, w) -> (a, s, w) -> (a, s, w)
g (a
a1, s
_, w
w1) (a
a2, s
_, w
w2) = (MonoKey (RWST r w s m a)
-> Element (RWST r w s m a)
-> Element (RWST r w s m a)
-> Element (RWST r w s m a)
f () a
Element (RWST r w s m a)
a1 a
Element (RWST r w s m a)
a2, s
s, w
w1 w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
w2)
in (a, s, w) -> (a, s, w) -> (a, s, w)
g ((a, s, w) -> (a, s, w) -> (a, s, w))
-> m (a, s, w) -> m ((a, s, w) -> (a, s, w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r -> s -> m (a, s, w)
x r
r s
s m ((a, s, w) -> (a, s, w)) -> m (a, s, w) -> m (a, s, w)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> r -> s -> m (a, s, w)
y r
r s
s
instance (Applicative m, Semigroup w) => MonoZipWithKey (S.RWST r w s m a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (RWST r w s m a)
-> Element (RWST r w s m a)
-> Element (RWST r w s m a)
-> Element (RWST r w s m a))
-> RWST r w s m a -> RWST r w s m a -> RWST r w s m a
ozipWithKey MonoKey (RWST r w s m a)
-> Element (RWST r w s m a)
-> Element (RWST r w s m a)
-> Element (RWST r w s m a)
f (S.RWST r -> s -> m (a, s, w)
x) (S.RWST r -> s -> m (a, s, w)
y) = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
S.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s ->
let g :: (a, s, w) -> (a, s, w) -> (a, s, w)
g (a
a1, s
_, w
w1) (a
a2, s
_, w
w2) = (MonoKey (RWST r w s m a)
-> Element (RWST r w s m a)
-> Element (RWST r w s m a)
-> Element (RWST r w s m a)
f () a
Element (RWST r w s m a)
a1 a
Element (RWST r w s m a)
a2, s
s, w
w1 w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
w2)
in (a, s, w) -> (a, s, w) -> (a, s, w)
g ((a, s, w) -> (a, s, w) -> (a, s, w))
-> m (a, s, w) -> m ((a, s, w) -> (a, s, w))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r -> s -> m (a, s, w)
x r
r s
s m ((a, s, w) -> (a, s, w)) -> m (a, s, w) -> m (a, s, w)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> r -> s -> m (a, s, w)
y r
r s
s
instance MonoZipWithKey (Seq a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (Seq a)
-> Element (Seq a) -> Element (Seq a) -> Element (Seq a))
-> Seq a -> Seq a -> Seq a
ozipWithKey = (MonoKey (Seq a)
-> Element (Seq a) -> Element (Seq a) -> Element (Seq a))
-> Seq a -> Seq a -> Seq a
forall (f :: * -> *) a b c.
ZipWithKey f =>
(Key f -> a -> b -> c) -> f a -> f b -> f c
zipWithKey
instance Applicative m => MonoZipWithKey (StateT s m a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (StateT s m a)
-> Element (StateT s m a)
-> Element (StateT s m a)
-> Element (StateT s m a))
-> StateT s m a -> StateT s m a -> StateT s m a
ozipWithKey MonoKey (StateT s m a)
-> Element (StateT s m a)
-> Element (StateT s m a)
-> Element (StateT s m a)
f (StateT s -> m (a, s)
x) (StateT s -> m (a, s)
y) = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \ s
s ->
let g :: (a, s) -> (a, s) -> (a, s)
g (a
a1, s
_) (a
a2, s
_) = (MonoKey (StateT s m a)
-> Element (StateT s m a)
-> Element (StateT s m a)
-> Element (StateT s m a)
f () a
Element (StateT s m a)
a1 a
Element (StateT s m a)
a2, s
s)
in (a, s) -> (a, s) -> (a, s)
g ((a, s) -> (a, s) -> (a, s)) -> m (a, s) -> m ((a, s) -> (a, s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (a, s)
x s
s m ((a, s) -> (a, s)) -> m (a, s) -> m (a, s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m (a, s)
y s
s
instance Applicative m => MonoZipWithKey (S.StateT s m a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (StateT s m a)
-> Element (StateT s m a)
-> Element (StateT s m a)
-> Element (StateT s m a))
-> StateT s m a -> StateT s m a -> StateT s m a
ozipWithKey MonoKey (StateT s m a)
-> Element (StateT s m a)
-> Element (StateT s m a)
-> Element (StateT s m a)
f (S.StateT s -> m (a, s)
x) (S.StateT s -> m (a, s)
y) = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
S.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \ s
s ->
let g :: (a, s) -> (a, s) -> (a, s)
g (a
a1, s
_) (a
a2, s
_) = (MonoKey (StateT s m a)
-> Element (StateT s m a)
-> Element (StateT s m a)
-> Element (StateT s m a)
f () a
Element (StateT s m a)
a1 a
Element (StateT s m a)
a2, s
s)
in (a, s) -> (a, s) -> (a, s)
g ((a, s) -> (a, s) -> (a, s)) -> m (a, s) -> m ((a, s) -> (a, s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (a, s)
x s
s m ((a, s) -> (a, s)) -> m (a, s) -> m (a, s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m (a, s)
y s
s
instance MonoZipWithKey T.Text where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey Text -> Element Text -> Element Text -> Element Text)
-> Text -> Text -> Text
ozipWithKey MonoKey Text -> Element Text -> Element Text -> Element Text
f Text
ts = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key [] -> Char -> Char -> Char) -> String -> String -> String
forall (f :: * -> *) a b c.
ZipWithKey f =>
(Key f -> a -> b -> c) -> f a -> f b -> f c
zipWithKey Key [] -> Char -> Char -> Char
MonoKey Text -> Element Text -> Element Text -> Element Text
f (Text -> String
T.unpack Text
ts) (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
instance MonoZipWithKey TL.Text where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey Text -> Element Text -> Element Text -> Element Text)
-> Text -> Text -> Text
ozipWithKey MonoKey Text -> Element Text -> Element Text -> Element Text
f Text
ts = String -> Text
TL.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key [] -> Char -> Char -> Char) -> String -> String -> String
forall (f :: * -> *) a b c.
ZipWithKey f =>
(Key f -> a -> b -> c) -> f a -> f b -> f c
zipWithKey Key [] -> Char -> Char -> Char
MonoKey Text -> Element Text -> Element Text -> Element Text
f (Text -> String
TL.unpack Text
ts) (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack
instance MonoZipWithKey (Tree a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (Tree a)
-> Element (Tree a) -> Element (Tree a) -> Element (Tree a))
-> Tree a -> Tree a -> Tree a
ozipWithKey = (MonoKey (Tree a)
-> Element (Tree a) -> Element (Tree a) -> Element (Tree a))
-> Tree a -> Tree a -> Tree a
forall (f :: * -> *) a b c.
ZipWithKey f =>
(Key f -> a -> b -> c) -> f a -> f b -> f c
zipWithKey
instance MonoZipWithKey (Vector a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (Vector a)
-> Element (Vector a) -> Element (Vector a) -> Element (Vector a))
-> Vector a -> Vector a -> Vector a
ozipWithKey = (MonoKey (Vector a)
-> Element (Vector a) -> Element (Vector a) -> Element (Vector a))
-> Vector a -> Vector a -> Vector a
forall a b c.
(Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c
V.izipWith
instance VU.Unbox a => MonoZipWithKey (VU.Vector a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (Vector a)
-> Element (Vector a) -> Element (Vector a) -> Element (Vector a))
-> Vector a -> Vector a -> Vector a
ozipWithKey = (MonoKey (Vector a)
-> Element (Vector a) -> Element (Vector a) -> Element (Vector a))
-> Vector a -> Vector a -> Vector a
forall a b c.
(Unbox a, Unbox b, Unbox c) =>
(Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c
VU.izipWith
instance VS.Storable a => MonoZipWithKey (VS.Vector a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (Vector a)
-> Element (Vector a) -> Element (Vector a) -> Element (Vector a))
-> Vector a -> Vector a -> Vector a
ozipWithKey = (MonoKey (Vector a)
-> Element (Vector a) -> Element (Vector a) -> Element (Vector a))
-> Vector a -> Vector a -> Vector a
forall a b c.
(Storable a, Storable b, Storable c) =>
(Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c
VS.izipWith
instance MonoZipWithKey (ViewL a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (ViewL a)
-> Element (ViewL a) -> Element (ViewL a) -> Element (ViewL a))
-> ViewL a -> ViewL a -> ViewL a
ozipWithKey MonoKey (ViewL a)
-> Element (ViewL a) -> Element (ViewL a) -> Element (ViewL a)
_ ViewL a
EmptyL ViewL a
_ = ViewL a
forall a. ViewL a
EmptyL
ozipWithKey MonoKey (ViewL a)
-> Element (ViewL a) -> Element (ViewL a) -> Element (ViewL a)
_ ViewL a
_ ViewL a
EmptyL = ViewL a
forall a. ViewL a
EmptyL
ozipWithKey MonoKey (ViewL a)
-> Element (ViewL a) -> Element (ViewL a) -> Element (ViewL a)
f (a
x:<Seq a
xs) (a
y:<Seq a
ys) = MonoKey (ViewL a)
-> Element (ViewL a) -> Element (ViewL a) -> Element (ViewL a)
f () a
Element (ViewL a)
x a
Element (ViewL a)
y a -> Seq a -> ViewL a
forall a. a -> Seq a -> ViewL a
:< [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList ((a -> a -> a) -> [a] -> [a] -> [a]
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith (MonoKey (ViewL a)
-> Element (ViewL a) -> Element (ViewL a) -> Element (ViewL a)
f ()) (Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs) (Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
ys))
instance MonoZipWithKey (ViewR a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (ViewR a)
-> Element (ViewR a) -> Element (ViewR a) -> Element (ViewR a))
-> ViewR a -> ViewR a -> ViewR a
ozipWithKey MonoKey (ViewR a)
-> Element (ViewR a) -> Element (ViewR a) -> Element (ViewR a)
_ ViewR a
EmptyR ViewR a
_ = ViewR a
forall a. ViewR a
EmptyR
ozipWithKey MonoKey (ViewR a)
-> Element (ViewR a) -> Element (ViewR a) -> Element (ViewR a)
_ ViewR a
_ ViewR a
EmptyR = ViewR a
forall a. ViewR a
EmptyR
ozipWithKey MonoKey (ViewR a)
-> Element (ViewR a) -> Element (ViewR a) -> Element (ViewR a)
f (Seq a
xs:>a
x) (Seq a
ys:>a
y) = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList ((a -> a -> a) -> [a] -> [a] -> [a]
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith (MonoKey (ViewR a)
-> Element (ViewR a) -> Element (ViewR a) -> Element (ViewR a)
f ()) (Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
xs) (Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
ys)) Seq a -> a -> ViewR a
forall a. Seq a -> a -> ViewR a
:> MonoKey (ViewR a)
-> Element (ViewR a) -> Element (ViewR a) -> Element (ViewR a)
f () a
Element (ViewR a)
x a
Element (ViewR a)
y
instance Arrow a => MonoZipWithKey (WrappedArrow a b c) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (WrappedArrow a b c)
-> Element (WrappedArrow a b c)
-> Element (WrappedArrow a b c)
-> Element (WrappedArrow a b c))
-> WrappedArrow a b c -> WrappedArrow a b c -> WrappedArrow a b c
ozipWithKey MonoKey (WrappedArrow a b c)
-> Element (WrappedArrow a b c)
-> Element (WrappedArrow a b c)
-> Element (WrappedArrow a b c)
f = (Element (WrappedArrow a b c)
-> Element (WrappedArrow a b c) -> Element (WrappedArrow a b c))
-> WrappedArrow a b (Element (WrappedArrow a b c))
-> WrappedArrow a b (Element (WrappedArrow a b c))
-> WrappedArrow a b (Element (WrappedArrow a b c))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((Element (WrappedArrow a b c)
-> Element (WrappedArrow a b c) -> Element (WrappedArrow a b c))
-> WrappedArrow a b (Element (WrappedArrow a b c))
-> WrappedArrow a b (Element (WrappedArrow a b c))
-> WrappedArrow a b (Element (WrappedArrow a b c)))
-> (Element (WrappedArrow a b c)
-> Element (WrappedArrow a b c) -> Element (WrappedArrow a b c))
-> WrappedArrow a b (Element (WrappedArrow a b c))
-> WrappedArrow a b (Element (WrappedArrow a b c))
-> WrappedArrow a b (Element (WrappedArrow a b c))
forall a b. (a -> b) -> a -> b
$ MonoKey (WrappedArrow a b c)
-> Element (WrappedArrow a b c)
-> Element (WrappedArrow a b c)
-> Element (WrappedArrow a b c)
f ()
instance Monad m => MonoZipWithKey (WrappedMonad m a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (WrappedMonad m a)
-> Element (WrappedMonad m a)
-> Element (WrappedMonad m a)
-> Element (WrappedMonad m a))
-> WrappedMonad m a -> WrappedMonad m a -> WrappedMonad m a
ozipWithKey MonoKey (WrappedMonad m a)
-> Element (WrappedMonad m a)
-> Element (WrappedMonad m a)
-> Element (WrappedMonad m a)
f = (Element (WrappedMonad m a)
-> Element (WrappedMonad m a) -> Element (WrappedMonad m a))
-> WrappedMonad m (Element (WrappedMonad m a))
-> WrappedMonad m (Element (WrappedMonad m a))
-> WrappedMonad m (Element (WrappedMonad m a))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((Element (WrappedMonad m a)
-> Element (WrappedMonad m a) -> Element (WrappedMonad m a))
-> WrappedMonad m (Element (WrappedMonad m a))
-> WrappedMonad m (Element (WrappedMonad m a))
-> WrappedMonad m (Element (WrappedMonad m a)))
-> (Element (WrappedMonad m a)
-> Element (WrappedMonad m a) -> Element (WrappedMonad m a))
-> WrappedMonad m (Element (WrappedMonad m a))
-> WrappedMonad m (Element (WrappedMonad m a))
-> WrappedMonad m (Element (WrappedMonad m a))
forall a b. (a -> b) -> a -> b
$ MonoKey (WrappedMonad m a)
-> Element (WrappedMonad m a)
-> Element (WrappedMonad m a)
-> Element (WrappedMonad m a)
f ()
instance (Applicative m, Monoid w) => MonoZipWithKey (WriterT w m a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (WriterT w m a)
-> Element (WriterT w m a)
-> Element (WriterT w m a)
-> Element (WriterT w m a))
-> WriterT w m a -> WriterT w m a -> WriterT w m a
ozipWithKey MonoKey (WriterT w m a)
-> Element (WriterT w m a)
-> Element (WriterT w m a)
-> Element (WriterT w m a)
f = (Element (WriterT w m a)
-> Element (WriterT w m a) -> Element (WriterT w m a))
-> WriterT w m (Element (WriterT w m a))
-> WriterT w m (Element (WriterT w m a))
-> WriterT w m (Element (WriterT w m a))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((Element (WriterT w m a)
-> Element (WriterT w m a) -> Element (WriterT w m a))
-> WriterT w m (Element (WriterT w m a))
-> WriterT w m (Element (WriterT w m a))
-> WriterT w m (Element (WriterT w m a)))
-> (Element (WriterT w m a)
-> Element (WriterT w m a) -> Element (WriterT w m a))
-> WriterT w m (Element (WriterT w m a))
-> WriterT w m (Element (WriterT w m a))
-> WriterT w m (Element (WriterT w m a))
forall a b. (a -> b) -> a -> b
$ MonoKey (WriterT w m a)
-> Element (WriterT w m a)
-> Element (WriterT w m a)
-> Element (WriterT w m a)
f ()
instance (Applicative m, Monoid w) => MonoZipWithKey (S.WriterT w m a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (WriterT w m a)
-> Element (WriterT w m a)
-> Element (WriterT w m a)
-> Element (WriterT w m a))
-> WriterT w m a -> WriterT w m a -> WriterT w m a
ozipWithKey MonoKey (WriterT w m a)
-> Element (WriterT w m a)
-> Element (WriterT w m a)
-> Element (WriterT w m a)
f = (Element (WriterT w m a)
-> Element (WriterT w m a) -> Element (WriterT w m a))
-> WriterT w m (Element (WriterT w m a))
-> WriterT w m (Element (WriterT w m a))
-> WriterT w m (Element (WriterT w m a))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((Element (WriterT w m a)
-> Element (WriterT w m a) -> Element (WriterT w m a))
-> WriterT w m (Element (WriterT w m a))
-> WriterT w m (Element (WriterT w m a))
-> WriterT w m (Element (WriterT w m a)))
-> (Element (WriterT w m a)
-> Element (WriterT w m a) -> Element (WriterT w m a))
-> WriterT w m (Element (WriterT w m a))
-> WriterT w m (Element (WriterT w m a))
-> WriterT w m (Element (WriterT w m a))
forall a b. (a -> b) -> a -> b
$ MonoKey (WriterT w m a)
-> Element (WriterT w m a)
-> Element (WriterT w m a)
-> Element (WriterT w m a)
f ()
instance MonoZipWithKey (ZipList a) where
{-# INLINE ozipWithKey #-}
ozipWithKey :: (MonoKey (ZipList a)
-> Element (ZipList a)
-> Element (ZipList a)
-> Element (ZipList a))
-> ZipList a -> ZipList a -> ZipList a
ozipWithKey = (MonoKey (ZipList a)
-> Element (ZipList a)
-> Element (ZipList a)
-> Element (ZipList a))
-> ZipList a -> ZipList a -> ZipList a
forall (f :: * -> *) a b c.
ZipWithKey f =>
(Key f -> a -> b -> c) -> f a -> f b -> f c
zipWithKey
ofoldlWithKeyUnwrap :: MonoFoldableWithKey mono
=> (x -> Element mono -> x) -> x -> (x -> b) -> mono -> b
ofoldlWithKeyUnwrap :: forall mono x b.
MonoFoldableWithKey mono =>
(x -> Element mono -> x) -> x -> (x -> b) -> mono -> b
ofoldlWithKeyUnwrap x -> Element mono -> x
f x
x x -> b
unwrap mono
mono = x -> b
unwrap ((x -> Element mono -> x) -> x -> mono -> x
forall mono a.
MonoFoldable mono =>
(a -> Element mono -> a) -> a -> mono -> a
ofoldl' x -> Element mono -> x
f x
x mono
mono)
ofoldWithKeyMUnwrap :: (Monad m, MonoFoldableWithKey mono)
=> (x -> Element mono -> m x) -> m x -> (x -> m b) -> mono -> m b
ofoldWithKeyMUnwrap :: forall (m :: * -> *) mono x b.
(Monad m, MonoFoldableWithKey mono) =>
(x -> Element mono -> m x) -> m x -> (x -> m b) -> mono -> m b
ofoldWithKeyMUnwrap x -> Element mono -> m x
f m x
mx x -> m b
unwrap mono
mono = do
x
x <- m x
mx
x
x' <- (x -> Element mono -> m x) -> x -> mono -> m x
forall mono (m :: * -> *) a.
(MonoFoldable mono, Monad m) =>
(a -> Element mono -> m a) -> a -> mono -> m a
ofoldlM x -> Element mono -> m x
f x
x mono
mono
x -> m b
unwrap x
x'
omapWithUnitKey :: MonoFunctor mono => (() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey :: forall mono.
MonoFunctor mono =>
(() -> Element mono -> Element mono) -> mono -> mono
omapWithUnitKey () -> Element mono -> Element mono
f = (Element mono -> Element mono) -> mono -> mono
forall mono.
MonoFunctor mono =>
(Element mono -> Element mono) -> mono -> mono
omap (() -> Element mono -> Element mono
f ())
monoFoldableWithUnitKey :: (Monoid m, MonoFoldable mono) => (() -> Element mono -> m) -> mono -> m
monoFoldableWithUnitKey :: forall m mono.
(Monoid m, MonoFoldable mono) =>
(() -> Element mono -> m) -> mono -> m
monoFoldableWithUnitKey () -> Element mono -> m
f = (Element mono -> m) -> mono -> m
forall mono m.
(MonoFoldable mono, Monoid m) =>
(Element mono -> m) -> mono -> m
ofoldMap (() -> Element mono -> m
f ())
monoFoldableWithIntegralKey
:: ( Integral i, MonoFoldable mono)
=> (a -> i -> Element mono -> a) -> a -> mono -> a
monoFoldableWithIntegralKey :: forall i mono a.
(Integral i, MonoFoldable mono) =>
(a -> i -> Element mono -> a) -> a -> mono -> a
monoFoldableWithIntegralKey a -> i -> Element mono -> a
f a
z = (State i a -> i -> a
forall s a. State s a -> s -> a
`S.evalState` i
0) (State i a -> a) -> (mono -> State i a) -> mono -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Element mono -> State i a) -> a -> mono -> State i a
forall mono (m :: * -> *) a.
(MonoFoldable mono, Monad m) =>
(a -> Element mono -> m a) -> a -> mono -> m a
ofoldlM a -> Element mono -> State i a
g a
z
where
g :: a -> Element mono -> State i a
g a
a Element mono
e = do
!i
k <- StateT i Identity i
forall (m :: * -> *) s. Monad m => StateT s m s
S.get
(i -> i) -> StateT i Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
S.modify i -> i
forall a. Enum a => a -> a
succ
a -> State i a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> State i a) -> a -> State i a
forall a b. (a -> b) -> a -> b
$ a -> i -> Element mono -> a
f a
a i
k Element mono
e
monoTraversableWithUnitKey
:: (Applicative f, MonoTraversable mono)
=> (() -> Element mono -> f (Element mono)) -> mono -> f mono
monoTraversableWithUnitKey :: forall (f :: * -> *) mono.
(Applicative f, MonoTraversable mono) =>
(() -> Element mono -> f (Element mono)) -> mono -> f mono
monoTraversableWithUnitKey () -> Element mono -> f (Element mono)
f = (Element mono -> f (Element mono)) -> mono -> f mono
forall mono (f :: * -> *).
(MonoTraversable mono, Applicative f) =>
(Element mono -> f (Element mono)) -> mono -> f mono
otraverse (() -> Element mono -> f (Element mono)
f ())
monoLookupFoldable :: (Integral i, MonoFoldable mono) => i -> mono -> Maybe (Element mono)
monoLookupFoldable :: forall i mono.
(Integral i, MonoFoldable mono) =>
i -> mono -> Maybe (Element mono)
monoLookupFoldable i
i mono
t
| i
i i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
0 = Maybe (Element mono)
forall a. Maybe a
Nothing
| Bool
otherwise = i -> [Element mono] -> Maybe (Element mono)
forall {t} {a}. (Eq t, Num t) => t -> [a] -> Maybe a
go i
i ([Element mono] -> Maybe (Element mono))
-> [Element mono] -> Maybe (Element mono)
forall a b. (a -> b) -> a -> b
$ mono -> [Element mono]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList mono
t
where
go :: t -> [a] -> Maybe a
go t
_ [] = Maybe a
forall a. Maybe a
Nothing
go t
0 [a
x] = a -> Maybe a
forall a. a -> Maybe a
Just a
x
go !t
n (a
_:[a]
xs) = t -> [a] -> Maybe a
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [a]
xs