{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
#if __GLASGOW_HASKELL__ >= 707
{-# LANGUAGE RoleAnnotations #-}
#endif
module Control.Lens.Internal.Magma
(
Magma(..)
, runMagma
, Molten(..)
, Mafic(..)
, runMafic
, TakingWhile(..)
, runTakingWhile
) where
import Control.Applicative
import Control.Category
import Control.Comonad
import Control.Lens.Internal.Bazaar
import Control.Lens.Internal.Context
import Control.Lens.Internal.Indexed
import Data.Foldable
import Data.Functor.Apply
import Data.Functor.Contravariant
import Data.Monoid
import Data.Profunctor.Rep
import Data.Profunctor.Sieve
import Data.Profunctor.Unsafe
import Data.Traversable
import Prelude hiding ((.),id)
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
#if __GLASGOW_HASKELL__ >= 707
type role Magma representational nominal nominal nominal
#endif
instance Functor (Magma i t b) where
fmap :: (a -> b) -> Magma i t b a -> Magma i t b b
fmap f :: a -> b
f (MagmaAp x :: Magma i (x -> t) b a
x y :: 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 _ (MagmaPure x :: t
x) = t -> Magma i t b b
forall x i b a. x -> Magma i x b a
MagmaPure t
x
fmap f :: a -> b
f (MagmaFmap xy :: x -> t
xy x :: 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 f :: a -> b
f (Magma i :: i
i a :: 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 f :: a -> m
f (MagmaAp x :: Magma i (x -> t) b a
x y :: 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 _ MagmaPure{} = m
forall a. Monoid a => a
mempty
foldMap f :: a -> m
f (MagmaFmap _ x :: 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 f :: a -> m
f (Magma _ a :: 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 f :: a -> f b
f (MagmaAp x :: Magma i (x -> t) b a
x y :: 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 _ (MagmaPure x :: 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 f :: a -> f b
f (MagmaFmap xy :: x -> t
xy x :: 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 f :: a -> f b
f (Magma i :: i
i a :: 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 (Show i, Show a) => Show (Magma i t b a) where
showsPrec :: Int -> Magma i t b a -> ShowS
showsPrec d :: Int
d (MagmaAp x :: Magma i (x -> t) b a
x y :: Magma i x b a
y) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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 4 Magma i (x -> t) b a
x ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ShowS
showString " <*> " ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Magma i x b a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 5 Magma i x b a
y
showsPrec d :: Int
d (MagmaPure _) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString "pure .."
showsPrec d :: Int
d (MagmaFmap _ x :: Magma i x b a
x) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 4) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString ".. <$> " ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Magma i x b a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 5 Magma i x b a
x
showsPrec d :: Int
d (Magma i :: i
i a :: a
a) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString "Magma " ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> i -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 i
i ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> ShowS
showChar ' ' ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 a
a
runMagma :: Magma i t a a -> t
runMagma :: Magma i t a a -> t
runMagma (MagmaAp l :: Magma i (x -> t) a a
l r :: 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 f :: x -> t
f r :: 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 x :: t
x) = t
x
runMagma (Magma _ a :: 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 f :: a -> b
f (Molten xs :: 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 xs :: Magma i (a -> b) b a
xs <*> :: Molten i a b (a -> b) -> Molten i a b a -> Molten i a b b
<*> Molten ys :: 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
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 f :: Indexed i a (f b)
f (Molten (MagmaAp x :: Magma i (x -> t) b a
x y :: 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 f :: Indexed i a (f b)
f (Molten (MagmaFmap g :: x -> t
g x :: 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 _ (Molten (MagmaPure x :: t
x)) = t -> f t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
x
bazaar f :: Indexed i a (f b)
f (Molten (Magma i :: i
i a :: 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 f :: s -> t
f (Molten xs :: 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 x :: Magma i (x -> t) a a
x y :: 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 f :: x -> t
f y :: 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 x :: t
x)) = t
x
iextract (Molten (Magma _ a :: 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
i a :: 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 x :: 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 f :: x -> t
f y :: 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 x :: Magma i (x -> t) c a
x y :: 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 k :: Molten i b c t -> r
k (Molten (Magma i :: i
i a :: 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 k :: Molten i b c t -> r
k (Molten (MagmaPure x :: 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 k :: Molten i b c t -> r
k (Molten (MagmaFmap f :: x -> t
f y :: 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 k :: Molten i b c t -> r
k (Molten (MagmaAp x :: Magma i (x -> t) c a
x y :: 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 (\x' :: Molten i b c (x -> t)
x' y' :: 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 _ k :: Int -> Magma Int t b a
k) = Int -> Magma Int t b a
k 0
instance Functor (Mafic a b) where
fmap :: (a -> b) -> Mafic a b a -> Mafic a b b
fmap f :: a -> b
f (Mafic w :: Int
w k :: 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Magma Int a b a
k)
{-# INLINE fmap #-}
instance Apply (Mafic a b) where
Mafic wf :: Int
wf mf :: Int -> Magma Int (a -> b) b a
mf <.> :: Mafic a b (a -> b) -> Mafic a b a -> Mafic a b b
<.> ~(Mafic wa :: Int
wa ma :: 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
$ \o :: 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
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 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
$ \_ -> a -> Magma Int a b a
forall x i b a. x -> Magma i x b a
MagmaPure a
a
{-# INLINE pure #-}
Mafic wf :: Int
wf mf :: Int -> Magma Int (a -> b) b a
mf <*> :: Mafic a b (a -> b) -> Mafic a b a -> Mafic a b b
<*> ~(Mafic wa :: Int
wa ma :: 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
$ \o :: 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
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 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
$ \ i :: 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 _ k :: 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 0) where
go :: Magma Int t b a -> f t
go :: Magma Int t b a -> f t
go (MagmaAp x :: Magma Int (x -> t) b a
x y :: 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 f :: x -> t
f x :: 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 x :: t
x) = t -> f t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
x
go (Magma i :: Int
i a :: 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 f :: s -> t
f (Mafic w :: Int
w k :: 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Magma Int s b a
k)
{-# INLINE ifmap #-}
data TakingWhile p (g :: * -> *) a b t = TakingWhile Bool t (Bool -> Magma () t b (Corep p a))
#if __GLASGOW_HASKELL__ >= 707
type role TakingWhile nominal nominal nominal nominal nominal
#endif
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 _ _ k :: 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 f :: a -> b
f (TakingWhile w :: Bool
w t :: a
t k :: 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
$ \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 wf :: Bool
wf tf :: a -> b
tf mf :: 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 wa :: Bool
wa ta :: a
ta ma :: 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
$ \o :: 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
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
$ \_ -> a -> Magma () a b (Corep p a)
forall x i b a. x -> Magma i x b a
MagmaPure a
a
{-# INLINE pure #-}
TakingWhile wf :: Bool
wf tf :: a -> b
tf mf :: 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 wa :: Bool
wa ta :: a
ta ma :: 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
$ \o :: 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 _ _ k :: 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 x :: Magma () (x -> t) b (Corep p a)
x y :: 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 f :: x -> t
f x :: 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 x :: t
x) = t -> f t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
x
go (Magma _ wa :: 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 -> 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 "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 #-}