{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
#ifndef MIN_VERSION_profunctors
#define MIN_VERSION_profunctors(x,y,z) 1
#endif
module Data.Profunctor.Optic.Types (
Optic, Optic'
, Affine, Coaffine
, Traversing, Cotraversing
, Traversing1, Cotraversing1
, CoerceL, CoerceR
, Mapping, Comapping
, Mapping1, Comapping1
, Equality, Equality'
, Iso, Iso'
, Prism, Coprism
, Prism', Coprism'
, Lens, Colens
, Lens', Colens'
, Grate, Grate'
, Traversal0, Cotraversal0
, Traversal, Cotraversal
, Traversal1, Cotraversal1
, Traversal0', Cotraversal0'
, Traversal', Cotraversal'
, Traversal1', Cotraversal1'
, Fold0, Fold, Fold1
, Setter, Resetter
, Setter', Resetter'
, View, Review
, Re(..), re
, between
, module Export
) where
import Data.Bifunctor (Bifunctor(..))
import Data.Functor.Apply (Apply(..))
import Data.Profunctor.Optic.Import
import Data.Profunctor.Types as Export
type Affine p = (Choice p, Strong p)
type Coaffine p = (Choice p, Closed p)
type Traversing p = (Representable p, Applicative' (Rep p))
type Cotraversing p = (Corepresentable p, Coapplicative (Corep p))
type Traversing1 p = (Representable p, Apply (Rep p))
type Cotraversing1 p = (Corepresentable p, Coapply (Corep p))
type CoerceL p = (Bifunctor p)
type CoerceR p = (forall x. Contravariant (p x))
type Mapping p = (Representable p, Distributive (Rep p))
type Mapping1 p = (Representable p, Distributive1 (Rep p))
type Comapping p = (Corepresentable p, Traversable (Corep p))
type Comapping1 p = (Corepresentable p, Traversable1 (Corep p))
type Optic p s t a b = p a b -> p s t
type Optic' p s a = Optic p s s a a
type Equality s t a b = forall p. Optic p s t a b
type Equality' s a = Equality s s a a
type Iso s t a b = forall p. Profunctor p => Optic p s t a b
type Iso' s a = Iso s s a a
type Prism s t a b = forall p. Choice p => Optic p s t a b
type Coprism s t a b = forall p. Cochoice p => Optic p s t a b
type Prism' s a = Prism s s a a
type Coprism' t b = Coprism t t b b
type Lens s t a b = forall p. Strong p => Optic p s t a b
type Colens s t a b = forall p. Costrong p => Optic p s t a b
type Grate s t a b = forall p. Closed p => Optic p s t a b
type Lens' s a = Lens s s a a
type Colens' t b = Lens t t b b
type Grate' s a = Grate s s a a
type Traversal0 s t a b = forall p. Affine p => Optic p s t a b
type Cotraversal0 s t a b = forall p. Coaffine p => Optic p s t a b
type Traversal0' s a = Traversal0 s s a a
type Cotraversal0' t b = Cotraversal0 t t b b
type Traversal s t a b = forall p. (Affine p, Traversing p) => Optic p s t a b
type Cotraversal s t a b = forall p. (Coaffine p, Cotraversing p) => Optic p s t a b
type Traversal' s a = Traversal s s a a
type Cotraversal' t b = Cotraversal t t b b
type Traversal1 s t a b = forall p. (Strong p, Traversing1 p) => Optic p s t a b
type Cotraversal1 s t a b = forall p. (Closed p, Cotraversing1 p) => Optic p s t a b
type Traversal1' s a = Traversal1 s s a a
type Cotraversal1' t b = Cotraversal1 t t b b
type Fold0 s a = forall p. (Affine p, CoerceR p) => Optic' p s a
type Fold s a = forall p. (Affine p, Traversing p, CoerceR p) => Optic' p s a
type Fold1 s a = forall p. (Strong p, Traversing1 p, CoerceR p) => Optic' p s a
type View s a = forall p. (Strong p, CoerceR p) => Optic' p s a
type Review t b = forall p. (Closed p, CoerceL p) => Optic' p t b
type Setter s t a b = forall p. (Affine p, Traversing p, Mapping p) => Optic p s t a b
type Resetter s t a b = forall p. (Coaffine p, Cotraversing p, Comapping p) => Optic p s t a b
type Setter' s a = Setter s s a a
type Resetter' s a = Resetter s s a a
between :: (c -> d) -> (a -> b) -> (b -> c) -> a -> d
between f g = (f .) . (. g)
{-# INLINE between #-}
re :: Optic (Re p a b) s t a b -> Optic p b a t s
re o = (between runRe Re) o id
{-# INLINE re #-}
newtype Re p s t a b = Re { runRe :: p b a -> p t s }
instance Profunctor p => Profunctor (Re p s t) where
dimap f g (Re p) = Re (p . dimap g f)
instance Strong p => Costrong (Re p s t) where
unfirst (Re p) = Re (p . first')
instance Costrong p => Strong (Re p s t) where
first' (Re p) = Re (p . unfirst)
instance Choice p => Cochoice (Re p s t) where
unright (Re p) = Re (p . right')
instance Cochoice p => Choice (Re p s t) where
right' (Re p) = Re (p . unright)
instance (Profunctor p, forall x. Contravariant (p x)) => Bifunctor (Re p s t) where
first f (Re p) = Re (p . contramap f)
second f (Re p) = Re (p . lmap f)
instance Bifunctor p => Contravariant (Re p s t a) where
contramap f (Re p) = Re (p . first f)
instance Apply f => Apply (Star f a) where
Star ff <.> Star fx = Star $ \a -> ff a <.> fx a
instance Apply (Costar f a) where
Costar ff <.> Costar fx = Costar $ \a -> ff a (fx a)
#if !(MIN_VERSION_profunctors(5,4,0))
instance Contravariant f => Contravariant (Star f a) where
contramap f (Star g) = Star $ contramap f . g
#endif
instance Contravariant f => Bifunctor (Costar f) where
first f (Costar g) = Costar $ g . contramap f
second f (Costar g) = Costar $ f . g
#if MIN_VERSION_profunctors(5,4,0)
instance Coapplicative f => Choice (Costar f) where
left' (Costar f) = Costar $ either (Left . f) (Right . copure) . coapply
#endif