{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE QuantifiedConstraints #-}
#ifndef MIN_VERSION_profunctors
#define MIN_VERSION_profunctors(x,y,z) 1
#endif
module Data.Profunctor.Optic.Types (
Optic, Optic'
, IndexedOptic, IndexedOptic'
, CoindexedOptic, CoindexedOptic'
, Iso, Iso', Equality, Equality'
, Lens, Lens', Ixlens, Ixlens'
, Prism, Prism', Cxprism, Cxprism'
, Grate, Grate', Cxgrate, Cxgrate'
, Affine, Affine', Ixaffine, Ixaffine'
, Option, Ixoption
, Grism , Grism'
, Traversal , Traversal' , Ixtraversal , Ixtraversal'
, Traversal1 , Traversal1' , Ixtraversal1, Ixtraversal1'
, Fold, Ixfold , Fold1, Ixfold1
, Cotraversal , Cotraversal'
, PrimView, View, Ixview, PrimReview, Review, Cxview
, Setter, Setter', Ixsetter, Ixsetter'
, Resetter, Resetter', Cxsetter, Cxsetter'
, Coapplicative(..), Branch(..)
, between
, Re(..), re
, module Export
) where
import Data.Bifunctor (Bifunctor(..))
import Data.Functor.Apply (Apply(..))
import Data.Profunctor.Optic.Import hiding (branch)
import Data.Profunctor.Extra as Export (type (+))
import Data.Profunctor.Types as Export
import qualified Control.Arrow as A
import Data.List.NonEmpty as L1
import qualified Data.Bifunctor as B
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 IndexedOptic p i s t a b = p (i , a) b -> p (i , s) t
type IndexedOptic' p i s a = IndexedOptic p i s s a a
type CoindexedOptic p k s t a b = p a (k -> b) -> p s (k -> t)
type CoindexedOptic' p k t b = CoindexedOptic p k t t b b
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 Equality s t a b = forall p. Optic p s t a b
type Equality' s a = Equality s s a a
type Lens s t a b = forall p. Strong p => Optic p s t a b
type Lens' s a = Lens s s a a
type Ixlens i s t a b = forall p. Strong p => IndexedOptic p i s t a b
type Ixlens' i s a = Ixlens i s s a a
type Prism s t a b = forall p. Choice p => Optic p s t a b
type Prism' s a = Prism s s a a
type Cxprism k s t a b = forall p. Choice p => CoindexedOptic p k s t a b
type Cxprism' k s a = Cxprism k s s a a
type Grate s t a b = forall p. Closed p => Optic p s t a b
type Grate' s a = Grate s s a a
type Cxgrate k s t a b = forall p. Closed p => CoindexedOptic p k s t a b
type Cxgrate' k s a = Cxgrate k s s a a
type Colens s t a b = forall p. Costrong p => Optic p s t a b
type Colens' s a = Colens s s a a
type Cxlens k s t a b = forall p. Costrong p => CoindexedOptic p k s t a b
type Cxlens' k s a = Cxlens k s s a a
type Cotraversal0 s t a b = forall p. (Choice p, Closed p) => Optic p s t a b
type Cotraversal0' t b = Cotraversal0 t t b b
type Affine s t a b = forall p. (Choice p, Strong p) => Optic p s t a b
type Affine' s a = Affine s s a a
type Ixaffine i s t a b = forall p. (Choice p, Strong p) => IndexedOptic p i s t a b
type Ixaffine' i s a = Ixaffine i s s a a
type Option s a = forall p. (Choice p, Strong p, forall x. Contravariant (p x)) => Optic' p s a
type Ixoption i s a = forall p. (Choice p, Strong p, forall x. Contravariant (p x)) => IndexedOptic' p i s a
type Grism s t a b = forall p. (Choice p, Closed p) => Optic p s t a b
type Grism' t b = Grism t t b b
type Traversal s t a b = forall p. (Choice p, Strong p, Representable p, Applicative (Rep p)) => Optic p s t a b
type Traversal' s a = Traversal s s a a
type Ixtraversal i s t a b = forall p. (Choice p, Strong p, Representable p, Applicative (Rep p)) => IndexedOptic p i s t a b
type Ixtraversal' i s a = Ixtraversal i s s a a
type Traversal1 s t a b = forall p. (Strong p, Representable p, Apply (Rep p)) => Optic p s t a b
type Traversal1' s a = Traversal1 s s a a
type Ixtraversal1 i s t a b = forall p. (Strong p, Representable p, Apply (Rep p)) => IndexedOptic p i s t a b
type Ixtraversal1' i s a = Ixtraversal1 i s s a a
type Cofold0 t b = forall p. (Choice p, Closed p, Strong p, forall x. Contravariant (p x)) => Optic' p t b
type Fold1 s a = forall p. (Strong p, Representable p, Apply (Rep p), forall x. Contravariant (p x)) => Optic' p s a
type Ixfold1 i s a = forall p. (Strong p, Representable p, Apply (Rep p), forall x. Contravariant (p x)) => IndexedOptic' p i s a
type Fold s a = forall p. (Choice p, Representable p, Applicative (Rep p), forall x. Contravariant (p x)) => Optic' p s a
type Ixfold i s a = forall p. (Choice p, Representable p, Applicative (Rep p), forall x. Contravariant (p x)) => IndexedOptic' p i s a
type Cotraversal s t a b = forall p. (Choice p, Closed p, Coapplicative (Corep p), Corepresentable p) => Optic p s t a b
type Cotraversal' t b = Cotraversal t t b b
type PrimView s t a b = forall p. (Profunctor p, forall x. Contravariant (p x)) => Optic p s t a b
type View s a = forall p. (Strong p, forall x. Contravariant (p x)) => Optic' p s a
type Ixview i s a = forall p. (Strong p, forall x. Contravariant (p x)) => IndexedOptic' p i s a
type PrimReview s t a b = forall p. (Profunctor p, Bifunctor p) => Optic p s t a b
type Review t b = forall p. (Closed p, Bifunctor p) => Optic' p t b
type Cxview k t b = forall p. (Closed p, Bifunctor p) => CoindexedOptic' p k t b
type Setter s t a b = forall p. (Choice p, Strong p, Representable p, Applicative (Rep p), Distributive (Rep p)) => Optic p s t a b
type Setter' s a = Setter s s a a
type Ixsetter i s t a b = forall p. (Choice p, Strong p, Representable p, Applicative (Rep p), Distributive (Rep p)) => IndexedOptic p i s t a b
type Ixsetter' i s a = Ixsetter i s s a a
type Resetter s t a b = forall p. (Choice p, Closed p, Corepresentable p, Coapplicative (Corep p), Traversable (Corep p)) => Optic p s t a b
type Resetter' s a = Resetter s s a a
type Cxsetter k s t a b = forall p. (Choice p, Closed p, Corepresentable p, Coapplicative (Corep p), Traversable (Corep p)) => CoindexedOptic p k s t a b
type Cxsetter' k t b = Cxsetter k t t b b
class Functor f => Branch f where
branch :: f (Either a b) -> Either (f a) (f b)
cobranch :: Apply f => (f a, f b) -> f (a, b)
cobranch = uncurry $ liftF2 (,)
instance Branch Identity where
branch (Identity ab) = either (Left . Identity) (Right . Identity) ab
instance Branch (Tagged k) where
branch (Tagged ab) = either (Left . Tagged) (Right . Tagged) ab
instance Branch ((,) r) where
branch (r, a) = either (Left . (r,)) (Right . (r,)) a
instance Monoid m => Branch ((->) m) where
branch f = either (Left . const) (Right . const) $ f mempty
instance Branch NonEmpty where
branch (Left x :| zs) = Left $ x :| foldr (either (:) (const id)) [] zs
branch (Right y :| zs) = Right $ y :| foldr (either (const id) (:)) [] zs
instance (Branch f, Branch g) => Branch (Compose f g) where
branch (Compose ab) = B.bimap Compose Compose . branch . fmap branch $ ab
class Branch f => Coapplicative f where
copure :: f a -> a
instance Coapplicative Identity where
copure (Identity a) = a
instance Coapplicative (Tagged k) where
copure (Tagged a) = a
instance Coapplicative ((,) r) where
copure (_, a) = a
instance Monoid m => Coapplicative ((->) m) where
copure f = f mempty
instance Coapplicative NonEmpty where
copure = L1.head
catLefts :: [Either a b] -> [a]
catLefts = foldr (either (:) (const id)) []
catRights :: [Either a b] -> [b]
catRights = foldr (either (const id) (:)) []
instance (Coapplicative f, Coapplicative g) => Coapplicative (Compose f g) where
copure (Compose a) = copure . fmap copure $ a
#if MIN_VERSION_profunctors(5,4,0)
instance Coapplicative f => Choice (Costar f) where
left' (Costar f) = Costar $ either (Left . f) (Right . copure) . branch
#endif
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