{-# 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

-- Copyright   :  (C) 2012-2016 Edward Kmett

-- License     :  BSD-style (see the file LICENSE)

-- Maintainer  :  Edward Kmett <ekmett@gmail.com>

-- Stability   :  experimental

-- Portability :  non-portable

--

----------------------------------------------------------------------------

module Control.Lens.Internal.Magma
  (
  -- * Magma

    Magma(..)
  , runMagma
  -- * Molten

  , Molten(..)
  -- * Mafic

  , Mafic(..)
  , runMafic
  -- * TakingWhile

  , 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

------------------------------------------------------------------------------

-- Magma

------------------------------------------------------------------------------


-- | This provides a way to peek at the internal structure of a

-- 'Control.Lens.Traversal.Traversal' or 'Control.Lens.Traversal.IndexedTraversal'

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

-- note the 3rd argument infers as phantom, but that would be unsound

type role Magma representational nominal nominal nominal

instance Functor (Magma i t b) where
  fmap :: forall a b. (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)    = forall i x y b a.
Magma i (x -> y) b a -> Magma i x b a -> Magma i y b a
MagmaAp (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Magma i (x -> t) b a
x) (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)    = 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) = forall x y i b a. (x -> y) -> Magma i x b a -> Magma i y b a
MagmaFmap x -> t
xy (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)  = 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 :: forall m a. Monoid m => (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)   = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Magma i (x -> t) b a
x forall a. Monoid a => a -> a -> a
`mappend` 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{}     = forall a. Monoid a => a
mempty
  foldMap a -> m
f (MagmaFmap x -> t
_ Magma i x b a
x) = 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 :: forall (f :: * -> *) a b.
Applicative f =>
(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)    = forall i x y b a.
Magma i (x -> y) b a -> Magma i x b a -> Magma i y b a
MagmaAp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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)    = forall (f :: * -> *) a. Applicative f => a -> f a
pure (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) = forall x y i b a. (x -> y) -> Magma i x b a -> Magma i y b a
MagmaFmap x -> t
xy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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)  = forall i a b. i -> a -> Magma i b b a
Magma i
i 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 :: forall a b. (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)    = forall i x y b a.
Magma i (x -> y) b a -> Magma i x b a -> Magma i y b a
MagmaAp (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) (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)    = 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) = forall x y i b a. (x -> y) -> Magma i x b a -> Magma i y b a
MagmaFmap x -> t
xy (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)      = 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 :: forall m a. Monoid m => (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)   = 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 forall a. Monoid a => a -> a -> a
`mappend` 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{}     = forall a. Monoid a => a
mempty
  ifoldMap i -> a -> m
f (MagmaFmap x -> t
_ Magma i x b a
x) = 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 :: forall (f :: * -> *) a b.
Applicative f =>
(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)    = forall i x y b a.
Magma i (x -> y) b a -> Magma i x b a -> Magma i y b a
MagmaAp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f 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)    = forall (f :: * -> *) a. Applicative f => a -> f a
pure (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) = forall x y i b a. (x -> y) -> Magma i x b a -> Magma i y b a
MagmaFmap x -> t
xy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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)      = forall i a b. i -> a -> Magma i b b a
Magma i
i 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 forall a. Ord a => a -> a -> Bool
> Int
4) forall a b. (a -> b) -> a -> b
$
    forall a. Show a => Int -> a -> ShowS
showsPrec Int
4 Magma i (x -> t) b a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" <*> " forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Ord a => a -> a -> Bool
> Int
10) 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 forall a. Ord a => a -> a -> Bool
> Int
4) forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
".. <$> " forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"Magma " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
a

-- | Run a 'Magma' where all the individual leaves have been converted to the

-- expected type

runMagma :: Magma i t a a -> t
runMagma :: forall i t a. Magma i t a a -> t
runMagma (MagmaAp Magma i (x -> t) a a
l Magma i x a a
r)   = forall i t a. Magma i t a a -> t
runMagma Magma i (x -> t) a a
l (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 (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) = a
a

------------------------------------------------------------------------------

-- Molten

------------------------------------------------------------------------------


-- | This is a a non-reassociating initially encoded version of 'Bazaar'.

newtype Molten i a b t = Molten { forall i a b t. Molten i a b t -> Magma i t b a
runMolten :: Magma i t b a }

instance Functor (Molten i a b) where
  fmap :: forall a b. (a -> b) -> Molten i a b a -> Molten i a b b
fmap a -> b
f (Molten Magma i a b a
xs) = forall i a b t. Magma i t b a -> Molten i a b t
Molten (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
  <.> :: forall a 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 :: forall a. a -> Molten i a b a
pure  = forall i a b t. Magma i t b a -> Molten i a b t
Molten forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall x i b a. x -> Magma i x b a
MagmaPure
  {-# INLINE pure #-}
  Molten Magma i (a -> b) b a
xs <*> :: forall a b.
Molten i a b (a -> b) -> Molten i a b a -> Molten i a b b
<*> Molten Magma i a b a
ys = forall i a b t. Magma i t b a -> Molten i a b t
Molten (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 :: forall a b. Indexed i a (Molten i a b b)
sell = forall i a b. (i -> a -> b) -> Indexed i a b
Indexed (\i
i -> forall i a b t. Magma i t b a -> Molten i a b t
Molten forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall i a b. i -> a -> Magma i b b a
Magma i
i)
  {-# INLINE sell #-}

instance Bizarre (Indexed i) (Molten i) where
  bazaar :: forall (f :: * -> *) a b t.
Applicative f =>
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))   = 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 (forall i a b t. Magma i t b a -> Molten i a b t
Molten Magma i (x -> t) b a
x) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (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))   = forall (f :: * -> *) a. Applicative f => a -> f a
pure t
x
  bazaar Indexed i a (f b)
f (Molten (Magma i
i a
a)) = 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 :: forall s t a b. (s -> t) -> Molten i a b s -> Molten i a b t
ifmap s -> t
f (Molten Magma i s b a
xs) = forall i a b t. Magma i t b a -> Molten i a b t
Molten (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 :: forall a t. Molten i a a t -> t
iextract (Molten (MagmaAp Magma i (x -> t) a a
x Magma i x a a
y))   = forall (w :: * -> * -> * -> *) a t.
IndexedComonad w =>
w a a t -> t
iextract (forall i a b t. Magma i t b a -> Molten i a b t
Molten Magma i (x -> t) a a
x) (forall (w :: * -> * -> * -> *) a t.
IndexedComonad w =>
w a a t -> t
iextract (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 (forall (w :: * -> * -> * -> *) a t.
IndexedComonad w =>
w a a t -> t
iextract (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
a

  iduplicate :: forall a c t b. Molten i a c t -> Molten i a b (Molten i b c t)
iduplicate (Molten (Magma i
i a
a)) = forall i a b t. Magma i t b a -> Molten i a b t
Molten forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall i a b. i -> a -> Magma i b b a
Magma i
i forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i a b t. Magma i t b a -> Molten i a b t
Molten (forall i a b. i -> a -> Magma i b b a
Magma i
i a
a)
  iduplicate (Molten (MagmaPure t
x))   = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure t
x)
  iduplicate (Molten (MagmaFmap x -> t
f Magma i x c a
y)) = forall (w :: * -> * -> * -> *) b c t r a.
IndexedComonad w =>
(w b c t -> r) -> w a c t -> w a b r
iextend (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> t
f) (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))   = forall (w :: * -> * -> * -> *) b c t r a.
IndexedComonad w =>
(w b c t -> r) -> w a c t -> w a b r
iextend forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (forall i a b t. Magma i t b a -> Molten i a b t
Molten Magma i (x -> t) c a
x) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (w :: * -> * -> * -> *) a c t b.
IndexedComonad w =>
w a c t -> w a b (w b c t)
iduplicate (forall i a b t. Magma i t b a -> Molten i a b t
Molten Magma i x c a
y)

  iextend :: forall b c t r a.
(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
k forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall i a b t. Magma i t b a -> Molten i a b t
Molten) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i a b. i -> a -> Magma i b b a
Magma i
i forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i a b t. Magma i t b a -> Molten i a b t
Molten (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))   = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Molten i b c t -> r
k (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)) = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> t
f) (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))   = 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 forall a b. (a -> b) -> a -> b
$ Molten i b c (x -> t)
x' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Molten i b c x
y') (forall i a b t. Magma i t b a -> Molten i a b t
Molten Magma i (x -> t) c a
x) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (w :: * -> * -> * -> *) a c t b.
IndexedComonad w =>
w a c t -> w a b (w b c t)
iduplicate (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 :: forall a. Molten i a b a -> a
extract   = forall (w :: * -> * -> * -> *) a t.
IndexedComonad w =>
w a a t -> t
iextract
  {-# INLINE extract #-}
  extend :: forall a b.
(Molten i a b a -> b) -> Molten i a b a -> Molten i a b b
extend    = 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 :: forall a. Molten i a b a -> Molten i a b (Molten i a b a)
duplicate = forall (w :: * -> * -> * -> *) a c t b.
IndexedComonad w =>
w a c t -> w a b (w b c t)
iduplicate
  {-# INLINE duplicate #-}

------------------------------------------------------------------------------

-- Mafic

------------------------------------------------------------------------------


-- | This is used to generate an indexed magma from an unindexed source

--

-- By constructing it this way we avoid infinite reassociations in sums where possible.

data Mafic a b t = Mafic Int (Int -> Magma Int t b a)

-- | Generate a 'Magma' using from a prefix sum.

runMafic :: Mafic a b t -> Magma Int t b a
runMafic :: forall a b t. 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 :: forall a b. (a -> b) -> Mafic a b a -> Mafic a b b
fmap a -> b
f (Mafic Int
w Int -> Magma Int a b a
k) = forall a b t. Int -> (Int -> Magma Int t b a) -> Mafic a b t
Mafic Int
w (forall x y i b a. (x -> y) -> Magma i x b a -> Magma i y b a
MagmaFmap a -> b
f 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 <.> :: forall a b. Mafic a b (a -> b) -> Mafic a b a -> Mafic a b b
<.> ~(Mafic Int
wa Int -> Magma Int a b a
ma) = forall a b t. Int -> (Int -> Magma Int t b a) -> Mafic a b t
Mafic (Int
wf forall a. Num a => a -> a -> a
+ Int
wa) forall a b. (a -> b) -> a -> b
$ \Int
o -> 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 forall a. Num a => a -> a -> a
+ Int
wf))
  {-# INLINE (<.>) #-}

instance Applicative (Mafic a b) where
  pure :: forall a. a -> Mafic a b a
pure a
a = forall a b t. Int -> (Int -> Magma Int t b a) -> Mafic a b t
Mafic Int
0 forall a b. (a -> b) -> a -> b
$ \Int
_ -> 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 <*> :: forall a b. Mafic a b (a -> b) -> Mafic a b a -> Mafic a b b
<*> ~(Mafic Int
wa Int -> Magma Int a b a
ma) = forall a b t. Int -> (Int -> Magma Int t b a) -> Mafic a b t
Mafic (Int
wf forall a. Num a => a -> a -> a
+ Int
wa) forall a b. (a -> b) -> a -> b
$ \Int
o -> 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 forall a. Num a => a -> a -> a
+ Int
wf))
  {-# INLINE (<*>) #-}

instance Sellable (->) Mafic where
  sell :: forall a b. a -> Mafic a b b
sell a
a = forall a b t. Int -> (Int -> Magma Int t b a) -> Mafic a b t
Mafic Int
1 forall a b. (a -> b) -> a -> b
$ \ Int
i -> 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 :: forall (f :: * -> *) a b t.
Applicative f =>
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) = 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 :: forall t. Magma Int t b a -> f t
go (MagmaAp Magma Int (x -> t) b a
x Magma Int x b a
y)   = forall t. Magma Int t b a -> f t
go Magma Int (x -> t) b a
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Magma Int t b a -> f t
go Magma Int x b a
x
    go (MagmaPure t
x)   = forall (f :: * -> *) a. Applicative f => a -> f a
pure t
x
    go (Magma Int
i a
a) = 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 :: forall s t a b. (s -> t) -> Mafic a b s -> Mafic a b t
ifmap s -> t
f (Mafic Int
w Int -> Magma Int s b a
k) = forall a b t. Int -> (Int -> Magma Int t b a) -> Mafic a b t
Mafic Int
w (forall x y i b a. (x -> y) -> Magma i x b a -> Magma i y b a
MagmaFmap s -> t
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Magma Int s b a
k)
  {-# INLINE ifmap #-}

------------------------------------------------------------------------------

-- TakingWhile

------------------------------------------------------------------------------


-- | This is used to generate an indexed magma from an unindexed source

--

-- By constructing it this way we avoid infinite reassociations where possible.

--

-- In @'TakingWhile' p g a b t@, @g@ has a @nominal@ role to avoid exposing an illegal _|_ via 'Contravariant',

-- while the remaining arguments are degraded to a @nominal@ role by the invariants of 'Magma'

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

-- | Generate a 'Magma' with leaves only while the predicate holds from left to right.

runTakingWhile :: TakingWhile p f a b t -> Magma () t b (Corep p a)
runTakingWhile :: forall (p :: * -> * -> *) (f :: * -> *) a b t.
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 :: forall a b.
(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 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 forall a b. (a -> b) -> a -> b
$ \Bool
b -> if Bool
b then 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 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 <.> :: forall a b.
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) = 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) forall a b. (a -> b) -> a -> b
$ \Bool
o ->
    if Bool
o then 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 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 :: forall a. a -> TakingWhile p f a b a
pure a
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 forall a b. (a -> b) -> a -> b
$ \Bool
_ -> 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 <*> :: forall a b.
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) = 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) forall a b. (a -> b) -> a -> b
$ \Bool
o ->
    if Bool
o then 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 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 :: forall (f :: * -> *) a b t.
Applicative f =>
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) = 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 :: forall t. 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)  = forall t. Magma () t b (Corep p a) -> f t
go Magma () (x -> t) b (Corep p a)
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Magma () t b (Corep p a) -> f t
go Magma () x b (Corep p a)
x
    go (MagmaPure t
x)    = forall (f :: * -> *) a. Applicative f => a -> f a
pure t
x
    go (Magma ()
_ Corep p a
wa) = 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 #-}

-- This constraint is unused intentionally, it protects TakingWhile

instance Contravariant f => Contravariant (TakingWhile p f a b) where
  contramap :: forall a' a.
(a' -> a) -> TakingWhile p f a b a -> TakingWhile p f a b a'
contramap a' -> a
_ = forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$) (forall a. HasCallStack => String -> a
error String
"contramap: TakingWhile")
  {-# INLINE contramap #-}

instance IndexedFunctor (TakingWhile p f) where
  ifmap :: forall s t a b.
(s -> t) -> TakingWhile p f a b s -> TakingWhile p f a b t
ifmap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  {-# INLINE ifmap #-}