{-# 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)    = 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 a b.
(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 a b. (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 a b. (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 :: 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)   = (a -> m) -> Magma i (x -> t) b a -> m
forall m a. Monoid m => (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 m a. Monoid m => (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 m a. Monoid m => (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 :: 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)    = 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Magma i (x -> t) b a -> f (Magma i (x -> t) b 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 a b. f (a -> b) -> f a -> f 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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Magma i x b a -> f (Magma i x b 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 a. a -> f a
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Magma i x b a -> f (Magma i x b 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 b b) -> f b -> f (Magma i t b 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 :: 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)    = 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 a b.
(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 a b. (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 a b. (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 :: 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)   = (i -> a -> m) -> Magma i (x -> t) b a -> m
forall m a. Monoid m => (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 m a. Monoid m => (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 m a. Monoid m => (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 :: 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)    = 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)
forall (f :: * -> *) a b.
Applicative f =>
(i -> a -> f b) -> Magma i (x -> t) b a -> f (Magma i (x -> t) b 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 a b. f (a -> b) -> f a -> f 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)
forall (f :: * -> *) a b.
Applicative f =>
(i -> a -> f b) -> Magma i x b a -> f (Magma i x b 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 a. a -> f a
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)
forall (f :: * -> *) a b.
Applicative f =>
(i -> a -> f b) -> Magma i x b a -> f (Magma i x b 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 b b) -> f b -> f (Magma i t b 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

-- | 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)   = 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

------------------------------------------------------------------------------
-- 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) = 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
  <.> :: forall a b.
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 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  = 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 a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
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 <*> :: 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 = 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 :: forall a b. 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 a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
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 :: 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))   = Indexed i a (f b) -> Molten i a b (x -> t) -> f (x -> t)
forall (f :: * -> *) a b t.
Applicative f =>
Indexed i a (f b) -> Molten i a b t -> f 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 a b. f (a -> b) -> f a -> f b
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 (f :: * -> *) a b t.
Applicative f =>
Indexed i a (f b) -> Molten i a b t -> f 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 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 (f :: * -> *) a b t.
Applicative f =>
Indexed i a (f b) -> Molten i a b t -> f 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 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 a. a -> f a
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 t) -> i -> a -> f t
forall a b. Indexed i a b -> i -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed Indexed i a (f b)
Indexed i a (f t)
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) = 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 :: 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))   = Molten i a a (x -> t) -> x -> t
forall a t. Molten i a a t -> 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 a t. Molten i a a t -> t
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 a t. Molten i a a t -> t
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 :: 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)) = 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 a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
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 a. a -> Molten i a b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> Molten i b c t
forall a. a -> Molten i b c a
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 b c t r a.
(Molten i b c t -> r) -> Molten i a c t -> 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 ((x -> t) -> Molten i b c x -> Molten i b c t
forall a b. (a -> b) -> Molten i b c a -> Molten i b c b
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 b c t r a.
(Molten i b c t -> r) -> Molten i a c t -> 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 (x -> t) -> Molten i b c x -> Molten i b c t
forall a b.
Molten i b c (a -> b) -> Molten i b c a -> Molten i b c b
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 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
<*> Molten i a c x -> Molten i a b (Molten i b c x)
forall a c t b. Molten i a c t -> Molten i a b (Molten i b c t)
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 :: 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
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 a b c (q :: * -> * -> *).
Coercible b a =>
(b -> c) -> q a b -> a -> c
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 a. a -> Molten i a b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Molten i b c t -> r
k (t -> Molten i b c t
forall a. a -> Molten i b c a
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 b c t r a.
(Molten i b c t -> r) -> Molten i a c t -> 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 a b. (a -> b) -> Molten i b c a -> Molten i b c b
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 b c t r a.
(Molten i b c t -> r) -> Molten i a c t -> 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 (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 a b.
Molten i b c (a -> b) -> Molten i b c a -> Molten i b c b
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 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
<*> Molten i a c x -> Molten i a b (Molten i b c x)
forall a c t b. Molten i a c t -> Molten i a b (Molten i b c t)
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 :: forall a. Molten i a b a -> a
extract   = Molten i a b a -> a
Molten i b b a -> a
forall a t. Molten i a a t -> t
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    = (Molten i a b a -> b) -> Molten i a b a -> Molten i a a b
(Molten i a b a -> b) -> Molten i a b a -> Molten i a b b
forall b c t r a.
(Molten i b c t -> r) -> Molten i a c t -> 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
  {-# INLINE extend #-}
  duplicate :: forall a. Molten i a b a -> Molten i a b (Molten i a b a)
duplicate = Molten i a b a -> Molten i a a (Molten i a b a)
Molten i a b a -> Molten i a b (Molten i a b a)
forall a c t b. Molten i a c t -> Molten i a b (Molten i b c t)
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) = 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 <.> :: 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) = 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 :: forall a. 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 <*> :: 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) = 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 :: forall a b. 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 :: 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) = 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 :: forall t. 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 a b. f (a -> b) -> f a -> f b
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 a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
x
    go (Magma Int
i a
a) = Indexed Int a (f t) -> Int -> a -> f t
forall a b. Indexed Int a b -> Int -> a -> b
forall i (p :: * -> * -> *) a b.
Indexable i p =>
p a b -> i -> a -> b
indexed Indexed Int a (f b)
Indexed Int a (f t)
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) = 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 #-}

------------------------------------------------------------------------------
-- 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 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 <.> :: 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) = 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 :: forall a. 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 <*> :: 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) = 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 :: 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) = 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 :: 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)  = 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 a b. f (a -> b) -> f a -> f b
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 a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
x
    go (Magma ()
_ Corep p a
wa) = p a (f t) -> Corep p a -> f t
forall a b. p a b -> Corep p a -> b
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p a (f b)
p a (f t)
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
_ = a' -> TakingWhile p f a b a -> TakingWhile p f a b a'
forall 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 :: forall s t a b.
(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 a b.
(a -> b) -> TakingWhile p f a b a -> TakingWhile p f a b b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  {-# INLINE ifmap #-}