{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RoleAnnotations #-}
module Control.Lens.Internal.Magma
(
Magma(..)
, runMagma
, Molten(..)
, Mafic(..)
, runMafic
, TakingWhile(..)
, runTakingWhile
) where
import Prelude ()
import Control.Comonad
import Control.Lens.Internal.Bazaar
import Control.Lens.Internal.Context
import Control.Lens.Internal.Indexed
import Control.Lens.Internal.Prelude
import Data.Functor.Apply
import Data.Functor.WithIndex
import Data.Foldable.WithIndex
import Data.Kind
import Data.Traversable.WithIndex
data Magma i t b a where
MagmaAp :: Magma i (x -> y) b a -> Magma i x b a -> Magma i y b a
MagmaPure :: x -> Magma i x b a
MagmaFmap :: (x -> y) -> Magma i x b a -> Magma i y b a
Magma :: i -> a -> Magma i b b a
type role Magma representational nominal nominal nominal
instance Functor (Magma i t b) where
fmap :: (a -> b) -> Magma i t b a -> Magma i t b b
fmap a -> b
f (MagmaAp Magma i (x -> t) b a
x Magma i x b a
y) = Magma i (x -> t) b b -> Magma i x b b -> Magma i t b b
forall i x y b a.
Magma i (x -> y) b a -> Magma i x b a -> Magma i y b a
MagmaAp ((a -> b) -> Magma i (x -> t) b a -> Magma i (x -> t) b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Magma i (x -> t) b a
x) ((a -> b) -> Magma i x b a -> Magma i x b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Magma i x b a
y)
fmap a -> b
_ (MagmaPure t
x) = t -> Magma i t b b
forall x i b a. x -> Magma i x b a
MagmaPure t
x
fmap a -> b
f (MagmaFmap x -> t
xy Magma i x b a
x) = (x -> t) -> Magma i x b b -> Magma i t b b
forall x y i b a. (x -> y) -> Magma i x b a -> Magma i y b a
MagmaFmap x -> t
xy ((a -> b) -> Magma i x b a -> Magma i x b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Magma i x b a
x)
fmap a -> b
f (Magma i
i a
a) = i -> b -> Magma i t t b
forall i a b. i -> a -> Magma i b b a
Magma i
i (a -> b
f a
a)
instance Foldable (Magma i t b) where
foldMap :: (a -> m) -> Magma i t b a -> m
foldMap a -> m
f (MagmaAp Magma i (x -> t) b a
x Magma i x b a
y) = (a -> m) -> Magma i (x -> t) b a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Magma i (x -> t) b a
x m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> Magma i x b a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Magma i x b a
y
foldMap a -> m
_ MagmaPure{} = m
forall a. Monoid a => a
mempty
foldMap a -> m
f (MagmaFmap x -> t
_ Magma i x b a
x) = (a -> m) -> Magma i x b a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Magma i x b a
x
foldMap a -> m
f (Magma i
_ a
a) = a -> m
f a
a
instance Traversable (Magma i t b) where
traverse :: (a -> f b) -> Magma i t b a -> f (Magma i t b b)
traverse a -> f b
f (MagmaAp Magma i (x -> t) b a
x Magma i x b a
y) = Magma i (x -> t) b b -> Magma i x b b -> Magma i t b b
forall i x y b a.
Magma i (x -> y) b a -> Magma i x b a -> Magma i y b a
MagmaAp (Magma i (x -> t) b b -> Magma i x b b -> Magma i t b b)
-> f (Magma i (x -> t) b b) -> f (Magma i x b b -> Magma i t b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Magma i (x -> t) b a -> f (Magma i (x -> t) b b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Magma i (x -> t) b a
x f (Magma i x b b -> Magma i t b b)
-> f (Magma i x b b) -> f (Magma i t b b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Magma i x b a -> f (Magma i x b b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Magma i x b a
y
traverse a -> f b
_ (MagmaPure t
x) = Magma i t b b -> f (Magma i t b b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> Magma i t b b
forall x i b a. x -> Magma i x b a
MagmaPure t
x)
traverse a -> f b
f (MagmaFmap x -> t
xy Magma i x b a
x) = (x -> t) -> Magma i x b b -> Magma i t b b
forall x y i b a. (x -> y) -> Magma i x b a -> Magma i y b a
MagmaFmap x -> t
xy (Magma i x b b -> Magma i t b b)
-> f (Magma i x b b) -> f (Magma i t b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Magma i x b a -> f (Magma i x b b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Magma i x b a
x
traverse a -> f b
f (Magma i
i a
a) = i -> b -> Magma i t t b
forall i a b. i -> a -> Magma i b b a
Magma i
i (b -> Magma i t t b) -> f b -> f (Magma i t t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
instance FunctorWithIndex i (Magma i t b) where
imap :: (i -> a -> b) -> Magma i t b a -> Magma i t b b
imap i -> a -> b
f (MagmaAp Magma i (x -> t) b a
x Magma i x b a
y) = Magma i (x -> t) b b -> Magma i x b b -> Magma i t b b
forall i x y b a.
Magma i (x -> y) b a -> Magma i x b a -> Magma i y b a
MagmaAp ((i -> a -> b) -> Magma i (x -> t) b a -> Magma i (x -> t) b b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap i -> a -> b
f Magma i (x -> t) b a
x) ((i -> a -> b) -> Magma i x b a -> Magma i x b b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap i -> a -> b
f Magma i x b a
y)
imap i -> a -> b
_ (MagmaPure t
x) = t -> Magma i t b b
forall x i b a. x -> Magma i x b a
MagmaPure t
x
imap i -> a -> b
f (MagmaFmap x -> t
xy Magma i x b a
x) = (x -> t) -> Magma i x b b -> Magma i t b b
forall x y i b a. (x -> y) -> Magma i x b a -> Magma i y b a
MagmaFmap x -> t
xy ((i -> a -> b) -> Magma i x b a -> Magma i x b b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap i -> a -> b
f Magma i x b a
x)
imap i -> a -> b
f (Magma i
i a
a) = i -> b -> Magma i t t b
forall i a b. i -> a -> Magma i b b a
Magma i
i (i -> a -> b
f i
i a
a)
{-# INLINE imap #-}
instance FoldableWithIndex i (Magma i t b) where
ifoldMap :: (i -> a -> m) -> Magma i t b a -> m
ifoldMap i -> a -> m
f (MagmaAp Magma i (x -> t) b a
x Magma i x b a
y) = (i -> a -> m) -> Magma i (x -> t) b a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap i -> a -> m
f Magma i (x -> t) b a
x m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (i -> a -> m) -> Magma i x b a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap i -> a -> m
f Magma i x b a
y
ifoldMap i -> a -> m
_ MagmaPure{} = m
forall a. Monoid a => a
mempty
ifoldMap i -> a -> m
f (MagmaFmap x -> t
_ Magma i x b a
x) = (i -> a -> m) -> Magma i x b a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap i -> a -> m
f Magma i x b a
x
ifoldMap i -> a -> m
f (Magma i
i a
a) = i -> a -> m
f i
i a
a
{-# INLINE ifoldMap #-}
instance TraversableWithIndex i (Magma i t b) where
itraverse :: (i -> a -> f b) -> Magma i t b a -> f (Magma i t b b)
itraverse i -> a -> f b
f (MagmaAp Magma i (x -> t) b a
x Magma i x b a
y) = Magma i (x -> t) b b -> Magma i x b b -> Magma i t b b
forall i x y b a.
Magma i (x -> y) b a -> Magma i x b a -> Magma i y b a
MagmaAp (Magma i (x -> t) b b -> Magma i x b b -> Magma i t b b)
-> f (Magma i (x -> t) b b) -> f (Magma i x b b -> Magma i t b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (i -> a -> f b) -> Magma i (x -> t) b a -> f (Magma i (x -> t) b b)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse i -> a -> f b
f Magma i (x -> t) b a
x f (Magma i x b b -> Magma i t b b)
-> f (Magma i x b b) -> f (Magma i t b b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (i -> a -> f b) -> Magma i x b a -> f (Magma i x b b)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse i -> a -> f b
f Magma i x b a
y
itraverse i -> a -> f b
_ (MagmaPure t
x) = Magma i t b b -> f (Magma i t b b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> Magma i t b b
forall x i b a. x -> Magma i x b a
MagmaPure t
x)
itraverse i -> a -> f b
f (MagmaFmap x -> t
xy Magma i x b a
x) = (x -> t) -> Magma i x b b -> Magma i t b b
forall x y i b a. (x -> y) -> Magma i x b a -> Magma i y b a
MagmaFmap x -> t
xy (Magma i x b b -> Magma i t b b)
-> f (Magma i x b b) -> f (Magma i t b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (i -> a -> f b) -> Magma i x b a -> f (Magma i x b b)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse i -> a -> f b
f Magma i x b a
x
itraverse i -> a -> f b
f (Magma i
i a
a) = i -> b -> Magma i t t b
forall i a b. i -> a -> Magma i b b a
Magma i
i (b -> Magma i t t b) -> f b -> f (Magma i t t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i -> a -> f b
f i
i a
a
{-# INLINE itraverse #-}
instance (Show i, Show a) => Show (Magma i t b a) where
showsPrec :: Int -> Magma i t b a -> ShowS
showsPrec Int
d (MagmaAp Magma i (x -> t) b a
x Magma i x b a
y) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
Int -> Magma i (x -> t) b a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
4 Magma i (x -> t) b a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" <*> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Magma i x b a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
5 Magma i x b a
y
showsPrec Int
d (MagmaPure t
_) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"pure .."
showsPrec Int
d (MagmaFmap x -> t
_ Magma i x b a
x) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
".. <$> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Magma i x b a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
5 Magma i x b a
x
showsPrec Int
d (Magma i
i a
a) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"Magma " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> i -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 i
i ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
a
runMagma :: Magma i t a a -> t
runMagma :: Magma i t a a -> t
runMagma (MagmaAp Magma i (x -> t) a a
l Magma i x a a
r) = Magma i (x -> t) a a -> x -> t
forall i t a. Magma i t a a -> t
runMagma Magma i (x -> t) a a
l (Magma i x a a -> x
forall i t a. Magma i t a a -> t
runMagma Magma i x a a
r)
runMagma (MagmaFmap x -> t
f Magma i x a a
r) = x -> t
f (Magma i x a a -> x
forall i t a. Magma i t a a -> t
runMagma Magma i x a a
r)
runMagma (MagmaPure t
x) = t
x
runMagma (Magma i
_ a
a) = t
a
a
newtype Molten i a b t = Molten { Molten i a b t -> Magma i t b a
runMolten :: Magma i t b a }
instance Functor (Molten i a b) where
fmap :: (a -> b) -> Molten i a b a -> Molten i a b b
fmap a -> b
f (Molten Magma i a b a
xs) = Magma i b b a -> Molten i a b b
forall i a b t. Magma i t b a -> Molten i a b t
Molten ((a -> b) -> Magma i a b a -> Magma i b b a
forall x y i b a. (x -> y) -> Magma i x b a -> Magma i y b a
MagmaFmap a -> b
f Magma i a b a
xs)
{-# INLINE fmap #-}
instance Apply (Molten i a b) where
<.> :: Molten i a b (a -> b) -> Molten i a b a -> Molten i a b b
(<.>) = Molten i a b (a -> b) -> Molten i a b a -> Molten i a b b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
{-# INLINE (<.>) #-}
instance Applicative (Molten i a b) where
pure :: a -> Molten i a b a
pure = Magma i a b a -> Molten i a b a
forall i a b t. Magma i t b a -> Molten i a b t
Molten (Magma i a b a -> Molten i a b a)
-> (a -> Magma i a b a) -> a -> Molten i a b a
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. a -> Magma i a b a
forall x i b a. x -> Magma i x b a
MagmaPure
{-# INLINE pure #-}
Molten Magma i (a -> b) b a
xs <*> :: Molten i a b (a -> b) -> Molten i a b a -> Molten i a b b
<*> Molten Magma i a b a
ys = Magma i b b a -> Molten i a b b
forall i a b t. Magma i t b a -> Molten i a b t
Molten (Magma i (a -> b) b a -> Magma i a b a -> Magma i b b a
forall i x y b a.
Magma i (x -> y) b a -> Magma i x b a -> Magma i y b a
MagmaAp Magma i (a -> b) b a
xs Magma i a b a
ys)
{-# INLINE (<*>) #-}
instance Sellable (Indexed i) (Molten i) where
sell :: Indexed i a (Molten i a b b)
sell = (i -> a -> Molten i a b b) -> Indexed i a (Molten i a b b)
forall i a b. (i -> a -> b) -> Indexed i a b
Indexed (\i
i -> Magma i b b a -> Molten i a b b
forall i a b t. Magma i t b a -> Molten i a b t
Molten (Magma i b b a -> Molten i a b b)
-> (a -> Magma i b b a) -> a -> Molten i a b b
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. i -> a -> Magma i b b a
forall i a b. i -> a -> Magma i b b a
Magma i
i)
{-# INLINE sell #-}
instance Bizarre (Indexed i) (Molten i) where
bazaar :: Indexed i a (f b) -> Molten i a b t -> f t
bazaar Indexed i a (f b)
f (Molten (MagmaAp Magma i (x -> t) b a
x Magma i x b a
y)) = Indexed i a (f b) -> Molten i a b (x -> t) -> f (x -> t)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) (f :: * -> *) a b
t.
(Bizarre p w, Applicative f) =>
p a (f b) -> w a b t -> f t
bazaar Indexed i a (f b)
f (Magma i (x -> t) b a -> Molten i a b (x -> t)
forall i a b t. Magma i t b a -> Molten i a b t
Molten Magma i (x -> t) b a
x) f (x -> t) -> f x -> f t
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Indexed i a (f b) -> Molten i a b x -> f x
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) (f :: * -> *) a b
t.
(Bizarre p w, Applicative f) =>
p a (f b) -> w a b t -> f t
bazaar Indexed i a (f b)
f (Magma i x b a -> Molten i a b x
forall i a b t. Magma i t b a -> Molten i a b t
Molten Magma i x b a
y)
bazaar Indexed i a (f b)
f (Molten (MagmaFmap x -> t
g Magma i x b a
x)) = x -> t
g (x -> t) -> f x -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Indexed i a (f b) -> Molten i a b x -> f x
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) (f :: * -> *) a b
t.
(Bizarre p w, Applicative f) =>
p a (f b) -> w a b t -> f t
bazaar Indexed i a (f b)
f (Magma i x b a -> Molten i a b x
forall i a b t. Magma i t b a -> Molten i a b t
Molten Magma i x b a
x)
bazaar Indexed i a (f b)
_ (Molten (MagmaPure t
x)) = t -> f t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
x
bazaar Indexed i a (f b)
f (Molten (Magma i
i a
a)) = Indexed i a (f b) -> i -> a -> f b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed Indexed i a (f b)
f i
i a
a
instance IndexedFunctor (Molten i) where
ifmap :: (s -> t) -> Molten i a b s -> Molten i a b t
ifmap s -> t
f (Molten Magma i s b a
xs) = Magma i t b a -> Molten i a b t
forall i a b t. Magma i t b a -> Molten i a b t
Molten ((s -> t) -> Magma i s b a -> Magma i t b a
forall x y i b a. (x -> y) -> Magma i x b a -> Magma i y b a
MagmaFmap s -> t
f Magma i s b a
xs)
{-# INLINE ifmap #-}
instance IndexedComonad (Molten i) where
iextract :: Molten i a a t -> t
iextract (Molten (MagmaAp Magma i (x -> t) a a
x Magma i x a a
y)) = Molten i a a (x -> t) -> x -> t
forall (w :: * -> * -> * -> *) a t.
IndexedComonad w =>
w a a t -> t
iextract (Magma i (x -> t) a a -> Molten i a a (x -> t)
forall i a b t. Magma i t b a -> Molten i a b t
Molten Magma i (x -> t) a a
x) (Molten i a a x -> x
forall (w :: * -> * -> * -> *) a t.
IndexedComonad w =>
w a a t -> t
iextract (Magma i x a a -> Molten i a a x
forall i a b t. Magma i t b a -> Molten i a b t
Molten Magma i x a a
y))
iextract (Molten (MagmaFmap x -> t
f Magma i x a a
y)) = x -> t
f (Molten i a a x -> x
forall (w :: * -> * -> * -> *) a t.
IndexedComonad w =>
w a a t -> t
iextract (Magma i x a a -> Molten i a a x
forall i a b t. Magma i t b a -> Molten i a b t
Molten Magma i x a a
y))
iextract (Molten (MagmaPure t
x)) = t
x
iextract (Molten (Magma i
_ a
a)) = a
t
a
iduplicate :: Molten i a c t -> Molten i a b (Molten i b c t)
iduplicate (Molten (Magma i
i a
a)) = Magma i t t b -> Molten i b t t
forall i a b t. Magma i t b a -> Molten i a b t
Molten (Magma i t t b -> Molten i b t t)
-> (b -> Magma i t t b) -> b -> Molten i b t t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. i -> b -> Magma i t t b
forall i a b. i -> a -> Magma i b b a
Magma i
i (b -> Molten i b c t)
-> Molten i a b b -> Molten i a b (Molten i b c t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Magma i b b a -> Molten i a b b
forall i a b t. Magma i t b a -> Molten i a b t
Molten (i -> a -> Magma i b b a
forall i a b. i -> a -> Magma i b b a
Magma i
i a
a)
iduplicate (Molten (MagmaPure t
x)) = Molten i b c t -> Molten i a b (Molten i b c t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> Molten i b c t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
x)
iduplicate (Molten (MagmaFmap x -> t
f Magma i x c a
y)) = (Molten i b c x -> Molten i b c t)
-> Molten i a c x -> Molten i a b (Molten i b c t)
forall (w :: * -> * -> * -> *) b c t r a.
IndexedComonad w =>
(w b c t -> r) -> w a c t -> w a b r
iextend ((x -> t) -> Molten i b c x -> Molten i b c t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> t
f) (Magma i x c a -> Molten i a c x
forall i a b t. Magma i t b a -> Molten i a b t
Molten Magma i x c a
y)
iduplicate (Molten (MagmaAp Magma i (x -> t) c a
x Magma i x c a
y)) = (Molten i b c (x -> t) -> Molten i b c x -> Molten i b c t)
-> Molten i a c (x -> t)
-> Molten i a b (Molten i b c x -> Molten i b c t)
forall (w :: * -> * -> * -> *) b c t r a.
IndexedComonad w =>
(w b c t -> r) -> w a c t -> w a b r
iextend Molten i b c (x -> t) -> Molten i b c x -> Molten i b c t
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (Magma i (x -> t) c a -> Molten i a c (x -> t)
forall i a b t. Magma i t b a -> Molten i a b t
Molten Magma i (x -> t) c a
x) Molten i a b (Molten i b c x -> Molten i b c t)
-> Molten i a b (Molten i b c x) -> Molten i a b (Molten i b c t)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Molten i a c x -> Molten i a b (Molten i b c x)
forall (w :: * -> * -> * -> *) a c t b.
IndexedComonad w =>
w a c t -> w a b (w b c t)
iduplicate (Magma i x c a -> Molten i a c x
forall i a b t. Magma i t b a -> Molten i a b t
Molten Magma i x c a
y)
iextend :: (Molten i b c t -> r) -> Molten i a c t -> Molten i a b r
iextend Molten i b c t -> r
k (Molten (Magma i
i a
a)) = (Molten i b c t -> r
Molten i b t t -> r
k (Molten i b t t -> r)
-> (Magma i t t b -> Molten i b t t) -> Magma i t t b -> r
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# Magma i t t b -> Molten i b t t
forall i a b t. Magma i t b a -> Molten i a b t
Molten) (Magma i t t b -> r) -> (b -> Magma i t t b) -> b -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> b -> Magma i t t b
forall i a b. i -> a -> Magma i b b a
Magma i
i (b -> r) -> Molten i a b b -> Molten i a b r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Magma i b b a -> Molten i a b b
forall i a b t. Magma i t b a -> Molten i a b t
Molten (i -> a -> Magma i b b a
forall i a b. i -> a -> Magma i b b a
Magma i
i a
a)
iextend Molten i b c t -> r
k (Molten (MagmaPure t
x)) = r -> Molten i a b r
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Molten i b c t -> r
k (t -> Molten i b c t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
x))
iextend Molten i b c t -> r
k (Molten (MagmaFmap x -> t
f Magma i x c a
y)) = (Molten i b c x -> r) -> Molten i a c x -> Molten i a b r
forall (w :: * -> * -> * -> *) b c t r a.
IndexedComonad w =>
(w b c t -> r) -> w a c t -> w a b r
iextend (Molten i b c t -> r
k (Molten i b c t -> r)
-> (Molten i b c x -> Molten i b c t) -> Molten i b c x -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> t) -> Molten i b c x -> Molten i b c t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> t
f) (Magma i x c a -> Molten i a c x
forall i a b t. Magma i t b a -> Molten i a b t
Molten Magma i x c a
y)
iextend Molten i b c t -> r
k (Molten (MagmaAp Magma i (x -> t) c a
x Magma i x c a
y)) = (Molten i b c (x -> t) -> Molten i b c x -> r)
-> Molten i a c (x -> t) -> Molten i a b (Molten i b c x -> r)
forall (w :: * -> * -> * -> *) b c t r a.
IndexedComonad w =>
(w b c t -> r) -> w a c t -> w a b r
iextend (\Molten i b c (x -> t)
x' Molten i b c x
y' -> Molten i b c t -> r
k (Molten i b c t -> r) -> Molten i b c t -> r
forall a b. (a -> b) -> a -> b
$ Molten i b c (x -> t)
x' Molten i b c (x -> t) -> Molten i b c x -> Molten i b c t
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Molten i b c x
y') (Magma i (x -> t) c a -> Molten i a c (x -> t)
forall i a b t. Magma i t b a -> Molten i a b t
Molten Magma i (x -> t) c a
x) Molten i a b (Molten i b c x -> r)
-> Molten i a b (Molten i b c x) -> Molten i a b r
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Molten i a c x -> Molten i a b (Molten i b c x)
forall (w :: * -> * -> * -> *) a c t b.
IndexedComonad w =>
w a c t -> w a b (w b c t)
iduplicate (Magma i x c a -> Molten i a c x
forall i a b t. Magma i t b a -> Molten i a b t
Molten Magma i x c a
y)
instance a ~ b => Comonad (Molten i a b) where
extract :: Molten i a b a -> a
extract = Molten i a b a -> a
forall (w :: * -> * -> * -> *) a t.
IndexedComonad w =>
w a a t -> t
iextract
{-# INLINE extract #-}
extend :: (Molten i a b a -> b) -> Molten i a b a -> Molten i a b b
extend = (Molten i a b a -> b) -> Molten i a b a -> Molten i a b b
forall (w :: * -> * -> * -> *) b c t r a.
IndexedComonad w =>
(w b c t -> r) -> w a c t -> w a b r
iextend
{-# INLINE extend #-}
duplicate :: Molten i a b a -> Molten i a b (Molten i a b a)
duplicate = Molten i a b a -> Molten i a b (Molten i a b a)
forall (w :: * -> * -> * -> *) a c t b.
IndexedComonad w =>
w a c t -> w a b (w b c t)
iduplicate
{-# INLINE duplicate #-}
data Mafic a b t = Mafic Int (Int -> Magma Int t b a)
runMafic :: Mafic a b t -> Magma Int t b a
runMafic :: Mafic a b t -> Magma Int t b a
runMafic (Mafic Int
_ Int -> Magma Int t b a
k) = Int -> Magma Int t b a
k Int
0
instance Functor (Mafic a b) where
fmap :: (a -> b) -> Mafic a b a -> Mafic a b b
fmap a -> b
f (Mafic Int
w Int -> Magma Int a b a
k) = Int -> (Int -> Magma Int b b a) -> Mafic a b b
forall a b t. Int -> (Int -> Magma Int t b a) -> Mafic a b t
Mafic Int
w ((a -> b) -> Magma Int a b a -> Magma Int b b a
forall x y i b a. (x -> y) -> Magma i x b a -> Magma i y b a
MagmaFmap a -> b
f (Magma Int a b a -> Magma Int b b a)
-> (Int -> Magma Int a b a) -> Int -> Magma Int b b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Magma Int a b a
k)
{-# INLINE fmap #-}
instance Apply (Mafic a b) where
Mafic Int
wf Int -> Magma Int (a -> b) b a
mf <.> :: Mafic a b (a -> b) -> Mafic a b a -> Mafic a b b
<.> ~(Mafic Int
wa Int -> Magma Int a b a
ma) = Int -> (Int -> Magma Int b b a) -> Mafic a b b
forall a b t. Int -> (Int -> Magma Int t b a) -> Mafic a b t
Mafic (Int
wf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wa) ((Int -> Magma Int b b a) -> Mafic a b b)
-> (Int -> Magma Int b b a) -> Mafic a b b
forall a b. (a -> b) -> a -> b
$ \Int
o -> Magma Int (a -> b) b a -> Magma Int a b a -> Magma Int b b a
forall i x y b a.
Magma i (x -> y) b a -> Magma i x b a -> Magma i y b a
MagmaAp (Int -> Magma Int (a -> b) b a
mf Int
o) (Int -> Magma Int a b a
ma (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wf))
{-# INLINE (<.>) #-}
instance Applicative (Mafic a b) where
pure :: a -> Mafic a b a
pure a
a = Int -> (Int -> Magma Int a b a) -> Mafic a b a
forall a b t. Int -> (Int -> Magma Int t b a) -> Mafic a b t
Mafic Int
0 ((Int -> Magma Int a b a) -> Mafic a b a)
-> (Int -> Magma Int a b a) -> Mafic a b a
forall a b. (a -> b) -> a -> b
$ \Int
_ -> a -> Magma Int a b a
forall x i b a. x -> Magma i x b a
MagmaPure a
a
{-# INLINE pure #-}
Mafic Int
wf Int -> Magma Int (a -> b) b a
mf <*> :: Mafic a b (a -> b) -> Mafic a b a -> Mafic a b b
<*> ~(Mafic Int
wa Int -> Magma Int a b a
ma) = Int -> (Int -> Magma Int b b a) -> Mafic a b b
forall a b t. Int -> (Int -> Magma Int t b a) -> Mafic a b t
Mafic (Int
wf Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wa) ((Int -> Magma Int b b a) -> Mafic a b b)
-> (Int -> Magma Int b b a) -> Mafic a b b
forall a b. (a -> b) -> a -> b
$ \Int
o -> Magma Int (a -> b) b a -> Magma Int a b a -> Magma Int b b a
forall i x y b a.
Magma i (x -> y) b a -> Magma i x b a -> Magma i y b a
MagmaAp (Int -> Magma Int (a -> b) b a
mf Int
o) (Int -> Magma Int a b a
ma (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wf))
{-# INLINE (<*>) #-}
instance Sellable (->) Mafic where
sell :: a -> Mafic a b b
sell a
a = Int -> (Int -> Magma Int b b a) -> Mafic a b b
forall a b t. Int -> (Int -> Magma Int t b a) -> Mafic a b t
Mafic Int
1 ((Int -> Magma Int b b a) -> Mafic a b b)
-> (Int -> Magma Int b b a) -> Mafic a b b
forall a b. (a -> b) -> a -> b
$ \ Int
i -> Int -> a -> Magma Int b b a
forall i a b. i -> a -> Magma i b b a
Magma Int
i a
a
{-# INLINE sell #-}
instance Bizarre (Indexed Int) Mafic where
bazaar :: Indexed Int a (f b) -> Mafic a b t -> f t
bazaar (Indexed Int a (f b)
pafb :: Indexed Int a (f b)) (Mafic Int
_ Int -> Magma Int t b a
k) = Magma Int t b a -> f t
forall t. Magma Int t b a -> f t
go (Int -> Magma Int t b a
k Int
0) where
go :: Magma Int t b a -> f t
go :: Magma Int t b a -> f t
go (MagmaAp Magma Int (x -> t) b a
x Magma Int x b a
y) = Magma Int (x -> t) b a -> f (x -> t)
forall t. Magma Int t b a -> f t
go Magma Int (x -> t) b a
x f (x -> t) -> f x -> f t
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Magma Int x b a -> f x
forall t. Magma Int t b a -> f t
go Magma Int x b a
y
go (MagmaFmap x -> t
f Magma Int x b a
x) = x -> t
f (x -> t) -> f x -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Magma Int x b a -> f x
forall t. Magma Int t b a -> f t
go Magma Int x b a
x
go (MagmaPure t
x) = t -> f t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
x
go (Magma Int
i a
a) = Indexed Int a (f b) -> Int -> a -> f b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed Indexed Int a (f b)
pafb (Int
i :: Int) a
a
{-# INLINE bazaar #-}
instance IndexedFunctor Mafic where
ifmap :: (s -> t) -> Mafic a b s -> Mafic a b t
ifmap s -> t
f (Mafic Int
w Int -> Magma Int s b a
k) = Int -> (Int -> Magma Int t b a) -> Mafic a b t
forall a b t. Int -> (Int -> Magma Int t b a) -> Mafic a b t
Mafic Int
w ((s -> t) -> Magma Int s b a -> Magma Int t b a
forall x y i b a. (x -> y) -> Magma i x b a -> Magma i y b a
MagmaFmap s -> t
f (Magma Int s b a -> Magma Int t b a)
-> (Int -> Magma Int s b a) -> Int -> Magma Int t b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Magma Int s b a
k)
{-# INLINE ifmap #-}
data TakingWhile p (g :: Type -> Type) a b t = TakingWhile Bool t (Bool -> Magma () t b (Corep p a))
type role TakingWhile nominal nominal nominal nominal nominal
runTakingWhile :: TakingWhile p f a b t -> Magma () t b (Corep p a)
runTakingWhile :: TakingWhile p f a b t -> Magma () t b (Corep p a)
runTakingWhile (TakingWhile Bool
_ t
_ Bool -> Magma () t b (Corep p a)
k) = Bool -> Magma () t b (Corep p a)
k Bool
True
instance Functor (TakingWhile p f a b) where
fmap :: (a -> b) -> TakingWhile p f a b a -> TakingWhile p f a b b
fmap a -> b
f (TakingWhile Bool
w a
t Bool -> Magma () a b (Corep p a)
k) = let ft :: b
ft = a -> b
f a
t in Bool
-> b -> (Bool -> Magma () b b (Corep p a)) -> TakingWhile p f a b b
forall (p :: * -> * -> *) (g :: * -> *) a b t.
Bool
-> t -> (Bool -> Magma () t b (Corep p a)) -> TakingWhile p g a b t
TakingWhile Bool
w b
ft ((Bool -> Magma () b b (Corep p a)) -> TakingWhile p f a b b)
-> (Bool -> Magma () b b (Corep p a)) -> TakingWhile p f a b b
forall a b. (a -> b) -> a -> b
$ \Bool
b -> if Bool
b then (a -> b) -> Magma () a b (Corep p a) -> Magma () b b (Corep p a)
forall x y i b a. (x -> y) -> Magma i x b a -> Magma i y b a
MagmaFmap a -> b
f (Bool -> Magma () a b (Corep p a)
k Bool
b) else b -> Magma () b b (Corep p a)
forall x i b a. x -> Magma i x b a
MagmaPure b
ft
{-# INLINE fmap #-}
instance Apply (TakingWhile p f a b) where
TakingWhile Bool
wf a -> b
tf Bool -> Magma () (a -> b) b (Corep p a)
mf <.> :: TakingWhile p f a b (a -> b)
-> TakingWhile p f a b a -> TakingWhile p f a b b
<.> ~(TakingWhile Bool
wa a
ta Bool -> Magma () a b (Corep p a)
ma) = Bool
-> b -> (Bool -> Magma () b b (Corep p a)) -> TakingWhile p f a b b
forall (p :: * -> * -> *) (g :: * -> *) a b t.
Bool
-> t -> (Bool -> Magma () t b (Corep p a)) -> TakingWhile p g a b t
TakingWhile (Bool
wf Bool -> Bool -> Bool
&& Bool
wa) (a -> b
tf a
ta) ((Bool -> Magma () b b (Corep p a)) -> TakingWhile p f a b b)
-> (Bool -> Magma () b b (Corep p a)) -> TakingWhile p f a b b
forall a b. (a -> b) -> a -> b
$ \Bool
o ->
if Bool
o then Magma () (a -> b) b (Corep p a)
-> Magma () a b (Corep p a) -> Magma () b b (Corep p a)
forall i x y b a.
Magma i (x -> y) b a -> Magma i x b a -> Magma i y b a
MagmaAp (Bool -> Magma () (a -> b) b (Corep p a)
mf Bool
True) (Bool -> Magma () a b (Corep p a)
ma Bool
wf) else b -> Magma () b b (Corep p a)
forall x i b a. x -> Magma i x b a
MagmaPure (a -> b
tf a
ta)
{-# INLINE (<.>) #-}
instance Applicative (TakingWhile p f a b) where
pure :: a -> TakingWhile p f a b a
pure a
a = Bool
-> a -> (Bool -> Magma () a b (Corep p a)) -> TakingWhile p f a b a
forall (p :: * -> * -> *) (g :: * -> *) a b t.
Bool
-> t -> (Bool -> Magma () t b (Corep p a)) -> TakingWhile p g a b t
TakingWhile Bool
True a
a ((Bool -> Magma () a b (Corep p a)) -> TakingWhile p f a b a)
-> (Bool -> Magma () a b (Corep p a)) -> TakingWhile p f a b a
forall a b. (a -> b) -> a -> b
$ \Bool
_ -> a -> Magma () a b (Corep p a)
forall x i b a. x -> Magma i x b a
MagmaPure a
a
{-# INLINE pure #-}
TakingWhile Bool
wf a -> b
tf Bool -> Magma () (a -> b) b (Corep p a)
mf <*> :: TakingWhile p f a b (a -> b)
-> TakingWhile p f a b a -> TakingWhile p f a b b
<*> ~(TakingWhile Bool
wa a
ta Bool -> Magma () a b (Corep p a)
ma) = Bool
-> b -> (Bool -> Magma () b b (Corep p a)) -> TakingWhile p f a b b
forall (p :: * -> * -> *) (g :: * -> *) a b t.
Bool
-> t -> (Bool -> Magma () t b (Corep p a)) -> TakingWhile p g a b t
TakingWhile (Bool
wf Bool -> Bool -> Bool
&& Bool
wa) (a -> b
tf a
ta) ((Bool -> Magma () b b (Corep p a)) -> TakingWhile p f a b b)
-> (Bool -> Magma () b b (Corep p a)) -> TakingWhile p f a b b
forall a b. (a -> b) -> a -> b
$ \Bool
o ->
if Bool
o then Magma () (a -> b) b (Corep p a)
-> Magma () a b (Corep p a) -> Magma () b b (Corep p a)
forall i x y b a.
Magma i (x -> y) b a -> Magma i x b a -> Magma i y b a
MagmaAp (Bool -> Magma () (a -> b) b (Corep p a)
mf Bool
True) (Bool -> Magma () a b (Corep p a)
ma Bool
wf) else b -> Magma () b b (Corep p a)
forall x i b a. x -> Magma i x b a
MagmaPure (a -> b
tf a
ta)
{-# INLINE (<*>) #-}
instance Corepresentable p => Bizarre p (TakingWhile p g) where
bazaar :: p a (f b) -> TakingWhile p g a b t -> f t
bazaar (p a (f b)
pafb :: p a (f b)) ~(TakingWhile Bool
_ t
_ Bool -> Magma () t b (Corep p a)
k) = Magma () t b (Corep p a) -> f t
forall t. Magma () t b (Corep p a) -> f t
go (Bool -> Magma () t b (Corep p a)
k Bool
True) where
go :: Magma () t b (Corep p a) -> f t
go :: Magma () t b (Corep p a) -> f t
go (MagmaAp Magma () (x -> t) b (Corep p a)
x Magma () x b (Corep p a)
y) = Magma () (x -> t) b (Corep p a) -> f (x -> t)
forall t. Magma () t b (Corep p a) -> f t
go Magma () (x -> t) b (Corep p a)
x f (x -> t) -> f x -> f t
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Magma () x b (Corep p a) -> f x
forall t. Magma () t b (Corep p a) -> f t
go Magma () x b (Corep p a)
y
go (MagmaFmap x -> t
f Magma () x b (Corep p a)
x) = x -> t
f (x -> t) -> f x -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Magma () x b (Corep p a) -> f x
forall t. Magma () t b (Corep p a) -> f t
go Magma () x b (Corep p a)
x
go (MagmaPure t
x) = t -> f t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
x
go (Magma ()
_ Corep p a
wa) = p a (f b) -> Corep p a -> f b
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p a (f b)
pafb Corep p a
wa
{-# INLINE bazaar #-}
instance Contravariant f => Contravariant (TakingWhile p f a b) where
contramap :: (a -> b) -> TakingWhile p f a b b -> TakingWhile p f a b a
contramap a -> b
_ = a -> TakingWhile p f a b b -> TakingWhile p f a b a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$) (String -> a
forall a. HasCallStack => String -> a
error String
"contramap: TakingWhile")
{-# INLINE contramap #-}
instance IndexedFunctor (TakingWhile p f) where
ifmap :: (s -> t) -> TakingWhile p f a b s -> TakingWhile p f a b t
ifmap = (s -> t) -> TakingWhile p f a b s -> TakingWhile p f a b t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
{-# INLINE ifmap #-}