{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE RoleAnnotations #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Lens.Internal.Context
-- 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.Context
  ( IndexedFunctor(..)
  , IndexedComonad(..)
  , IndexedComonadStore(..)
  , Sellable(..)
  , Context(..), Context'
  , Pretext(..), Pretext'
  , PretextT(..), PretextT'
  ) where

import Prelude ()

import Control.Arrow
import qualified Control.Category as C
import Control.Comonad
import Control.Comonad.Store.Class
import Control.Lens.Internal.Indexed
import Control.Lens.Internal.Prelude
import Data.Kind
import Data.Profunctor.Rep
import Prelude hiding ((.),id)

------------------------------------------------------------------------------
-- IndexedFunctor
------------------------------------------------------------------------------

-- | This is a Bob Atkey -style 2-argument indexed functor.
--
-- It exists as a superclass for 'IndexedComonad' and expresses the functoriality
-- of an 'IndexedComonad' in its third argument.
class IndexedFunctor w where
  ifmap :: (s -> t) -> w a b s -> w a b t

------------------------------------------------------------------------------
-- IndexedComonad
------------------------------------------------------------------------------

-- | This is a Bob Atkey -style 2-argument indexed comonad.
--
-- It exists as a superclass for 'IndexedComonad' and expresses the functoriality
-- of an 'IndexedComonad' in its third argument.
--
-- The notion of indexed monads is covered in more depth in Bob Atkey's
-- "Parameterized Notions of Computation" <http://bentnib.org/paramnotions-jfp.pdf>
-- and that construction is dualized here.
class IndexedFunctor w => IndexedComonad w where
  {-# MINIMAL iextract, (iduplicate | iextend) #-}

  -- | extract from an indexed comonadic value when the indices match.
  iextract :: w a a t -> t

  -- | duplicate an indexed comonadic value splitting the index.
  iduplicate :: w a c t -> w a b (w b c t)
  iduplicate = forall (w :: * -> * -> * -> *) b c t r a.
IndexedComonad w =>
(w b c t -> r) -> w a c t -> w a b r
iextend forall a. a -> a
id
  {-# INLINE iduplicate #-}

  -- | extend a indexed comonadic computation splitting the index.
  iextend :: (w b c t -> r) -> w a c t -> w a b r
  iextend w b c t -> r
f = forall (w :: * -> * -> * -> *) s t a b.
IndexedFunctor w =>
(s -> t) -> w a b s -> w a b t
ifmap w b c t -> r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (w :: * -> * -> * -> *) a c t b.
IndexedComonad w =>
w a c t -> w a b (w b c t)
iduplicate
  {-# INLINE iextend #-}

------------------------------------------------------------------------------
-- IndexedComonadStore
------------------------------------------------------------------------------

-- | This is an indexed analogue to 'ComonadStore' for when you are working with an
-- 'IndexedComonad'.
class IndexedComonad w => IndexedComonadStore w where
  -- | This is the generalization of 'pos' to an indexed comonad store.
  ipos :: w a c t -> a

  -- | This is the generalization of 'peek' to an indexed comonad store.
  ipeek :: c  -> w a c t -> t
  ipeek c
c = forall (w :: * -> * -> * -> *) a t.
IndexedComonad w =>
w a a t -> t
iextract forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (w :: * -> * -> * -> *) b a c t.
IndexedComonadStore w =>
b -> w a c t -> w b c t
iseek c
c
  {-# INLINE ipeek #-}

  -- | This is the generalization of 'peeks' to an indexed comonad store.
  ipeeks :: (a -> c) -> w a c t -> t
  ipeeks a -> c
f = forall (w :: * -> * -> * -> *) a t.
IndexedComonad w =>
w a a t -> t
iextract forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (w :: * -> * -> * -> *) a b c t.
IndexedComonadStore w =>
(a -> b) -> w a c t -> w b c t
iseeks a -> c
f
  {-# INLINE ipeeks #-}

  -- | This is the generalization of 'seek' to an indexed comonad store.
  iseek :: b  -> w a c t -> w b c t

  -- | This is the generalization of 'seeks' to an indexed comonad store.
  iseeks :: (a -> b) -> w a c t -> w b c t

  -- | This is the generalization of 'experiment' to an indexed comonad store.
  iexperiment :: Functor f => (b -> f c) -> w b c t -> f t
  iexperiment b -> f c
bfc w b c t
wbct = (forall (w :: * -> * -> * -> *) c a t.
IndexedComonadStore w =>
c -> w a c t -> t
`ipeek` w b c t
wbct) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f c
bfc (forall (w :: * -> * -> * -> *) a c t.
IndexedComonadStore w =>
w a c t -> a
ipos w b c t
wbct)
  {-# INLINE iexperiment #-}

  -- | We can always forget the rest of the structure of 'w' and obtain a simpler
  -- indexed comonad store model called 'Context'.
  context :: w a b t -> Context a b t
  context w a b t
wabt = forall a b t. (b -> t) -> a -> Context a b t
Context (forall (w :: * -> * -> * -> *) c a t.
IndexedComonadStore w =>
c -> w a c t -> t
`ipeek` w a b t
wabt) (forall (w :: * -> * -> * -> *) a c t.
IndexedComonadStore w =>
w a c t -> a
ipos w a b t
wabt)
  {-# INLINE context #-}

------------------------------------------------------------------------------
-- Sellable
------------------------------------------------------------------------------

-- | This is used internally to construct a 'Control.Lens.Internal.Bazaar.Bazaar', 'Context' or 'Pretext'
-- from a singleton value.
class Corepresentable p => Sellable p w | w -> p where
  sell :: p a (w a b b)

------------------------------------------------------------------------------
-- Context
------------------------------------------------------------------------------

-- | The indexed store can be used to characterize a 'Control.Lens.Lens.Lens'
-- and is used by 'Control.Lens.Lens.cloneLens'.
--
-- @'Context' a b t@ is isomorphic to
-- @newtype 'Context' a b t = 'Context' { runContext :: forall f. 'Functor' f => (a -> f b) -> f t }@,
-- and to @exists s. (s, 'Control.Lens.Lens.Lens' s t a b)@.
--
-- A 'Context' is like a 'Control.Lens.Lens.Lens' that has already been applied to a some structure.
data Context a b t = Context (b -> t) a
-- type role Context representational representational representational

instance IndexedFunctor Context where
  ifmap :: forall s t a b. (s -> t) -> Context a b s -> Context a b t
ifmap s -> t
f (Context b -> s
g a
t) = forall a b t. (b -> t) -> a -> Context a b t
Context (s -> t
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> s
g) a
t
  {-# INLINE ifmap #-}

instance IndexedComonad Context where
  iextract :: forall a t. Context a a t -> t
iextract   (Context a -> t
f a
a) = a -> t
f a
a
  {-# INLINE iextract #-}
  iduplicate :: forall a c t b. Context a c t -> Context a b (Context b c t)
iduplicate (Context c -> t
f a
a) = forall a b t. (b -> t) -> a -> Context a b t
Context (forall a b t. (b -> t) -> a -> Context a b t
Context c -> t
f) a
a
  {-# INLINE iduplicate #-}
  iextend :: forall b c t r a.
(Context b c t -> r) -> Context a c t -> Context a b r
iextend Context b c t -> r
g  (Context c -> t
f a
a) = forall a b t. (b -> t) -> a -> Context a b t
Context (Context b c t -> r
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b t. (b -> t) -> a -> Context a b t
Context c -> t
f) a
a
  {-# INLINE iextend #-}

instance IndexedComonadStore Context where
  ipos :: forall a c t. Context a c t -> a
ipos (Context c -> t
_ a
a) = a
a
  {-# INLINE ipos #-}
  ipeek :: forall c a t. c -> Context a c t -> t
ipeek c
b (Context c -> t
g a
_) = c -> t
g c
b
  {-# INLINE ipeek #-}
  ipeeks :: forall a c t. (a -> c) -> Context a c t -> t
ipeeks a -> c
f (Context c -> t
g a
a) = c -> t
g (a -> c
f a
a)
  {-# INLINE ipeeks #-}
  iseek :: forall b a c t. b -> Context a c t -> Context b c t
iseek b
a (Context c -> t
g a
_) = forall a b t. (b -> t) -> a -> Context a b t
Context c -> t
g b
a
  {-# INLINE iseek #-}
  iseeks :: forall a b c t. (a -> b) -> Context a c t -> Context b c t
iseeks a -> b
f (Context c -> t
g a
a) = forall a b t. (b -> t) -> a -> Context a b t
Context c -> t
g (a -> b
f a
a)
  {-# INLINE iseeks #-}
  iexperiment :: forall (f :: * -> *) b c t.
Functor f =>
(b -> f c) -> Context b c t -> f t
iexperiment b -> f c
f (Context c -> t
g b
a) = c -> t
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f c
f b
a
  {-# INLINE iexperiment #-}
  context :: forall a b t. Context a b t -> Context a b t
context = forall a. a -> a
id
  {-# INLINE context #-}

instance Functor (Context a b) where
  fmap :: forall a b. (a -> b) -> Context a b a -> Context a b b
fmap a -> b
f (Context b -> a
g a
t) = forall a b t. (b -> t) -> a -> Context a b t
Context (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g) a
t
  {-# INLINE fmap #-}

instance a ~ b => Comonad (Context a b) where
  extract :: forall a. Context a b a -> a
extract   (Context b -> a
f a
a) = b -> a
f a
a
  {-# INLINE extract #-}
  duplicate :: forall a. Context a b a -> Context a b (Context a b a)
duplicate (Context b -> a
f a
a) = forall a b t. (b -> t) -> a -> Context a b t
Context (forall a b t. (b -> t) -> a -> Context a b t
Context b -> a
f) a
a
  {-# INLINE duplicate #-}
  extend :: forall a b. (Context a b a -> b) -> Context a b a -> Context a b b
extend Context a b a -> b
g  (Context b -> a
f a
a) = forall a b t. (b -> t) -> a -> Context a b t
Context (Context a b a -> b
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b t. (b -> t) -> a -> Context a b t
Context b -> a
f) a
a
  {-# INLINE extend #-}

instance a ~ b => ComonadStore a (Context a b) where
  pos :: forall a. Context a b a -> a
pos = forall (w :: * -> * -> * -> *) a c t.
IndexedComonadStore w =>
w a c t -> a
ipos
  {-# INLINE pos #-}
  peek :: forall a. a -> Context a b a -> a
peek = forall (w :: * -> * -> * -> *) c a t.
IndexedComonadStore w =>
c -> w a c t -> t
ipeek
  {-# INLINE peek #-}
  peeks :: forall a. (a -> a) -> Context a b a -> a
peeks = forall (w :: * -> * -> * -> *) a c t.
IndexedComonadStore w =>
(a -> c) -> w a c t -> t
ipeeks
  {-# INLINE peeks #-}
  seek :: forall a. a -> Context a b a -> Context a b a
seek = forall (w :: * -> * -> * -> *) b a c t.
IndexedComonadStore w =>
b -> w a c t -> w b c t
iseek
  {-# INLINE seek #-}
  seeks :: forall a. (a -> a) -> Context a b a -> Context a b a
seeks = forall (w :: * -> * -> * -> *) a b c t.
IndexedComonadStore w =>
(a -> b) -> w a c t -> w b c t
iseeks
  {-# INLINE seeks #-}
  experiment :: forall (f :: * -> *) a.
Functor f =>
(a -> f a) -> Context a b a -> f a
experiment = forall (w :: * -> * -> * -> *) (f :: * -> *) b c t.
(IndexedComonadStore w, Functor f) =>
(b -> f c) -> w b c t -> f t
iexperiment
  {-# INLINE experiment #-}

instance Sellable (->) Context where
  sell :: forall a b. a -> Context a b b
sell = forall a b t. (b -> t) -> a -> Context a b t
Context forall a. a -> a
id
  {-# INLINE sell #-}

-- | @type 'Context'' a s = 'Context' a a s@
type Context' a = Context a a

------------------------------------------------------------------------------
-- Pretext
------------------------------------------------------------------------------

-- | This is a generalized form of 'Context' that can be repeatedly cloned with less
-- impact on its performance, and which permits the use of an arbitrary 'Conjoined'
-- 'Profunctor'
newtype Pretext p a b t = Pretext { forall (p :: * -> * -> *) a b t.
Pretext p a b t
-> forall (f :: * -> *). Functor f => p a (f b) -> f t
runPretext :: forall f. Functor f => p a (f b) -> f t }
-- type role Pretext representational nominal nominal nominal

-- | @type 'Pretext'' p a s = 'Pretext' p a a s@
type Pretext' p a = Pretext p a a

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

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

instance Conjoined p => IndexedComonad (Pretext p) where
  iextract :: forall a t. Pretext p a a t -> t
iextract (Pretext forall (f :: * -> *). Functor f => p a (f a) -> f t
m) = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Functor f => p a (f a) -> f t
m (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a. a -> Identity a
Identity)
  {-# INLINE iextract #-}
  iduplicate :: forall a c t b. Pretext p a c t -> Pretext p a b (Pretext p b c t)
iduplicate (Pretext forall (f :: * -> *). Functor f => p a (f c) -> f t
m) = forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Functor f => p a (f c) -> f t
m (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall (p :: * -> * -> *) (f :: * -> *) a b.
(Conjoined p, Functor f) =>
p a b -> p (f a) (f b)
distrib forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
C.. forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell)
  {-# INLINE iduplicate #-}

instance (a ~ b, Conjoined p) => Comonad (Pretext p a b) where
  extract :: forall a. Pretext p a b a -> a
extract = forall (w :: * -> * -> * -> *) a t.
IndexedComonad w =>
w a a t -> t
iextract
  {-# INLINE extract #-}
  duplicate :: forall a. Pretext p a b a -> Pretext p a b (Pretext p 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 #-}

instance Conjoined p => IndexedComonadStore (Pretext p) where
  ipos :: forall a c t. Pretext p a c t -> a
ipos (Pretext forall (f :: * -> *). Functor f => p a (f c) -> f t
m) = forall {k} a (b :: k). Const a b -> a
getConst forall a b. (a -> b) -> a -> b
$ forall (q :: * -> * -> *) a b.
(Representable q, Comonad (Rep q)) =>
q a b -> a -> b
coarr forall (f :: * -> *). Functor f => p a (f c) -> f t
m forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall {k} a (b :: k). a -> Const a b
Const
  {-# INLINE ipos #-}
  ipeek :: forall c a t. c -> Pretext p a c t -> t
ipeek c
a (Pretext forall (f :: * -> *). Functor f => p a (f c) -> f t
m) = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (q :: * -> * -> *) a b.
(Representable q, Comonad (Rep q)) =>
q a b -> a -> b
coarr forall (f :: * -> *). Functor f => p a (f c) -> f t
m forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\a
_ -> forall a. a -> Identity a
Identity c
a)
  {-# INLINE ipeek #-}
  ipeeks :: forall a c t. (a -> c) -> Pretext p a c t -> t
ipeeks a -> c
f (Pretext forall (f :: * -> *). Functor f => p a (f c) -> f t
m) = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (q :: * -> * -> *) a b.
(Representable q, Comonad (Rep q)) =>
q a b -> a -> b
coarr forall (f :: * -> *). Functor f => p a (f c) -> f t
m forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> c
f)
  {-# INLINE ipeeks #-}
  iseek :: forall b a c t. b -> Pretext p a c t -> Pretext p b c t
iseek b
a (Pretext forall (f :: * -> *). Functor f => p a (f c) -> f t
m) = forall (p :: * -> * -> *) a b t.
(forall (f :: * -> *). Functor f => p a (f b) -> f t)
-> Pretext p a b t
Pretext (forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (forall a b. a -> b -> a
const b
a)) forall (f :: * -> *). Functor f => p a (f c) -> f t
m)
  {-# INLINE iseek #-}
  iseeks :: forall a b c t. (a -> b) -> Pretext p a c t -> Pretext p b c t
iseeks a -> b
f (Pretext forall (f :: * -> *). Functor f => p a (f c) -> f t
m) = forall (p :: * -> * -> *) a b t.
(forall (f :: * -> *). Functor f => p a (f b) -> f t)
-> Pretext p a b t
Pretext (forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> b
f) forall (f :: * -> *). Functor f => p a (f c) -> f t
m)
  {-# INLINE iseeks #-}
  iexperiment :: forall (f :: * -> *) b c t.
Functor f =>
(b -> f c) -> Pretext p b c t -> f t
iexperiment b -> f c
f (Pretext forall (f :: * -> *). Functor f => p b (f c) -> f t
m) = forall (q :: * -> * -> *) a b.
(Representable q, Comonad (Rep q)) =>
q a b -> a -> b
coarr forall (f :: * -> *). Functor f => p b (f c) -> f t
m (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> f c
f)
  {-# INLINE iexperiment #-}
  context :: forall a b t. Pretext p a b t -> Context a b t
context (Pretext forall (f :: * -> *). Functor f => p a (f b) -> f t
m) = forall (q :: * -> * -> *) a b.
(Representable q, Comonad (Rep q)) =>
q a b -> a -> b
coarr forall (f :: * -> *). Functor f => p a (f b) -> f t
m (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell)
  {-# INLINE context #-}

instance (a ~ b, Conjoined p) => ComonadStore a (Pretext p a b) where
  pos :: forall a. Pretext p a b a -> a
pos = forall (w :: * -> * -> * -> *) a c t.
IndexedComonadStore w =>
w a c t -> a
ipos
  {-# INLINE pos #-}
  peek :: forall a. a -> Pretext p a b a -> a
peek = forall (w :: * -> * -> * -> *) c a t.
IndexedComonadStore w =>
c -> w a c t -> t
ipeek
  {-# INLINE peek #-}
  peeks :: forall a. (a -> a) -> Pretext p a b a -> a
peeks = forall (w :: * -> * -> * -> *) a c t.
IndexedComonadStore w =>
(a -> c) -> w a c t -> t
ipeeks
  {-# INLINE peeks #-}
  seek :: forall a. a -> Pretext p a b a -> Pretext p a b a
seek = forall (w :: * -> * -> * -> *) b a c t.
IndexedComonadStore w =>
b -> w a c t -> w b c t
iseek
  {-# INLINE seek #-}
  seeks :: forall a. (a -> a) -> Pretext p a b a -> Pretext p a b a
seeks = forall (w :: * -> * -> * -> *) a b c t.
IndexedComonadStore w =>
(a -> b) -> w a c t -> w b c t
iseeks
  {-# INLINE seeks #-}
  experiment :: forall (f :: * -> *) a.
Functor f =>
(a -> f a) -> Pretext p a b a -> f a
experiment = forall (w :: * -> * -> * -> *) (f :: * -> *) b c t.
(IndexedComonadStore w, Functor f) =>
(b -> f c) -> w b c t -> f t
iexperiment
  {-# INLINE experiment #-}

instance Corepresentable p => Sellable p (Pretext p) where
  sell :: forall a b. p a (Pretext p a b b)
sell = forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate forall a b. (a -> b) -> a -> b
$ \ Corep p a
w -> forall (p :: * -> * -> *) a b t.
(forall (f :: * -> *). Functor f => p a (f b) -> f t)
-> Pretext p a b t
Pretext (forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
`cosieve` Corep p a
w)
  {-# INLINE sell #-}

------------------------------------------------------------------------------
-- PretextT
------------------------------------------------------------------------------



-- | This is a generalized form of 'Context' that can be repeatedly cloned with less
-- impact on its performance, and which permits the use of an arbitrary 'Conjoined'
-- 'Profunctor'.
--
-- The extra phantom 'Functor' is used to let us lie and claim
-- 'Control.Lens.Getter.Getter'-compatibility under limited circumstances.
-- This is used internally to permit a number of combinators to gracefully
-- degrade when applied to a 'Control.Lens.Fold.Fold' or
-- 'Control.Lens.Getter.Getter'.
newtype PretextT p (g :: Type -> Type) a b t = PretextT { forall (p :: * -> * -> *) (g :: * -> *) a b t.
PretextT p g a b t
-> forall (f :: * -> *). Functor f => p a (f b) -> f t
runPretextT :: forall f. Functor f => p a (f b) -> f t }

-- really we want PretextT p g a b t to permit the last 3 arguments to be representational iff p and f accept representational arguments
-- but that isn't currently an option in GHC
type role PretextT representational nominal nominal nominal nominal

-- | @type 'PretextT'' p g a s = 'PretextT' p g a a s@
type PretextT' p g a = PretextT p g a a

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

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

instance Conjoined p => IndexedComonad (PretextT p g) where
  iextract :: forall a t. PretextT p g a a t -> t
iextract (PretextT forall (f :: * -> *). Functor f => p a (f a) -> f t
m) = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Functor f => p a (f a) -> f t
m (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall a. a -> Identity a
Identity)
  {-# INLINE iextract #-}
  iduplicate :: forall a c t b.
PretextT p g a c t -> PretextT p g a b (PretextT p g b c t)
iduplicate (PretextT forall (f :: * -> *). Functor f => p a (f c) -> f t
m) = forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Functor f => p a (f c) -> f t
m (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall (p :: * -> * -> *) (f :: * -> *) a b.
(Conjoined p, Functor f) =>
p a b -> p (f a) (f b)
distrib forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
C.. forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell)
  {-# INLINE iduplicate #-}

instance (a ~ b, Conjoined p) => Comonad (PretextT p g a b) where
  extract :: forall a. PretextT p g a b a -> a
extract = forall (w :: * -> * -> * -> *) a t.
IndexedComonad w =>
w a a t -> t
iextract
  {-# INLINE extract #-}
  duplicate :: forall a.
PretextT p g a b a -> PretextT p g a b (PretextT p g 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 #-}

instance Conjoined p => IndexedComonadStore (PretextT p g) where
  ipos :: forall a c t. PretextT p g a c t -> a
ipos (PretextT forall (f :: * -> *). Functor f => p a (f c) -> f t
m) = forall {k} a (b :: k). Const a b -> a
getConst forall a b. (a -> b) -> a -> b
$ forall (q :: * -> * -> *) a b.
(Representable q, Comonad (Rep q)) =>
q a b -> a -> b
coarr forall (f :: * -> *). Functor f => p a (f c) -> f t
m forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall {k} a (b :: k). a -> Const a b
Const
  {-# INLINE ipos #-}
  ipeek :: forall c a t. c -> PretextT p g a c t -> t
ipeek c
a (PretextT forall (f :: * -> *). Functor f => p a (f c) -> f t
m) = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (q :: * -> * -> *) a b.
(Representable q, Comonad (Rep q)) =>
q a b -> a -> b
coarr forall (f :: * -> *). Functor f => p a (f c) -> f t
m forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\a
_ -> forall a. a -> Identity a
Identity c
a)
  {-# INLINE ipeek #-}
  ipeeks :: forall a c t. (a -> c) -> PretextT p g a c t -> t
ipeeks a -> c
f (PretextT forall (f :: * -> *). Functor f => p a (f c) -> f t
m) = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (q :: * -> * -> *) a b.
(Representable q, Comonad (Rep q)) =>
q a b -> a -> b
coarr forall (f :: * -> *). Functor f => p a (f c) -> f t
m forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> c
f)
  {-# INLINE ipeeks #-}
  iseek :: forall b a c t. b -> PretextT p g a c t -> PretextT p g b c t
iseek b
a (PretextT forall (f :: * -> *). Functor f => p a (f c) -> f t
m) = forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Functor f => p a (f b) -> f t)
-> PretextT p g a b t
PretextT (forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (forall a b. a -> b -> a
const b
a)) forall (f :: * -> *). Functor f => p a (f c) -> f t
m)
  {-# INLINE iseek #-}
  iseeks :: forall a b c t.
(a -> b) -> PretextT p g a c t -> PretextT p g b c t
iseeks a -> b
f (PretextT forall (f :: * -> *). Functor f => p a (f c) -> f t
m) = forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Functor f => p a (f b) -> f t)
-> PretextT p g a b t
PretextT (forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap a -> b
f) forall (f :: * -> *). Functor f => p a (f c) -> f t
m)
  {-# INLINE iseeks #-}
  iexperiment :: forall (f :: * -> *) b c t.
Functor f =>
(b -> f c) -> PretextT p g b c t -> f t
iexperiment b -> f c
f (PretextT forall (f :: * -> *). Functor f => p b (f c) -> f t
m) = forall (q :: * -> * -> *) a b.
(Representable q, Comonad (Rep q)) =>
q a b -> a -> b
coarr forall (f :: * -> *). Functor f => p b (f c) -> f t
m (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> f c
f)
  {-# INLINE iexperiment #-}
  context :: forall a b t. PretextT p g a b t -> Context a b t
context (PretextT forall (f :: * -> *). Functor f => p a (f b) -> f t
m) = forall (q :: * -> * -> *) a b.
(Representable q, Comonad (Rep q)) =>
q a b -> a -> b
coarr forall (f :: * -> *). Functor f => p a (f b) -> f t
m (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell)
  {-# INLINE context #-}

instance (a ~ b, Conjoined p) => ComonadStore a (PretextT p g a b) where
  pos :: forall a. PretextT p g a b a -> a
pos = forall (w :: * -> * -> * -> *) a c t.
IndexedComonadStore w =>
w a c t -> a
ipos
  {-# INLINE pos #-}
  peek :: forall a. a -> PretextT p g a b a -> a
peek = forall (w :: * -> * -> * -> *) c a t.
IndexedComonadStore w =>
c -> w a c t -> t
ipeek
  {-# INLINE peek #-}
  peeks :: forall a. (a -> a) -> PretextT p g a b a -> a
peeks = forall (w :: * -> * -> * -> *) a c t.
IndexedComonadStore w =>
(a -> c) -> w a c t -> t
ipeeks
  {-# INLINE peeks #-}
  seek :: forall a. a -> PretextT p g a b a -> PretextT p g a b a
seek = forall (w :: * -> * -> * -> *) b a c t.
IndexedComonadStore w =>
b -> w a c t -> w b c t
iseek
  {-# INLINE seek #-}
  seeks :: forall a. (a -> a) -> PretextT p g a b a -> PretextT p g a b a
seeks = forall (w :: * -> * -> * -> *) a b c t.
IndexedComonadStore w =>
(a -> b) -> w a c t -> w b c t
iseeks
  {-# INLINE seeks #-}
  experiment :: forall (f :: * -> *) a.
Functor f =>
(a -> f a) -> PretextT p g a b a -> f a
experiment = forall (w :: * -> * -> * -> *) (f :: * -> *) b c t.
(IndexedComonadStore w, Functor f) =>
(b -> f c) -> w b c t -> f t
iexperiment
  {-# INLINE experiment #-}

instance Corepresentable p => Sellable p (PretextT p g) where
  sell :: forall a b. p a (PretextT p g a b b)
sell = forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate forall a b. (a -> b) -> a -> b
$ \ Corep p a
w -> forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Functor f => p a (f b) -> f t)
-> PretextT p g a b t
PretextT (forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
`cosieve` Corep p a
w)
  {-# INLINE sell #-}

instance (Profunctor p, Contravariant g) => Contravariant (PretextT p g a b) where
  contramap :: forall a' a. (a' -> a) -> PretextT p g a b a -> PretextT p g a b a'
contramap a' -> a
_ = forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$) (forall a. HasCallStack => [Char] -> a
error [Char]
"contramap: PretextT")
  {-# INLINE contramap #-}

------------------------------------------------------------------------------
-- Utilities
------------------------------------------------------------------------------

-- | We can convert any 'Conjoined' 'Profunctor' to a function,
-- possibly losing information about an index in the process.
coarr :: (Representable q, Comonad (Rep q)) => q a b -> a -> b
coarr :: forall (q :: * -> * -> *) a b.
(Representable q, Comonad (Rep q)) =>
q a b -> a -> b
coarr q a b
qab = forall (w :: * -> *) a. Comonad w => w a -> a
extract forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) a b.
Sieve p f =>
p a b -> a -> f b
sieve q a b
qab
{-# INLINE coarr #-}