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

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Generics.Internal.VL.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.VL.Prism where

import qualified "generic-lens-core" Data.Generics.Internal.Profunctor.Prism as P

import qualified Data.Profunctor as P
import Data.Functor.Identity (Identity (..))
import Data.Coerce (coerce)

-- | Type alias for prism
type Prism s t a b
  = forall p f. (P.Choice p, Applicative f) => p a (f b) -> p s (f t)

type Prism' s a
  = Prism s s a a

match :: Prism s t a b -> s -> Either t a
match :: forall s t a b. Prism s t a b -> s -> Either t a
match Prism s t a b
p = case Prism s t a b
p (forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market forall a. a -> Identity a
Identity forall a b. b -> Either a b
Right) of
  Market b -> Identity t
_ s -> Either (Identity t) a
seta -> coerce :: forall a b. Coercible a b => a -> b
coerce s -> Either (Identity t) a
seta
{-# INLINE match #-}

build :: Prism s t a b -> b -> t
build :: forall s t a b. Prism s t a b -> b -> t
build Prism s t a b
p = case Prism s t a b
p (forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market forall a. a -> Identity a
Identity forall a b. b -> Either a b
Right) of
  Market b -> Identity t
bt s -> Either (Identity t) a
_ -> coerce :: forall a b. Coercible a b => a -> b
coerce b -> Identity t
bt
{-# INLINE build #-}

prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
prism :: 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 p a (f b)
eta = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap (\s
x -> forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either a c) (Either b c)
P.left' forall (f :: * -> *) a. Applicative f => a -> f a
pure (s -> Either t a
seta s
x)) (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id (\f b
x -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> t
bt f b
x)) (forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
P.right' p a (f b)
eta)
{-# INLINE prism #-}

prism2prismvl :: P.APrism i s t a b -> Prism s t a b
prism2prismvl :: forall i s t a b. APrism i s t a b -> Prism s t a b
prism2prismvl  APrism i s t a b
_prism = forall i s t a b r.
APrism i s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
P.withPrism APrism i s t a b
_prism forall a b. (a -> b) -> a -> b
$ \ b -> t
bt s -> Either t a
sta -> forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> t
bt s -> Either t a
sta
{-# INLINE prism2prismvl #-}

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

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

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

instance P.Profunctor (Market a b) where
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Market a b b c -> Market a b a d
dimap a -> b
f c -> d
g (Market b -> c
bt b -> Either c a
seta) = forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market (c -> d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
bt) (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
g) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either c a
seta forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  {-# INLINE dimap #-}
  lmap :: forall a b c. (a -> b) -> Market a b b c -> Market a b a c
lmap a -> b
f (Market b -> c
bt b -> Either c a
seta) = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  {-# INLINE lmap #-}
  rmap :: forall b c a. (b -> c) -> Market a b a b -> Market a b a c
rmap b -> c
f (Market b -> b
bt a -> Either b a
seta) = forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market (b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
bt) (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
f) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b a
seta)
  {-# INLINE rmap #-}

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