{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
module Data.Generics.Internal.VL.Prism where
import Data.Functor.Identity (Identity(..))
import Data.Profunctor (Choice(..), Profunctor(..))
import Data.Coerce
import Data.Generics.Internal.Profunctor.Prism (Market (..), plus, idPrism)
import Data.Tagged
import Data.Profunctor.Unsafe ((#.), (.#))
import Data.Monoid (First (..))
import Control.Applicative (Const(..))
type Prism s t a b
= forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t)
type Prism' s a
= Prism s s a a
infixl 8 ^?
(^?) :: s -> ((a -> Const (First a) a) -> s -> Const (First a) s) -> Maybe a
s :: s
s ^? :: s
-> ((a -> Const (First a) a) -> s -> Const (First a) s) -> Maybe a
^? l :: (a -> Const (First a) a) -> s -> Const (First a) s
l = First a -> Maybe a
forall a. First a -> Maybe a
getFirst (((a -> Const (First a) a) -> s -> Const (First a) s)
-> (a -> First a) -> s -> First a
forall (p :: * -> * -> *) (p :: * -> * -> *) a b b a c b.
(Profunctor p, Profunctor p) =>
(p a (Const b b) -> p a (Const c b)) -> p a b -> p a c
fmof (a -> Const (First a) a) -> s -> Const (First a) s
l (Maybe a -> First a
forall a. Maybe a -> First a
First (Maybe a -> First a) -> (a -> Maybe a) -> a -> First a
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. a -> Maybe a
forall a. a -> Maybe a
Just) s
s)
where fmof :: (p a (Const b b) -> p a (Const c b)) -> p a b -> p a c
fmof l' :: p a (Const b b) -> p a (Const c b)
l' f :: p a b
f = Const c b -> c
forall a k (b :: k). Const a b -> a
getConst (Const c b -> c) -> p a (Const c b) -> p a c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. p a (Const b b) -> p a (Const c b)
l' (b -> Const b b
forall k a (b :: k). a -> Const a b
Const (b -> Const b b) -> p a b -> p a (Const b b)
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. p a b
f)
match :: Prism s t a b -> s -> Either t a
match :: Prism s t a b -> s -> Either t a
match k :: Prism s t a b
k = APrismVL s t a b
-> ((b -> t) -> (s -> Either t a) -> s -> Either t a)
-> s
-> Either t a
forall s t a b r.
APrismVL s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrismVL s t a b
Prism s t a b
k (((b -> t) -> (s -> Either t a) -> s -> Either t a)
-> s -> Either t a)
-> ((b -> t) -> (s -> Either t a) -> s -> Either t a)
-> s
-> Either t a
forall a b. (a -> b) -> a -> b
$ \_ _match :: s -> Either t a
_match -> s -> Either t a
_match
{-# INLINE match #-}
(#) :: (Tagged b (Identity b) -> Tagged t (Identity t)) -> b -> t
# :: (Tagged b (Identity b) -> Tagged t (Identity t)) -> b -> t
(#) = (Tagged b (Identity b) -> Tagged t (Identity t)) -> b -> t
forall b t.
(Tagged b (Identity b) -> Tagged t (Identity t)) -> b -> t
build
{-# INLINE (#) #-}
prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
prism bt :: b -> t
bt seta :: s -> Either t a
seta eta :: p a (f b)
eta = (s -> Either (f t) a)
-> (Either (f t) (f b) -> f t)
-> p (Either (f t) a) (Either (f t) (f b))
-> p s (f t)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (\x :: s
x -> (t -> f t) -> (a -> a) -> Either t a -> Either (f t) a
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
plus t -> f t
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id (s -> Either t a
seta s
x)) ((f t -> f t) -> (f b -> f t) -> Either (f t) (f b) -> f t
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either f t -> f t
forall a. a -> a
id (\x :: f b
x -> (b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> t
bt f b
x)) (p a (f b) -> p (Either (f t) a) (Either (f t) (f b))
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right' p a (f b)
eta)
{-# INLINE prism #-}
prismRavel :: (Market a b a b -> Market a b s t) -> Prism s t a b
prismRavel :: (Market a b a b -> Market a b s t) -> Prism s t a b
prismRavel l :: Market a b a b -> Market a b s t
l pab :: p a (f b)
pab = (Market a b s t -> Prism s t a b
forall a b s t. Market a b s t -> Prism s t a b
prism2prismvl (Market a b s t -> Prism s t a b)
-> Market a b s t -> Prism s t a b
forall a b. (a -> b) -> a -> b
$ Market a b a b -> Market a b s t
l Market a b a b
forall a b. Market a b a b
idPrism) p a (f b)
pab
{-# INLINE prismRavel #-}
type APrismVL s t a b = Market a b a (Identity b) -> Market a b s (Identity t)
withPrism :: APrismVL s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism :: APrismVL s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism k :: APrismVL s t a b
k f :: (b -> t) -> (s -> Either t a) -> r
f = case Market a b s (Identity t) -> Market a b s t
forall a b. Coercible a b => a -> b
coerce (APrismVL s t a b
k ((b -> Identity b)
-> (a -> Either (Identity b) a) -> Market a b a (Identity b)
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market b -> Identity b
forall a. a -> Identity a
Identity a -> Either (Identity b) a
forall a b. b -> Either a b
Right)) of
Market bt :: b -> t
bt seta :: s -> Either t a
seta -> (b -> t) -> (s -> Either t a) -> r
f b -> t
bt s -> Either t a
seta
prism2prismvl :: Market a b s t -> Prism s t a b
prism2prismvl :: Market a b s t -> Prism s t a b
prism2prismvl (Market bt :: b -> t
bt seta :: s -> Either t a
seta) = (b -> t) -> (s -> Either t a) -> Prism s t a b
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> t
bt s -> Either t a
seta
{-# INLINE prism2prismvl #-}
build :: (Tagged b (Identity b) -> Tagged t (Identity t)) -> b -> t
build :: (Tagged b (Identity b) -> Tagged t (Identity t)) -> b -> t
build p :: Tagged b (Identity b) -> Tagged t (Identity t)
p = Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t)
-> (Tagged b (Identity b) -> Identity t)
-> Tagged b (Identity b)
-> t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Tagged t (Identity t) -> Identity t
forall k (s :: k) b. Tagged s b -> b
unTagged (Tagged t (Identity t) -> Identity t)
-> (Tagged b (Identity b) -> Tagged t (Identity t))
-> Tagged b (Identity b)
-> Identity t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Tagged b (Identity b) -> Tagged t (Identity t)
p (Tagged b (Identity b) -> t)
-> (Identity b -> Tagged b (Identity b)) -> Identity b -> t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# Identity b -> Tagged b (Identity b)
forall k (s :: k) b. b -> Tagged s b
Tagged (Identity b -> t) -> (b -> Identity b) -> b -> t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# b -> Identity b
forall a. a -> Identity a
Identity
{-# INLINE build #-}