{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Trustworthy #-}
module Control.Lens.Internal.Indexed
(
Indexed(..)
, Conjoined(..)
, Indexable(..)
, Indexing(..)
, indexing
, Indexing64(..)
, indexing64
, withIndex
, asIndex
) where
import Prelude ()
import Control.Arrow as Arrow
import qualified Control.Category as C
import Control.Comonad
import Control.Lens.Internal.Prelude
import Control.Lens.Internal.Instances ()
import Control.Monad.Fix
import Data.Distributive
import Data.Functor.Bind
import Data.Int
import Data.Profunctor.Closed
import Data.Profunctor.Rep
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 b c a. (b -> c) -> (a -> b) -> 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 b c a. (b -> c) -> (a -> b) -> 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 (p ~ (->)) => q (a -> b) 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 ((->) ~ (->)) => q (a -> b) r
l q (a -> b) r
_ = 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 a -> b
g (Indexed 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 a
a -> a -> b
g (i -> a -> a
f i
i a
a)
{-# INLINE fmap #-}
instance Apply (Indexed i a) where
Indexed i -> a -> a -> b
f <.> :: Indexed i a (a -> b) -> Indexed i a a -> Indexed i a b
<.> Indexed 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 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 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
$ \i
_ a
_ -> a
b
{-# INLINE pure #-}
Indexed i -> a -> a -> b
f <*> :: Indexed i a (a -> b) -> Indexed i a a -> Indexed i a b
<*> Indexed 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 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 i -> a -> a
f >>- :: Indexed i a a -> (a -> Indexed i a b) -> Indexed i a b
>>- 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 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 i -> a -> a
f >>= :: Indexed i a a -> (a -> Indexed i a b) -> Indexed i a b
>>= 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 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 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 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 a -> b
ab c -> d
cd 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 -> c -> d
cd (c -> d) -> (a -> c) -> a -> d
forall b c a. (b -> c) -> (a -> b) -> 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 b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
ab
{-# INLINE dimap #-}
lmap :: (a -> b) -> Indexed i b c -> Indexed i a c
lmap a -> b
ab 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 -> 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 b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
ab
{-# INLINE lmap #-}
rmap :: (b -> c) -> Indexed i a b -> Indexed i a c
rmap b -> c
bc 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 -> b -> c
bc (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> 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 #-}
.# :: Indexed i b c -> q a b -> Indexed i a c
(.#) Indexed i b c
ibc q a b
_ = Indexed i b c -> Indexed i a c
coerce Indexed i b c
ibc
{-# INLINE (.#) #-}
#. :: q b c -> Indexed i a b -> Indexed i a c
(#.) q b c
_ = Indexed i a b -> Indexed i a c
coerce
{-# INLINE (#.) #-}
instance Closed (Indexed i) where
closed :: Indexed i a b -> Indexed i (x -> a) (x -> b)
closed (Indexed 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 x -> a
xa 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 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 a
a -> let
(b
b, 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 b c a. (b -> c) -> (a -> b) -> 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 b c a. (b -> c) -> (a -> b) -> 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 b c a. (b -> c) -> (a -> b) -> 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 b c a. (b -> c) -> (a -> b) -> 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 C.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 a. a -> a
id)
{-# INLINE id #-}
Indexed i -> b -> c
f . :: Indexed i b c -> Indexed i a b -> Indexed i a c
. Indexed 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 -> b -> c
f i
i (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> a -> b
g i
i
{-# INLINE (.) #-}
instance Arrow (Indexed i) where
arr :: (b -> c) -> Indexed i b c
arr b -> c
f = (i -> b -> c) -> Indexed i b c
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed (\i
_ -> b -> c
f)
{-# INLINE arr #-}
first :: Indexed i b c -> Indexed i (b, d) (c, d)
first 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 b c a. (b -> c) -> (a -> b) -> 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 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 b c a. (b -> c) -> (a -> b) -> 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 i -> b -> c
f *** :: Indexed i b c -> Indexed i b' c' -> Indexed i (b, b') (c, c')
*** Indexed 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 -> 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 i -> b -> c
f &&& :: Indexed i b c -> Indexed i b c' -> Indexed i b (c, c')
&&& Indexed 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 -> 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 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 b c a. (b -> c) -> (a -> b) -> 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 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 b c a. (b -> c) -> (a -> b) -> 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 i -> b -> c
f +++ :: Indexed i b c
-> Indexed i b' c' -> Indexed i (Either b b') (Either c c')
+++ Indexed 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 -> 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 i -> b -> d
f ||| :: Indexed i b d -> Indexed i c d -> Indexed i (Either b c) d
||| Indexed 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 -> 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 (Indexed i b c
f, 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 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 b
b -> let (c
c,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 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 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 a -> b
f (Indexing 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
$ \Int
i -> case Int -> (Int, f a)
m Int
i of
(Int
j, 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 Int -> (Int, f (a -> b))
mf <.> :: Indexing f (a -> b) -> Indexing f a -> Indexing f b
<.> Indexing 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
$ \Int
i -> case Int -> (Int, f (a -> b))
mf Int
i of
(Int
j, f (a -> b)
ff) -> case Int -> (Int, f a)
ma Int
j of
~(Int
k, 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 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
$ \Int
i -> (Int
i, a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
{-# INLINE pure #-}
Indexing Int -> (Int, f (a -> b))
mf <*> :: Indexing f (a -> b) -> Indexing f a -> Indexing f b
<*> Indexing 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
$ \Int
i -> case Int -> (Int, f (a -> b))
mf Int
i of
(Int
j, f (a -> b)
ff) -> case Int -> (Int, f a)
ma Int
j of
~(Int
k, 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 a -> b
f (Indexing 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
$ \Int
i -> case Int -> (Int, f b)
m Int
i of
(Int
j, 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 Semigroup (f a) => Semigroup (Indexing f a) where
Indexing Int -> (Int, f a)
mx <> :: Indexing f a -> Indexing f a -> Indexing f a
<> Indexing 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
$ \Int
i -> case Int -> (Int, f a)
mx Int
i of
(Int
j, f a
x) -> case Int -> (Int, f a)
my Int
j of
~(Int
k, f a
y) -> (Int
k, f a
x f a -> f a -> f a
forall a. Semigroup a => a -> a -> a
<> 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
$ \Int
i -> (Int
i, f a
forall a. Monoid a => a
mempty)
{-# INLINE mempty #-}
#if !(MIN_VERSION_base(4,11,0))
mappend (Indexing mx) (Indexing my) = Indexing $ \i -> case mx i of
(j, x) -> case my j of
~(k, y) -> (k, mappend x y)
{-# INLINE mappend #-}
#endif
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 (a -> Indexing f b) -> s -> Indexing f t
l p a (f b)
iafb 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 -> (Int -> (Int, f b)) -> Indexing f b
forall (f :: * -> *) a. (Int -> (Int, f a)) -> Indexing f a
Indexing (\Int
i -> Int
i Int -> (Int, f b) -> (Int, f b)
`seq` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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) Int
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 a -> b
f (Indexing64 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
$ \Int64
i -> case Int64 -> (Int64, f a)
m Int64
i of
(Int64
j, 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 Int64 -> (Int64, f (a -> b))
mf <.> :: Indexing64 f (a -> b) -> Indexing64 f a -> Indexing64 f b
<.> Indexing64 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
$ \Int64
i -> case Int64 -> (Int64, f (a -> b))
mf Int64
i of
(Int64
j, f (a -> b)
ff) -> case Int64 -> (Int64, f a)
ma Int64
j of
~(Int64
k, 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 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
$ \Int64
i -> (Int64
i, a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
{-# INLINE pure #-}
Indexing64 Int64 -> (Int64, f (a -> b))
mf <*> :: Indexing64 f (a -> b) -> Indexing64 f a -> Indexing64 f b
<*> Indexing64 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
$ \Int64
i -> case Int64 -> (Int64, f (a -> b))
mf Int64
i of
(Int64
j, f (a -> b)
ff) -> case Int64 -> (Int64, f a)
ma Int64
j of
~(Int64
k, 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 a -> b
f (Indexing64 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
$ \Int64
i -> case Int64 -> (Int64, f b)
m Int64
i of
(Int64
j, 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 (a -> Indexing64 f b) -> s -> Indexing64 f t
l p a (f b)
iafb 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 -> (Int64 -> (Int64, f b)) -> Indexing64 f b
forall (f :: * -> *) a. (Int64 -> (Int64, f a)) -> Indexing64 f a
Indexing64 (\Int64
i -> Int64
i Int64 -> (Int64, f b) -> (Int64, f b)
`seq` (Int64
i Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
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) Int64
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 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 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 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 s
_ -> 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 #-}