{-# 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) 2019 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.Bifunctor         (bimap)
import Data.Profunctor        (Choice(..), Profunctor(..))
import Data.Tagged
import Data.Profunctor.Unsafe ((#.), (.#))
import GHC.Generics
import Data.Coerce

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

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

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

left :: Prism ((a :+: c) x) ((b :+: c) x) (a x) (b x)
left :: p (a x) (b x) -> p ((:+:) 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))
 -> p (a x) (b x) -> p ((:+:) a c x) ((:+:) b c x))
-> ((:+:) a c x -> Either ((:+:) b c x) (a x))
-> p (a x) (b x)
-> p ((:+:) a c x) ((:+:) b c 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 (b x) (c x) -> p ((:+:) 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))
 -> p (b x) (c x) -> p ((:+:) a b x) ((:+:) a c x))
-> ((:+:) a b x -> Either ((:+:) a c x) (b x))
-> p (b x) (c x)
-> p ((:+:) a b x) ((:+:) a 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 bt :: b -> t
bt seta :: s -> Either t a
seta eta :: p a b
eta = (s -> Either t a)
-> (Either t b -> t) -> p (Either t a) (Either t b) -> p s t
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p 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 a b -> p (Either t a) (Either t b)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right' p a b
eta)

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

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

prismPRavel :: APrism s t a b -> Prism s t a b
prismPRavel :: APrism s t a b -> Prism s t a b
prismPRavel l :: APrism s t a b
l pab :: p a 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
prism2prismp (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
$ APrism s t a b
l Market a b a b
forall a b. Market a b a b
idPrism) p a b
pab

build :: (Tagged b b -> Tagged t t) -> b -> t
build :: (Tagged b b -> Tagged t t) -> b -> t
build p :: Tagged b b -> Tagged t t
p = Tagged t t -> t
forall k (s :: k) b. Tagged s b -> b
unTagged (Tagged t t -> t) -> (Tagged b b -> Tagged t t) -> Tagged b b -> t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Tagged b b -> Tagged t t
p (Tagged b b -> t) -> (b -> Tagged b b) -> b -> t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# b -> Tagged b b
forall k (s :: k) b. b -> Tagged s b
Tagged

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 = APrism s t a b
-> ((b -> t) -> (s -> Either t a) -> s -> Either t a)
-> s
-> Either t a
forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism 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

--------------------------------------------------------------------------------
-- 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' k :: Prism s t a b
k =
  APrism s t a b
-> ((b -> t)
    -> (s -> Either t a)
    -> APrism s t c d
    -> p (Either a c) (Either b d)
    -> p s t)
-> APrism s t c d
-> p (Either a c) (Either b d)
-> p s t
forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism s t a b
Prism s t a b
k  (((b -> t)
  -> (s -> Either t a)
  -> APrism s t c d
  -> p (Either a c) (Either b d)
  -> p s t)
 -> Prism s t c d -> p (Either a c) (Either b d) -> p s t)
-> ((b -> t)
    -> (s -> Either t a)
    -> APrism s t c d
    -> p (Either a c) (Either b d)
    -> p s t)
-> Prism s t c d
-> p (Either a c) (Either b d)
-> p s t
forall a b. (a -> b) -> a -> b
$ \bt :: b -> t
bt _ k' :: APrism s t c d
k' ->
  APrism s t c d
-> ((d -> t)
    -> (s -> Either t c) -> p (Either a c) (Either b d) -> p s t)
-> p (Either a c) (Either b d)
-> p s t
forall s t a b r.
APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism APrism s t c d
k' (((d -> t)
  -> (s -> Either t c) -> p (Either a c) (Either b d) -> p s t)
 -> p (Either a c) (Either b d) -> p s t)
-> ((d -> t)
    -> (s -> Either t c) -> p (Either a c) (Either b d) -> p s t)
-> p (Either a c) (Either b d)
-> p s t
forall a b. (a -> b) -> a -> b
$ \dt :: d -> t
dt setc :: 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))
 -> p (Either a c) (Either b d) -> p s t)
-> (s -> Either t (Either a c))
-> p (Either a c) (Either b d)
-> p s t
forall a b. (a -> b) -> a -> b
$ \s :: 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 s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism :: APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism k :: APrism s t a b
k f :: (b -> t) -> (s -> Either t a) -> r
f = case APrism s t a b
k Market a b a b
forall a b. Market a b a b
idPrism 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

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

idPrism :: Market a b a b
idPrism :: Market a b a b
idPrism = (b -> b) -> (a -> Either b a) -> Market a b a b
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b 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 f :: a x -> c
f _ (L1 x :: a x
x) =  a x -> c
f a x
x
gsum _ g :: b x -> c
g (R1 y :: b x
y) =  b x -> c
g b x
y

plus :: (a -> b) -> (c -> d) -> Either a c -> Either b d
plus :: (a -> b) -> (c -> d) -> Either a c -> Either b d
plus = (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap

--------------------------------------------------------------------------------
-- Market

data Market a b s t = Market (b -> t) (s -> Either t a)

instance Functor (Market a b s) where
  fmap :: (a -> b) -> Market a b s a -> Market a b s b
fmap f :: a -> b
f (Market bt :: b -> a
bt seta :: s -> Either a a
seta) = (b -> b) -> (s -> Either b a) -> Market a b s b
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market (a -> b
f (a -> b) -> (b -> a) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
bt) ((a -> Either b a) -> (a -> Either b a) -> Either a a -> Either b a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (b -> Either b a
forall a b. a -> Either a b
Left (b -> Either b a) -> (a -> b) -> a -> Either b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) a -> Either b a
forall a b. b -> Either a b
Right (Either a a -> Either b a) -> (s -> Either a a) -> s -> Either b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Either a a
seta)
  {-# INLINE fmap #-}

instance Profunctor (Market a b) where
  dimap :: (a -> b) -> (c -> d) -> Market a b b c -> Market a b a d
dimap f :: a -> b
f g :: c -> d
g (Market bt :: b -> c
bt seta :: b -> Either c a
seta) = (b -> d) -> (a -> Either d a) -> Market a b a d
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market (c -> d
g (c -> d) -> (b -> c) -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
bt) ((c -> Either d a) -> (a -> Either d a) -> Either c a -> Either d a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (d -> Either d a
forall a b. a -> Either a b
Left (d -> Either d a) -> (c -> d) -> c -> Either d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
g) a -> Either d a
forall a b. b -> Either a b
Right (Either c a -> Either d a) -> (a -> Either c a) -> a -> Either d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either c a
seta (b -> Either c a) -> (a -> b) -> a -> Either c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  {-# INLINE dimap #-}
  lmap :: (a -> b) -> Market a b b c -> Market a b a c
lmap f :: a -> b
f (Market bt :: b -> c
bt seta :: b -> Either c a
seta) = (b -> c) -> (a -> Either c a) -> Market a b a c
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market b -> c
bt (b -> Either c a
seta (b -> Either c a) -> (a -> b) -> a -> Either c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  {-# INLINE lmap #-}
  rmap :: (b -> c) -> Market a b a b -> Market a b a c
rmap f :: b -> c
f (Market bt :: b -> b
bt seta :: a -> Either b a
seta) = (b -> c) -> (a -> Either c a) -> Market a b a c
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market (b -> c
f (b -> c) -> (b -> b) -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
bt) ((b -> Either c a) -> (a -> Either c a) -> Either b a -> Either c a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (c -> Either c a
forall a b. a -> Either a b
Left (c -> Either c a) -> (b -> c) -> b -> Either c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
f) a -> Either c a
forall a b. b -> Either a b
Right (Either b a -> Either c a) -> (a -> Either b a) -> a -> Either c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b a
seta)
  {-# INLINE rmap #-}
  ( #. ) _ = Market a b a b -> Market a b a c
forall a b. Coercible a b => a -> b
coerce
  {-# INLINE ( #. ) #-}
  ( .# ) p :: Market a b b c
p _ = Market a b b c -> Market a b a c
forall a b. Coercible a b => a -> b
coerce Market a b b c
p
  {-# INLINE ( .# ) #-}

instance Choice (Market a b) where
  left' :: Market a b a b -> Market a b (Either a c) (Either b c)
left' (Market bt :: b -> b
bt seta :: a -> Either b a
seta) = (b -> Either b c)
-> (Either a c -> Either (Either b c) a)
-> Market a b (Either a c) (Either b c)
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market (b -> Either b c
forall a b. a -> Either a b
Left (b -> Either b c) -> (b -> b) -> b -> Either b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
bt) ((Either a c -> Either (Either b c) a)
 -> Market a b (Either a c) (Either b c))
-> (Either a c -> Either (Either b c) a)
-> Market a b (Either a c) (Either b c)
forall a b. (a -> b) -> a -> b
$ \case
    Left s :: a
s -> case a -> Either b a
seta a
s of
      Left t :: b
t -> Either b c -> Either (Either b c) a
forall a b. a -> Either a b
Left (b -> Either b c
forall a b. a -> Either a b
Left b
t)
      Right a :: a
a -> a -> Either (Either b c) a
forall a b. b -> Either a b
Right a
a
    Right c :: c
c -> Either b c -> Either (Either b c) a
forall a b. a -> Either a b
Left (c -> Either b c
forall a b. b -> Either a b
Right c
c)
  {-# INLINE left' #-}