{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
#if __GLASGOW_HASKELL__ < 708
{-# LANGUAGE Trustworthy #-}
#endif
module Control.Lens.Internal.Indexed
(
Indexed(..)
, Conjoined(..)
, Indexable(..)
, Indexing(..)
, indexing
, Indexing64(..)
, indexing64
, withIndex
, asIndex
) where
import Control.Applicative
import Control.Arrow as Arrow
import Control.Category
import Control.Comonad
import Control.Lens.Internal.Instances ()
import Control.Monad
import Control.Monad.Fix
import Data.Distributive
import Data.Functor.Bind
import Data.Functor.Contravariant
import Data.Int
import Data.Monoid
import Data.Profunctor.Closed
import Data.Profunctor
import Data.Profunctor.Rep
import Data.Profunctor.Sieve
import qualified Data.Semigroup as Semi
import Data.Traversable
import Prelude hiding ((.),id)
#ifndef SAFE
import Data.Profunctor.Unsafe
import Control.Lens.Internal.Coerce
#endif
class
( Choice p, Corepresentable p, Comonad (Corep p), Traversable (Corep p)
, Strong p, Representable p, Monad (Rep p), MonadFix (Rep p), Distributive (Rep p)
, Costrong p, ArrowLoop p, ArrowApply p, ArrowChoice p, Closed p
) => Conjoined p where
distrib :: Functor f => p a b -> p (f a) (f b)
distrib = (f a -> Rep p (f b)) -> p (f a) (f b)
forall (p :: * -> * -> *) d c.
Representable p =>
(d -> Rep p c) -> p d c
tabulate ((f a -> Rep p (f b)) -> p (f a) (f b))
-> (p a b -> f a -> Rep p (f b)) -> p a b -> p (f a) (f b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> Rep p b) -> f a -> Rep p (f b)
forall (g :: * -> *) (f :: * -> *) a b.
(Distributive g, Functor f) =>
(a -> g b) -> f a -> g (f b)
collect ((a -> Rep p b) -> f a -> Rep p (f b))
-> (p a b -> a -> Rep p b) -> p a b -> f a -> Rep p (f b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p a b -> a -> Rep p b
forall (p :: * -> * -> *) (f :: * -> *) a b.
Sieve p f =>
p a b -> a -> f b
sieve
{-# INLINE distrib #-}
conjoined :: ((p ~ (->)) => q (a -> b) r) -> q (p a b) r -> q (p a b) r
conjoined _ r :: q (p a b) r
r = q (p a b) r
r
{-# INLINE conjoined #-}
instance Conjoined (->) where
distrib :: (a -> b) -> f a -> f b
distrib = (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
{-# INLINE distrib #-}
conjoined :: (((->) ~ (->)) => q (a -> b) r) -> q (a -> b) r -> q (a -> b) r
conjoined l :: ((->) ~ (->)) => q (a -> b) r
l _ = q (a -> b) r
((->) ~ (->)) => q (a -> b) r
l
{-# INLINE conjoined #-}
class Conjoined p => Indexable i p where
indexed :: p a b -> i -> a -> b
instance Indexable i (->) where
indexed :: (a -> b) -> i -> a -> b
indexed = (a -> b) -> i -> a -> b
forall a b. a -> b -> a
const
{-# INLINE indexed #-}
newtype Indexed i a b = Indexed { Indexed i a b -> i -> a -> b
runIndexed :: i -> a -> b }
instance Functor (Indexed i a) where
fmap :: (a -> b) -> Indexed i a a -> Indexed i a b
fmap g :: a -> b
g (Indexed f :: i -> a -> a
f) = (i -> a -> b) -> Indexed i a b
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> a -> b) -> Indexed i a b) -> (i -> a -> b) -> Indexed i a b
forall a b. (a -> b) -> a -> b
$ \i :: i
i a :: a
a -> a -> b
g (i -> a -> a
f i
i a
a)
{-# INLINE fmap #-}
instance Apply (Indexed i a) where
Indexed f :: i -> a -> a -> b
f <.> :: Indexed i a (a -> b) -> Indexed i a a -> Indexed i a b
<.> Indexed g :: i -> a -> a
g = (i -> a -> b) -> Indexed i a b
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> a -> b) -> Indexed i a b) -> (i -> a -> b) -> Indexed i a b
forall a b. (a -> b) -> a -> b
$ \i :: i
i a :: a
a -> i -> a -> a -> b
f i
i a
a (i -> a -> a
g i
i a
a)
{-# INLINE (<.>) #-}
instance Applicative (Indexed i a) where
pure :: a -> Indexed i a a
pure b :: a
b = (i -> a -> a) -> Indexed i a a
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> a -> a) -> Indexed i a a) -> (i -> a -> a) -> Indexed i a a
forall a b. (a -> b) -> a -> b
$ \_ _ -> a
b
{-# INLINE pure #-}
Indexed f :: i -> a -> a -> b
f <*> :: Indexed i a (a -> b) -> Indexed i a a -> Indexed i a b
<*> Indexed g :: i -> a -> a
g = (i -> a -> b) -> Indexed i a b
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> a -> b) -> Indexed i a b) -> (i -> a -> b) -> Indexed i a b
forall a b. (a -> b) -> a -> b
$ \i :: i
i a :: a
a -> i -> a -> a -> b
f i
i a
a (i -> a -> a
g i
i a
a)
{-# INLINE (<*>) #-}
instance Bind (Indexed i a) where
Indexed f :: i -> a -> a
f >>- :: Indexed i a a -> (a -> Indexed i a b) -> Indexed i a b
>>- k :: a -> Indexed i a b
k = (i -> a -> b) -> Indexed i a b
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> a -> b) -> Indexed i a b) -> (i -> a -> b) -> Indexed i a b
forall a b. (a -> b) -> a -> b
$ \i :: i
i a :: a
a -> Indexed i a b -> i -> a -> b
forall i a b. Indexed i a b -> i -> a -> b
runIndexed (a -> Indexed i a b
k (i -> a -> a
f i
i a
a)) i
i a
a
{-# INLINE (>>-) #-}
instance Monad (Indexed i a) where
return :: a -> Indexed i a a
return = a -> Indexed i a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE return #-}
Indexed f :: i -> a -> a
f >>= :: Indexed i a a -> (a -> Indexed i a b) -> Indexed i a b
>>= k :: a -> Indexed i a b
k = (i -> a -> b) -> Indexed i a b
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> a -> b) -> Indexed i a b) -> (i -> a -> b) -> Indexed i a b
forall a b. (a -> b) -> a -> b
$ \i :: i
i a :: a
a -> Indexed i a b -> i -> a -> b
forall i a b. Indexed i a b -> i -> a -> b
runIndexed (a -> Indexed i a b
k (i -> a -> a
f i
i a
a)) i
i a
a
{-# INLINE (>>=) #-}
instance MonadFix (Indexed i a) where
mfix :: (a -> Indexed i a a) -> Indexed i a a
mfix f :: a -> Indexed i a a
f = (i -> a -> a) -> Indexed i a a
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> a -> a) -> Indexed i a a) -> (i -> a -> a) -> Indexed i a a
forall a b. (a -> b) -> a -> b
$ \ i :: i
i a :: a
a -> let o :: a
o = Indexed i a a -> i -> a -> a
forall i a b. Indexed i a b -> i -> a -> b
runIndexed (a -> Indexed i a a
f a
o) i
i a
a in a
o
{-# INLINE mfix #-}
instance Profunctor (Indexed i) where
dimap :: (a -> b) -> (c -> d) -> Indexed i b c -> Indexed i a d
dimap ab :: a -> b
ab cd :: c -> d
cd ibc :: Indexed i b c
ibc = (i -> a -> d) -> Indexed i a d
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> a -> d) -> Indexed i a d) -> (i -> a -> d) -> Indexed i a d
forall a b. (a -> b) -> a -> b
$ \i :: i
i -> c -> d
cd (c -> d) -> (a -> c) -> a -> d
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Indexed i b c -> i -> b -> c
forall i a b. Indexed i a b -> i -> a -> b
runIndexed Indexed i b c
ibc i
i (b -> c) -> (a -> b) -> a -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
ab
{-# INLINE dimap #-}
lmap :: (a -> b) -> Indexed i b c -> Indexed i a c
lmap ab :: a -> b
ab ibc :: Indexed i b c
ibc = (i -> a -> c) -> Indexed i a c
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> a -> c) -> Indexed i a c) -> (i -> a -> c) -> Indexed i a c
forall a b. (a -> b) -> a -> b
$ \i :: i
i -> Indexed i b c -> i -> b -> c
forall i a b. Indexed i a b -> i -> a -> b
runIndexed Indexed i b c
ibc i
i (b -> c) -> (a -> b) -> a -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
ab
{-# INLINE lmap #-}
rmap :: (b -> c) -> Indexed i a b -> Indexed i a c
rmap bc :: b -> c
bc iab :: Indexed i a b
iab = (i -> a -> c) -> Indexed i a c
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> a -> c) -> Indexed i a c) -> (i -> a -> c) -> Indexed i a c
forall a b. (a -> b) -> a -> b
$ \i :: i
i -> b -> c
bc (b -> c) -> (a -> b) -> a -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Indexed i a b -> i -> a -> b
forall i a b. Indexed i a b -> i -> a -> b
runIndexed Indexed i a b
iab i
i
{-# INLINE rmap #-}
#ifndef SAFE
( .# ) ibc :: Indexed i b c
ibc _ = Indexed i b c -> Indexed i a c
forall a b. Coercible a b => a -> b
coerce Indexed i b c
ibc
{-# INLINE ( .# ) #-}
( #. ) _ = Indexed i a b -> Indexed i a c
forall a b. Coercible a b => b -> a
coerce'
{-# INLINE ( #. ) #-}
#endif
instance Closed (Indexed i) where
closed :: Indexed i a b -> Indexed i (x -> a) (x -> b)
closed (Indexed iab :: i -> a -> b
iab) = (i -> (x -> a) -> x -> b) -> Indexed i (x -> a) (x -> b)
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> (x -> a) -> x -> b) -> Indexed i (x -> a) (x -> b))
-> (i -> (x -> a) -> x -> b) -> Indexed i (x -> a) (x -> b)
forall a b. (a -> b) -> a -> b
$ \i :: i
i xa :: x -> a
xa x :: x
x -> i -> a -> b
iab i
i (x -> a
xa x
x)
instance Costrong (Indexed i) where
unfirst :: Indexed i (a, d) (b, d) -> Indexed i a b
unfirst (Indexed iadbd :: i -> (a, d) -> (b, d)
iadbd) = (i -> a -> b) -> Indexed i a b
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> a -> b) -> Indexed i a b) -> (i -> a -> b) -> Indexed i a b
forall a b. (a -> b) -> a -> b
$ \i :: i
i a :: a
a -> let
(b :: b
b, d :: d
d) = i -> (a, d) -> (b, d)
iadbd i
i (a
a, d
d)
in b
b
instance Sieve (Indexed i) ((->) i) where
sieve :: Indexed i a b -> a -> i -> b
sieve = (i -> a -> b) -> a -> i -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((i -> a -> b) -> a -> i -> b)
-> (Indexed i a b -> i -> a -> b) -> Indexed i a b -> a -> i -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Indexed i a b -> i -> a -> b
forall i a b. Indexed i a b -> i -> a -> b
runIndexed
{-# INLINE sieve #-}
instance Representable (Indexed i) where
type Rep (Indexed i) = (->) i
tabulate :: (d -> Rep (Indexed i) c) -> Indexed i d c
tabulate = (i -> d -> c) -> Indexed i d c
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> d -> c) -> Indexed i d c)
-> ((d -> i -> c) -> i -> d -> c) -> (d -> i -> c) -> Indexed i d c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (d -> i -> c) -> i -> d -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip
{-# INLINE tabulate #-}
instance Cosieve (Indexed i) ((,) i) where
cosieve :: Indexed i a b -> (i, a) -> b
cosieve = (i -> a -> b) -> (i, a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((i -> a -> b) -> (i, a) -> b)
-> (Indexed i a b -> i -> a -> b) -> Indexed i a b -> (i, a) -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Indexed i a b -> i -> a -> b
forall i a b. Indexed i a b -> i -> a -> b
runIndexed
{-# INLINE cosieve #-}
instance Corepresentable (Indexed i) where
type Corep (Indexed i) = (,) i
cotabulate :: (Corep (Indexed i) d -> c) -> Indexed i d c
cotabulate = (i -> d -> c) -> Indexed i d c
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> d -> c) -> Indexed i d c)
-> (((i, d) -> c) -> i -> d -> c) -> ((i, d) -> c) -> Indexed i d c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((i, d) -> c) -> i -> d -> c
forall a b c. ((a, b) -> c) -> a -> b -> c
curry
{-# INLINE cotabulate #-}
instance Choice (Indexed i) where
right' :: Indexed i a b -> Indexed i (Either c a) (Either c b)
right' = Indexed i a b -> Indexed i (Either c a) (Either c b)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right
{-# INLINE right' #-}
instance Strong (Indexed i) where
second' :: Indexed i a b -> Indexed i (c, a) (c, b)
second' = Indexed i a b -> Indexed i (c, a) (c, b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second
{-# INLINE second' #-}
instance Category (Indexed i) where
id :: Indexed i a a
id = (i -> a -> a) -> Indexed i a a
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((a -> a) -> i -> a -> a
forall a b. a -> b -> a
const a -> a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)
{-# INLINE id #-}
Indexed f :: i -> b -> c
f . :: Indexed i b c -> Indexed i a b -> Indexed i a c
. Indexed g :: i -> a -> b
g = (i -> a -> c) -> Indexed i a c
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> a -> c) -> Indexed i a c) -> (i -> a -> c) -> Indexed i a c
forall a b. (a -> b) -> a -> b
$ \i :: i
i -> i -> b -> c
f i
i (b -> c) -> (a -> b) -> a -> c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. i -> a -> b
g i
i
{-# INLINE (.) #-}
instance Arrow (Indexed i) where
arr :: (b -> c) -> Indexed i b c
arr f :: b -> c
f = (i -> b -> c) -> Indexed i b c
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed (\_ -> b -> c
f)
{-# INLINE arr #-}
first :: Indexed i b c -> Indexed i (b, d) (c, d)
first f :: Indexed i b c
f = (i -> (b, d) -> (c, d)) -> Indexed i (b, d) (c, d)
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Arrow.first ((b -> c) -> (b, d) -> (c, d))
-> (i -> b -> c) -> i -> (b, d) -> (c, d)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Indexed i b c -> i -> b -> c
forall i a b. Indexed i a b -> i -> a -> b
runIndexed Indexed i b c
f)
{-# INLINE first #-}
second :: Indexed i b c -> Indexed i (d, b) (d, c)
second f :: Indexed i b c
f = (i -> (d, b) -> (d, c)) -> Indexed i (d, b) (d, c)
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arrow.second ((b -> c) -> (d, b) -> (d, c))
-> (i -> b -> c) -> i -> (d, b) -> (d, c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Indexed i b c -> i -> b -> c
forall i a b. Indexed i a b -> i -> a -> b
runIndexed Indexed i b c
f)
{-# INLINE second #-}
Indexed f :: i -> b -> c
f *** :: Indexed i b c -> Indexed i b' c' -> Indexed i (b, b') (c, c')
*** Indexed g :: i -> b' -> c'
g = (i -> (b, b') -> (c, c')) -> Indexed i (b, b') (c, c')
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> (b, b') -> (c, c')) -> Indexed i (b, b') (c, c'))
-> (i -> (b, b') -> (c, c')) -> Indexed i (b, b') (c, c')
forall a b. (a -> b) -> a -> b
$ \i :: i
i -> i -> b -> c
f i
i (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** i -> b' -> c'
g i
i
{-# INLINE (***) #-}
Indexed f :: i -> b -> c
f &&& :: Indexed i b c -> Indexed i b c' -> Indexed i b (c, c')
&&& Indexed g :: i -> b -> c'
g = (i -> b -> (c, c')) -> Indexed i b (c, c')
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> b -> (c, c')) -> Indexed i b (c, c'))
-> (i -> b -> (c, c')) -> Indexed i b (c, c')
forall a b. (a -> b) -> a -> b
$ \i :: i
i -> i -> b -> c
f i
i (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& i -> b -> c'
g i
i
{-# INLINE (&&&) #-}
instance ArrowChoice (Indexed i) where
left :: Indexed i b c -> Indexed i (Either b d) (Either c d)
left f :: Indexed i b c
f = (i -> Either b d -> Either c d)
-> Indexed i (Either b d) (Either c d)
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ((b -> c) -> Either b d -> Either c d)
-> (i -> b -> c) -> i -> Either b d -> Either c d
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Indexed i b c -> i -> b -> c
forall i a b. Indexed i a b -> i -> a -> b
runIndexed Indexed i b c
f)
{-# INLINE left #-}
right :: Indexed i b c -> Indexed i (Either d b) (Either d c)
right f :: Indexed i b c
f = (i -> Either d b -> Either d c)
-> Indexed i (Either d b) (Either d c)
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((b -> c) -> Either d b -> Either d c
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right ((b -> c) -> Either d b -> Either d c)
-> (i -> b -> c) -> i -> Either d b -> Either d c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Indexed i b c -> i -> b -> c
forall i a b. Indexed i a b -> i -> a -> b
runIndexed Indexed i b c
f)
{-# INLINE right #-}
Indexed f :: i -> b -> c
f +++ :: Indexed i b c
-> Indexed i b' c' -> Indexed i (Either b b') (Either c c')
+++ Indexed g :: i -> b' -> c'
g = (i -> Either b b' -> Either c c')
-> Indexed i (Either b b') (Either c c')
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> Either b b' -> Either c c')
-> Indexed i (Either b b') (Either c c'))
-> (i -> Either b b' -> Either c c')
-> Indexed i (Either b b') (Either c c')
forall a b. (a -> b) -> a -> b
$ \i :: i
i -> i -> b -> c
f i
i (b -> c) -> (b' -> c') -> Either b b' -> Either c c'
forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ i -> b' -> c'
g i
i
{-# INLINE (+++) #-}
Indexed f :: i -> b -> d
f ||| :: Indexed i b d -> Indexed i c d -> Indexed i (Either b c) d
||| Indexed g :: i -> c -> d
g = (i -> Either b c -> d) -> Indexed i (Either b c) d
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> Either b c -> d) -> Indexed i (Either b c) d)
-> (i -> Either b c -> d) -> Indexed i (Either b c) d
forall a b. (a -> b) -> a -> b
$ \i :: i
i -> i -> b -> d
f i
i (b -> d) -> (c -> d) -> Either b c -> d
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| i -> c -> d
g i
i
{-# INLINE (|||) #-}
instance ArrowApply (Indexed i) where
app :: Indexed i (Indexed i b c, b) c
app = (i -> (Indexed i b c, b) -> c) -> Indexed i (Indexed i b c, b) c
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> (Indexed i b c, b) -> c) -> Indexed i (Indexed i b c, b) c)
-> (i -> (Indexed i b c, b) -> c) -> Indexed i (Indexed i b c, b) c
forall a b. (a -> b) -> a -> b
$ \ i :: i
i (f :: Indexed i b c
f, b :: b
b) -> Indexed i b c -> i -> b -> c
forall i a b. Indexed i a b -> i -> a -> b
runIndexed Indexed i b c
f i
i b
b
{-# INLINE app #-}
instance ArrowLoop (Indexed i) where
loop :: Indexed i (b, d) (c, d) -> Indexed i b c
loop (Indexed f :: i -> (b, d) -> (c, d)
f) = (i -> b -> c) -> Indexed i b c
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> b -> c) -> Indexed i b c) -> (i -> b -> c) -> Indexed i b c
forall a b. (a -> b) -> a -> b
$ \i :: i
i b :: b
b -> let (c :: c
c,d :: d
d) = i -> (b, d) -> (c, d)
f i
i (b
b, d
d) in c
c
{-# INLINE loop #-}
instance Conjoined (Indexed i) where
distrib :: Indexed i a b -> Indexed i (f a) (f b)
distrib (Indexed iab :: i -> a -> b
iab) = (i -> f a -> f b) -> Indexed i (f a) (f b)
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> f a -> f b) -> Indexed i (f a) (f b))
-> (i -> f a -> f b) -> Indexed i (f a) (f b)
forall a b. (a -> b) -> a -> b
$ \i :: i
i fa :: f a
fa -> i -> a -> b
iab i
i (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa
{-# INLINE distrib #-}
instance i ~ j => Indexable i (Indexed j) where
indexed :: Indexed j a b -> i -> a -> b
indexed = Indexed j a b -> i -> a -> b
forall i a b. Indexed i a b -> i -> a -> b
runIndexed
{-# INLINE indexed #-}
newtype Indexing f a = Indexing { Indexing f a -> Int -> (Int, f a)
runIndexing :: Int -> (Int, f a) }
instance Functor f => Functor (Indexing f) where
fmap :: (a -> b) -> Indexing f a -> Indexing f b
fmap f :: a -> b
f (Indexing m :: Int -> (Int, f a)
m) = (Int -> (Int, f b)) -> Indexing f b
forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing ((Int -> (Int, f b)) -> Indexing f b)
-> (Int -> (Int, f b)) -> Indexing f b
forall a b. (a -> b) -> a -> b
$ \i :: Int
i -> case Int -> (Int, f a)
m Int
i of
(j :: Int
j, x :: f a
x) -> (Int
j, (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
x)
{-# INLINE fmap #-}
instance Apply f => Apply (Indexing f) where
Indexing mf :: Int -> (Int, f (a -> b))
mf <.> :: Indexing f (a -> b) -> Indexing f a -> Indexing f b
<.> Indexing ma :: Int -> (Int, f a)
ma = (Int -> (Int, f b)) -> Indexing f b
forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing ((Int -> (Int, f b)) -> Indexing f b)
-> (Int -> (Int, f b)) -> Indexing f b
forall a b. (a -> b) -> a -> b
$ \i :: Int
i -> case Int -> (Int, f (a -> b))
mf Int
i of
(j :: Int
j, ff :: f (a -> b)
ff) -> case Int -> (Int, f a)
ma Int
j of
~(k :: Int
k, fa :: f a
fa) -> (Int
k, f (a -> b)
ff f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f a
fa)
{-# INLINE (<.>) #-}
instance Applicative f => Applicative (Indexing f) where
pure :: a -> Indexing f a
pure x :: a
x = (Int -> (Int, f a)) -> Indexing f a
forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing ((Int -> (Int, f a)) -> Indexing f a)
-> (Int -> (Int, f a)) -> Indexing f a
forall a b. (a -> b) -> a -> b
$ \i :: Int
i -> (Int
i, a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
{-# INLINE pure #-}
Indexing mf :: Int -> (Int, f (a -> b))
mf <*> :: Indexing f (a -> b) -> Indexing f a -> Indexing f b
<*> Indexing ma :: Int -> (Int, f a)
ma = (Int -> (Int, f b)) -> Indexing f b
forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing ((Int -> (Int, f b)) -> Indexing f b)
-> (Int -> (Int, f b)) -> Indexing f b
forall a b. (a -> b) -> a -> b
$ \i :: Int
i -> case Int -> (Int, f (a -> b))
mf Int
i of
(j :: Int
j, ff :: f (a -> b)
ff) -> case Int -> (Int, f a)
ma Int
j of
~(k :: Int
k, fa :: f a
fa) -> (Int
k, f (a -> b)
ff f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
fa)
{-# INLINE (<*>) #-}
instance Contravariant f => Contravariant (Indexing f) where
contramap :: (a -> b) -> Indexing f b -> Indexing f a
contramap f :: a -> b
f (Indexing m :: Int -> (Int, f b)
m) = (Int -> (Int, f a)) -> Indexing f a
forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing ((Int -> (Int, f a)) -> Indexing f a)
-> (Int -> (Int, f a)) -> Indexing f a
forall a b. (a -> b) -> a -> b
$ \i :: Int
i -> case Int -> (Int, f b)
m Int
i of
(j :: Int
j, ff :: f b
ff) -> (Int
j, (a -> b) -> f b -> f a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f f b
ff)
{-# INLINE contramap #-}
instance Semi.Semigroup (f a) => Semi.Semigroup (Indexing f a) where
Indexing mx :: Int -> (Int, f a)
mx <> :: Indexing f a -> Indexing f a -> Indexing f a
<> Indexing my :: Int -> (Int, f a)
my = (Int -> (Int, f a)) -> Indexing f a
forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing ((Int -> (Int, f a)) -> Indexing f a)
-> (Int -> (Int, f a)) -> Indexing f a
forall a b. (a -> b) -> a -> b
$ \i :: Int
i -> case Int -> (Int, f a)
mx Int
i of
(j :: Int
j, x :: f a
x) -> case Int -> (Int, f a)
my Int
j of
~(k :: Int
k, y :: f a
y) -> (Int
k, f a
x f a -> f a -> f a
forall a. Semigroup a => a -> a -> a
Semi.<> f a
y)
{-# INLINE (<>) #-}
instance Monoid (f a) => Monoid (Indexing f a) where
mempty :: Indexing f a
mempty = (Int -> (Int, f a)) -> Indexing f a
forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing ((Int -> (Int, f a)) -> Indexing f a)
-> (Int -> (Int, f a)) -> Indexing f a
forall a b. (a -> b) -> a -> b
$ \i :: Int
i -> (Int
i, f a
forall a. Monoid a => a
mempty)
{-# INLINE mempty #-}
mappend :: Indexing f a -> Indexing f a -> Indexing f a
mappend (Indexing mx :: Int -> (Int, f a)
mx) (Indexing my :: Int -> (Int, f a)
my) = (Int -> (Int, f a)) -> Indexing f a
forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing ((Int -> (Int, f a)) -> Indexing f a)
-> (Int -> (Int, f a)) -> Indexing f a
forall a b. (a -> b) -> a -> b
$ \i :: Int
i -> case Int -> (Int, f a)
mx Int
i of
(j :: Int
j, x :: f a
x) -> case Int -> (Int, f a)
my Int
j of
~(k :: Int
k, y :: f a
y) -> (Int
k, f a -> f a -> f a
forall a. Monoid a => a -> a -> a
mappend f a
x f a
y)
{-# INLINE mappend #-}
indexing :: Indexable Int p => ((a -> Indexing f b) -> s -> Indexing f t) -> p a (f b) -> s -> f t
indexing :: ((a -> Indexing f b) -> s -> Indexing f t) -> p a (f b) -> s -> f t
indexing l :: (a -> Indexing f b) -> s -> Indexing f t
l iafb :: p a (f b)
iafb s :: s
s = (Int, f t) -> f t
forall a b. (a, b) -> b
snd ((Int, f t) -> f t) -> (Int, f t) -> f t
forall a b. (a -> b) -> a -> b
$ Indexing f t -> Int -> (Int, f t)
forall (f :: * -> *) a. Indexing f a -> Int -> (Int, f a)
runIndexing ((a -> Indexing f b) -> s -> Indexing f t
l (\a :: a
a -> (Int -> (Int, f b)) -> Indexing f b
forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing (\i :: Int
i -> Int
i Int -> (Int, f b) -> (Int, f b)
forall a b. a -> b -> b
`seq` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1, p a (f b) -> Int -> a -> f b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p a (f b)
iafb Int
i a
a))) s
s) 0
{-# INLINE indexing #-}
newtype Indexing64 f a = Indexing64 { Indexing64 f a -> Int64 -> (Int64, f a)
runIndexing64 :: Int64 -> (Int64, f a) }
instance Functor f => Functor (Indexing64 f) where
fmap :: (a -> b) -> Indexing64 f a -> Indexing64 f b
fmap f :: a -> b
f (Indexing64 m :: Int64 -> (Int64, f a)
m) = (Int64 -> (Int64, f b)) -> Indexing64 f b
forall (f :: * -> *) a. (Int64 -> (Int64, f a)) -> Indexing64 f a
Indexing64 ((Int64 -> (Int64, f b)) -> Indexing64 f b)
-> (Int64 -> (Int64, f b)) -> Indexing64 f b
forall a b. (a -> b) -> a -> b
$ \i :: Int64
i -> case Int64 -> (Int64, f a)
m Int64
i of
(j :: Int64
j, x :: f a
x) -> (Int64
j, (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
x)
{-# INLINE fmap #-}
instance Apply f => Apply (Indexing64 f) where
Indexing64 mf :: Int64 -> (Int64, f (a -> b))
mf <.> :: Indexing64 f (a -> b) -> Indexing64 f a -> Indexing64 f b
<.> Indexing64 ma :: Int64 -> (Int64, f a)
ma = (Int64 -> (Int64, f b)) -> Indexing64 f b
forall (f :: * -> *) a. (Int64 -> (Int64, f a)) -> Indexing64 f a
Indexing64 ((Int64 -> (Int64, f b)) -> Indexing64 f b)
-> (Int64 -> (Int64, f b)) -> Indexing64 f b
forall a b. (a -> b) -> a -> b
$ \i :: Int64
i -> case Int64 -> (Int64, f (a -> b))
mf Int64
i of
(j :: Int64
j, ff :: f (a -> b)
ff) -> case Int64 -> (Int64, f a)
ma Int64
j of
~(k :: Int64
k, fa :: f a
fa) -> (Int64
k, f (a -> b)
ff f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> f a
fa)
{-# INLINE (<.>) #-}
instance Applicative f => Applicative (Indexing64 f) where
pure :: a -> Indexing64 f a
pure x :: a
x = (Int64 -> (Int64, f a)) -> Indexing64 f a
forall (f :: * -> *) a. (Int64 -> (Int64, f a)) -> Indexing64 f a
Indexing64 ((Int64 -> (Int64, f a)) -> Indexing64 f a)
-> (Int64 -> (Int64, f a)) -> Indexing64 f a
forall a b. (a -> b) -> a -> b
$ \i :: Int64
i -> (Int64
i, a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
{-# INLINE pure #-}
Indexing64 mf :: Int64 -> (Int64, f (a -> b))
mf <*> :: Indexing64 f (a -> b) -> Indexing64 f a -> Indexing64 f b
<*> Indexing64 ma :: Int64 -> (Int64, f a)
ma = (Int64 -> (Int64, f b)) -> Indexing64 f b
forall (f :: * -> *) a. (Int64 -> (Int64, f a)) -> Indexing64 f a
Indexing64 ((Int64 -> (Int64, f b)) -> Indexing64 f b)
-> (Int64 -> (Int64, f b)) -> Indexing64 f b
forall a b. (a -> b) -> a -> b
$ \i :: Int64
i -> case Int64 -> (Int64, f (a -> b))
mf Int64
i of
(j :: Int64
j, ff :: f (a -> b)
ff) -> case Int64 -> (Int64, f a)
ma Int64
j of
~(k :: Int64
k, fa :: f a
fa) -> (Int64
k, f (a -> b)
ff f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
fa)
{-# INLINE (<*>) #-}
instance Contravariant f => Contravariant (Indexing64 f) where
contramap :: (a -> b) -> Indexing64 f b -> Indexing64 f a
contramap f :: a -> b
f (Indexing64 m :: Int64 -> (Int64, f b)
m) = (Int64 -> (Int64, f a)) -> Indexing64 f a
forall (f :: * -> *) a. (Int64 -> (Int64, f a)) -> Indexing64 f a
Indexing64 ((Int64 -> (Int64, f a)) -> Indexing64 f a)
-> (Int64 -> (Int64, f a)) -> Indexing64 f a
forall a b. (a -> b) -> a -> b
$ \i :: Int64
i -> case Int64 -> (Int64, f b)
m Int64
i of
(j :: Int64
j, ff :: f b
ff) -> (Int64
j, (a -> b) -> f b -> f a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f f b
ff)
{-# INLINE contramap #-}
indexing64 :: Indexable Int64 p => ((a -> Indexing64 f b) -> s -> Indexing64 f t) -> p a (f b) -> s -> f t
indexing64 :: ((a -> Indexing64 f b) -> s -> Indexing64 f t)
-> p a (f b) -> s -> f t
indexing64 l :: (a -> Indexing64 f b) -> s -> Indexing64 f t
l iafb :: p a (f b)
iafb s :: s
s = (Int64, f t) -> f t
forall a b. (a, b) -> b
snd ((Int64, f t) -> f t) -> (Int64, f t) -> f t
forall a b. (a -> b) -> a -> b
$ Indexing64 f t -> Int64 -> (Int64, f t)
forall (f :: * -> *) a. Indexing64 f a -> Int64 -> (Int64, f a)
runIndexing64 ((a -> Indexing64 f b) -> s -> Indexing64 f t
l (\a :: a
a -> (Int64 -> (Int64, f b)) -> Indexing64 f b
forall (f :: * -> *) a. (Int64 -> (Int64, f a)) -> Indexing64 f a
Indexing64 (\i :: Int64
i -> Int64
i Int64 -> (Int64, f b) -> (Int64, f b)
forall a b. a -> b -> b
`seq` (Int64
i Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ 1, p a (f b) -> Int64 -> a -> f b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p a (f b)
iafb Int64
i a
a))) s
s) 0
{-# INLINE indexing64 #-}
withIndex :: (Indexable i p, Functor f) => p (i, s) (f (j, t)) -> Indexed i s (f t)
withIndex :: p (i, s) (f (j, t)) -> Indexed i s (f t)
withIndex f :: p (i, s) (f (j, t))
f = (i -> s -> f t) -> Indexed i s (f t)
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> s -> f t) -> Indexed i s (f t))
-> (i -> s -> f t) -> Indexed i s (f t)
forall a b. (a -> b) -> a -> b
$ \i :: i
i a :: s
a -> (j, t) -> t
forall a b. (a, b) -> b
snd ((j, t) -> t) -> f (j, t) -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p (i, s) (f (j, t)) -> i -> (i, s) -> f (j, t)
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p (i, s) (f (j, t))
f i
i (i
i, s
a)
{-# INLINE withIndex #-}
asIndex :: (Indexable i p, Contravariant f, Functor f) => p i (f i) -> Indexed i s (f s)
asIndex :: p i (f i) -> Indexed i s (f s)
asIndex f :: p i (f i)
f = (i -> s -> f s) -> Indexed i s (f s)
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed ((i -> s -> f s) -> Indexed i s (f s))
-> (i -> s -> f s) -> Indexed i s (f s)
forall a b. (a -> b) -> a -> b
$ \i :: i
i _ -> f i -> f s
forall (f :: * -> *) a b.
(Functor f, Contravariant f) =>
f a -> f b
phantom (p i (f i) -> i -> i -> f i
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed p i (f i)
f i
i i
i)
{-# INLINE asIndex #-}