{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK not-home #-}
module Optics.Internal.Indexed where
import Data.Kind (Type)
import GHC.TypeLits
import Data.Profunctor.Indexed
import Optics.Internal.Optic
class is ~ NoIx => AcceptsEmptyIndices (f :: Symbol) (is :: IxList)
instance
( TypeError
('Text "‘" ':<>: 'Text f ':<>: 'Text "’ accepts only optics with no indices")
, (x ': xs) ~ NoIx
) => AcceptsEmptyIndices f (x ': xs)
instance AcceptsEmptyIndices f '[]
class NonEmptyIndices (is :: IxList)
instance
( TypeError
('Text "Indexed optic is expected")
) => NonEmptyIndices '[]
instance NonEmptyIndices (x ': xs)
class is ~ '[i] => HasSingleIndex (is :: IxList) (i :: Type)
instance HasSingleIndex '[i] i
instance
( TypeError
('Text "Indexed optic is expected")
, '[] ~ '[i]
) => HasSingleIndex '[] i
instance
( TypeError
('Text "Use (<%>) or icompose to combine indices of type "
':<>: ShowTypes is)
, is ~ '[i1, i2]
, is ~ '[i]
) => HasSingleIndex '[i1, i2] i
instance
( TypeError
('Text "Use icompose3 to combine indices of type "
':<>: ShowTypes is)
, is ~ '[i1, i2, i3]
, is ~ '[i]
) => HasSingleIndex [i1, i2, i3] i
instance
( TypeError
('Text "Use icompose4 to combine indices of type "
':<>: ShowTypes is)
, is ~ '[i1, i2, i3, i4]
, is ~ '[i]
) => HasSingleIndex '[i1, i2, i3, i4] i
instance
( TypeError
('Text "Use icompose5 to flatten indices of type "
':<>: ShowTypes is)
, is ~ '[i1, i2, i3, i4, i5]
, is ~ '[i]
) => HasSingleIndex '[i1, i2, i3, i4, i5] i
instance
( TypeError
('Text "Use icomposeN to flatten indices of type "
':<>: ShowTypes is)
, is ~ (i1 ': i2 ': i3 ': i4 ': i5 ': i6 : is')
, is ~ '[i]
) => HasSingleIndex (i1 ': i2 ': i3 ': i4 ': i5 ': i6 ': is') i
type family ShowTypes (types :: [Type]) :: ErrorMessage where
ShowTypes '[i] = QuoteType i
ShowTypes '[i, j] = QuoteType i ':<>: 'Text " and " ':<>: QuoteType j
ShowTypes (i ': is) = QuoteType i ':<>: 'Text ", " ':<>: ShowTypes is
data IntT f a = IntT {-# UNPACK #-} !Int (f a)
unIntT :: IntT f a -> f a
unIntT :: forall {k} (f :: k -> *) (a :: k). IntT f a -> f a
unIntT (IntT Int
_ f a
fa) = f a
fa
newtype Indexing f a = Indexing { forall {k} (f :: k -> *) (a :: k). Indexing f a -> Int -> IntT f a
runIndexing :: Int -> IntT f a }
instance Functor f => Functor (Indexing f) where
fmap :: forall a b. (a -> b) -> Indexing f a -> Indexing f b
fmap a -> b
f (Indexing Int -> IntT f a
m) = forall {k} (f :: k -> *) (a :: k).
(Int -> IntT f a) -> Indexing f a
Indexing forall a b. (a -> b) -> a -> b
$ \Int
i -> case Int -> IntT f a
m Int
i of
IntT Int
j f a
x -> forall {k} (f :: k -> *) (a :: k). Int -> f a -> IntT f a
IntT Int
j (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
x)
instance Applicative f => Applicative (Indexing f) where
pure :: forall a. a -> Indexing f a
pure a
x = forall {k} (f :: k -> *) (a :: k).
(Int -> IntT f a) -> Indexing f a
Indexing forall a b. (a -> b) -> a -> b
$ \Int
i -> forall {k} (f :: k -> *) (a :: k). Int -> f a -> IntT f a
IntT Int
i (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
Indexing Int -> IntT f (a -> b)
mf <*> :: forall a b. Indexing f (a -> b) -> Indexing f a -> Indexing f b
<*> Indexing Int -> IntT f a
ma = forall {k} (f :: k -> *) (a :: k).
(Int -> IntT f a) -> Indexing f a
Indexing forall a b. (a -> b) -> a -> b
$ \Int
i -> case Int -> IntT f (a -> b)
mf Int
i of
IntT Int
j f (a -> b)
ff -> case Int -> IntT f a
ma Int
j of
IntT Int
k f a
fa -> forall {k} (f :: k -> *) (a :: k). Int -> f a -> IntT f a
IntT Int
k (f (a -> b)
ff forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
fa)
indexing
:: ((a -> Indexing f b) -> s -> Indexing f t)
-> ((Int -> a -> f b) -> s -> f t)
indexing :: forall {k} a (f :: k -> *) (b :: k) s (t :: k).
((a -> Indexing f b) -> s -> Indexing f t)
-> (Int -> a -> f b) -> s -> f t
indexing (a -> Indexing f b) -> s -> Indexing f t
l Int -> a -> f b
iafb s
s =
forall {k} (f :: k -> *) (a :: k). IntT f a -> f a
unIntT forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k). Indexing f a -> Int -> IntT f a
runIndexing ((a -> Indexing f b) -> s -> Indexing f t
l (\a
a -> forall {k} (f :: k -> *) (a :: k).
(Int -> IntT f a) -> Indexing f a
Indexing (\Int
i -> forall {k} (f :: k -> *) (a :: k). Int -> f a -> IntT f a
IntT (Int
i forall a. Num a => a -> a -> a
+ Int
1) (Int -> a -> f b
iafb Int
i a
a))) s
s) Int
0
conjoined
:: is `HasSingleIndex` i
=> Optic k NoIx s t a b
-> Optic k is s t a b
-> Optic k is s t a b
conjoined :: forall (is :: IxList) i k s t a b.
HasSingleIndex is i =>
Optic k NoIx s t a b -> Optic k is s t a b -> Optic k is s t a b
conjoined (Optic forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ k p i (Curry NoIx i) s t a b
f) (Optic forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ k p i (Curry is i) s t a b
g) = forall k (is :: IxList) s t a b.
(forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ k p i (Curry is i) s t a b)
-> Optic k is s t a b
Optic (forall (p :: * -> * -> * -> *) i a b s t j.
Profunctor p =>
(p i a b -> p i s t) -> (p i a b -> p j s t) -> p i a b -> p j s t
conjoined__ forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ k p i (Curry NoIx i) s t a b
f forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ k p i (Curry is i) s t a b
g)