{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE GADTs                     #-}
{-# LANGUAGE LambdaCase                #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE Rank2Types                #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE TypeFamilyDependencies    #-}
{-# LANGUAGE TypeOperators             #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Generics.Internal.Profunctor.Prism
-- Copyright   :  (C) 2020 Csongor Kiss
-- License     :  BSD3
-- Maintainer  :  Csongor Kiss <kiss.csongor.kiss@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Internal lens helpers. Only exported for Haddock
--
-----------------------------------------------------------------------------
module Data.Generics.Internal.Profunctor.Prism where

import Data.Profunctor.Indexed
import GHC.Generics

type APrism i s t a b = Market a b i a b -> Market a b i s t

type Prism s t a b
  = forall p i . (Choice p) => p i a b -> p i s t

type Prism' s a = forall p i . (Choice p) => p i a a -> p i s s

left :: Prism ((a :+: c) x) ((b :+: c) x) (a x) (b x)
left :: p i (a x) (b x) -> p i ((:+:) a c x) ((:+:) b c x)
left = (b x -> (:+:) b c x)
-> ((:+:) a c x -> Either ((:+:) b c x) (a x))
-> Prism ((:+:) a c x) ((:+:) b c x) (a x) (b x)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b x -> (:+:) b c x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (((:+:) a c x -> Either ((:+:) b c x) (a x))
 -> Prism ((:+:) a c x) ((:+:) b c x) (a x) (b x))
-> ((:+:) a c x -> Either ((:+:) b c x) (a x))
-> Prism ((:+:) a c x) ((:+:) b c x) (a x) (b x)
forall a b. (a -> b) -> a -> b
$ (a x -> Either ((:+:) b c x) (a x))
-> (c x -> Either ((:+:) b c x) (a x))
-> (:+:) a c x
-> Either ((:+:) b c x) (a x)
forall (a :: * -> *) x c (b :: * -> *).
(a x -> c) -> (b x -> c) -> (:+:) a b x -> c
gsum a x -> Either ((:+:) b c x) (a x)
forall a b. b -> Either a b
Right ((:+:) b c x -> Either ((:+:) b c x) (a x)
forall a b. a -> Either a b
Left ((:+:) b c x -> Either ((:+:) b c x) (a x))
-> (c x -> (:+:) b c x) -> c x -> Either ((:+:) b c x) (a x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c x -> (:+:) b c x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1)

right :: Prism ((a :+: b) x) ((a :+: c) x) (b x) (c x)
right :: p i (b x) (c x) -> p i ((:+:) a b x) ((:+:) a c x)
right = (c x -> (:+:) a c x)
-> ((:+:) a b x -> Either ((:+:) a c x) (b x))
-> Prism ((:+:) a b x) ((:+:) a c x) (b x) (c x)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism c x -> (:+:) a c x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (((:+:) a b x -> Either ((:+:) a c x) (b x))
 -> Prism ((:+:) a b x) ((:+:) a c x) (b x) (c x))
-> ((:+:) a b x -> Either ((:+:) a c x) (b x))
-> Prism ((:+:) a b x) ((:+:) a c x) (b x) (c x)
forall a b. (a -> b) -> a -> b
$ (a x -> Either ((:+:) a c x) (b x))
-> (b x -> Either ((:+:) a c x) (b x))
-> (:+:) a b x
-> Either ((:+:) a c x) (b x)
forall (a :: * -> *) x c (b :: * -> *).
(a x -> c) -> (b x -> c) -> (:+:) a b x -> c
gsum ((:+:) a c x -> Either ((:+:) a c x) (b x)
forall a b. a -> Either a b
Left ((:+:) a c x -> Either ((:+:) a c x) (b x))
-> (a x -> (:+:) a c x) -> a x -> Either ((:+:) a c x) (b x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a x -> (:+:) a c x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1) b x -> Either ((:+:) a c x) (b x)
forall a b. b -> Either a b
Right

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 b -> t
bt s -> Either t a
seta p i a b
eta = (s -> Either t a)
-> (Either t b -> t) -> p i (Either t a) (Either t b) -> p i s t
forall (p :: * -> * -> * -> *) a b c d i.
Profunctor p =>
(a -> b) -> (c -> d) -> p i b c -> p i a d
dimap s -> Either t a
seta ((t -> t) -> (b -> t) -> Either t b -> t
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either t -> t
forall a. a -> a
id b -> t
bt) (p i a b -> p i (Either t a) (Either t b)
forall (p :: * -> * -> * -> *) i a b c.
Choice p =>
p i a b -> p i (Either c a) (Either c b)
right' p i a b
eta)

_Left :: Prism (Either a c) (Either b c) a b
_Left :: p i a b -> p i (Either a c) (Either b c)
_Left = p i a b -> p i (Either a c) (Either b c)
forall (p :: * -> * -> * -> *) i a b c.
Choice p =>
p i a b -> p i (Either a c) (Either b c)
left'

_Right :: Prism (Either c a) (Either c b) a b
_Right :: p i a b -> p i (Either c a) (Either c b)
_Right = p i a b -> p i (Either c a) (Either c b)
forall (p :: * -> * -> * -> *) i a b c.
Choice p =>
p i a b -> p i (Either c a) (Either c b)
right'

prismPRavel :: APrism i s t a b -> Prism s t a b
prismPRavel :: APrism i s t a b -> Prism s t a b
prismPRavel APrism i s t a b
l p i a b
pab = (Market a b i s t -> Prism s t a b
forall a b i s t. Market a b i s t -> Prism s t a b
prism2prismp (Market a b i s t -> Prism s t a b)
-> Market a b i s t -> Prism s t a b
forall a b. (a -> b) -> a -> b
$ APrism i s t a b
l Market a b i a b
forall a b i. Market a b i a b
idPrism) p i a b
pab

build :: (Tagged i b b -> Tagged i t t) -> b -> t
build :: (Tagged i b b -> Tagged i t t) -> b -> t
build Tagged i b b -> Tagged i t t
p = Tagged i t t -> t
forall i a b. Tagged i a b -> b
unTagged (Tagged i t t -> t)
-> (Tagged i b b -> Tagged i t t) -> Tagged i b b -> t
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. Tagged i b b -> Tagged i t t
p (Tagged i b b -> t) -> (b -> Tagged i b b) -> b -> t
forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# b -> Tagged i b b
forall i a b. b -> Tagged i a b
Tagged

match :: Prism s t a b -> s -> Either t a
match :: Prism s t a b -> s -> Either t a
match Prism s t a b
k = APrism Any s t a b
-> ((b -> t) -> (s -> Either t a) -> s -> Either t a)
-> s
-> Either t a
forall i s t a b r.
APrism i s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism Any 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
$ \b -> t
_ s -> Either t a
_match -> s -> Either t a
_match

--------------------------------------------------------------------------------
-- Prism stuff

without' :: Prism s t a b -> Prism s t c d -> Prism s t (Either a c) (Either b d)
without' :: Prism s t a b
-> Prism s t c d -> Prism s t (Either a c) (Either b d)
without' Prism s t a b
k Prism s t c d
k' =
  APrism Any s t a b
-> ((b -> t)
    -> (s -> Either t a) -> p i (Either a c) (Either b d) -> p i s t)
-> p i (Either a c) (Either b d)
-> p i s t
forall i s t a b r.
APrism i s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism Any s t a b
Prism s t a b
k  (((b -> t)
  -> (s -> Either t a) -> p i (Either a c) (Either b d) -> p i s t)
 -> p i (Either a c) (Either b d) -> p i s t)
-> ((b -> t)
    -> (s -> Either t a) -> p i (Either a c) (Either b d) -> p i s t)
-> p i (Either a c) (Either b d)
-> p i s t
forall a b. (a -> b) -> a -> b
$ \b -> t
bt s -> Either t a
_ ->
  APrism Any s t c d
-> ((d -> t)
    -> (s -> Either t c) -> p i (Either a c) (Either b d) -> p i s t)
-> p i (Either a c) (Either b d)
-> p i s t
forall i s t a b r.
APrism i s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism Any s t c d
Prism s t c d
k' (((d -> t)
  -> (s -> Either t c) -> p i (Either a c) (Either b d) -> p i s t)
 -> p i (Either a c) (Either b d) -> p i s t)
-> ((d -> t)
    -> (s -> Either t c) -> p i (Either a c) (Either b d) -> p i s t)
-> p i (Either a c) (Either b d)
-> p i s t
forall a b. (a -> b) -> a -> b
$ \d -> t
dt s -> Either t c
setc ->
    (Either b d -> t)
-> (s -> Either t (Either a c))
-> Prism s t (Either a c) (Either b d)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((b -> t) -> (d -> t) -> Either b d -> t
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> t
bt d -> t
dt) ((s -> Either t (Either a c))
 -> Prism s t (Either a c) (Either b d))
-> (s -> Either t (Either a c))
-> Prism s t (Either a c) (Either b d)
forall a b. (a -> b) -> a -> b
$ \s
s -> (c -> Either a c) -> Either t c -> Either t (Either a c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> Either a c
forall a b. b -> Either a b
Right (s -> Either t c
setc s
s)
{-# INLINE without' #-}

withPrism :: APrism i s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism :: APrism i s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism i s t a b
k (b -> t) -> (s -> Either t a) -> r
f = case APrism i s t a b
k Market a b i a b
forall a b i. Market a b i a b
idPrism of
  Market b -> t
bt s -> Either t a
seta -> (b -> t) -> (s -> Either t a) -> r
f b -> t
bt s -> Either t a
seta

prism2prismp :: Market a b i s t -> Prism s t a b
prism2prismp :: Market a b i s t -> Prism s t a b
prism2prismp (Market b -> t
bt 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

idPrism :: Market a b i a b
idPrism :: Market a b i a b
idPrism = (b -> b) -> (a -> Either b a) -> Market a b i a b
forall a b i s t. (b -> t) -> (s -> Either t a) -> Market a b i s t
Market b -> b
forall a. a -> a
id a -> Either b a
forall a b. b -> Either a b
Right

gsum :: (a x -> c) -> (b x -> c) -> ((a :+: b) x) -> c
gsum :: (a x -> c) -> (b x -> c) -> (:+:) a b x -> c
gsum a x -> c
f b x -> c
_ (L1 a x
x) =  a x -> c
f a x
x
gsum a x -> c
_ b x -> c
g (R1 b x
y) =  b x -> c
g b x
y