-- Copyright 2016 Google Inc. All Rights Reserved.
--
-- Use of this source code is governed by a BSD-style
-- license that can be found in the LICENSE file or at
-- https://developers.google.com/open-source/licenses/bsd

-- | This module defines the 'Prism' type and combinators. Used for building
--   'Prism's for oneof fields.
{-# LANGUAGE RankNTypes #-}

module Data.ProtoLens.Prism
    ( Prism
    , Prism'
    , AReview
    , (#)
    , prism
    , prism'
    , _Left
    , _Right
    , _Just
    , _Nothing
    ) where

import  Data.Tagged (Tagged (..))
import  Data.Functor.Identity (Identity (..))
import  Data.Profunctor (dimap)
import  Data.Profunctor.Choice
import  Data.Profunctor.Unsafe ((#.), (.#))


------------------------------------------------------------------------------
-- Prism Internals
------------------------------------------------------------------------------
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

type Optic p f s t a b = p a (f b) -> p s (f t)

type Optic' p f s a = Optic p f s s a a

type AReview t b = Optic' Tagged Identity t b

-- | Used for constructing 'Prism' values.
--
-- @'_Just' '#' 5 == 'Just' 5@
( # ) :: AReview t b -> b -> t
( # ) AReview t b
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 a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
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)
-> AReview t b -> Tagged b (Identity b) -> Identity t
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. AReview t b
p (Tagged b (Identity b) -> t)
-> (Identity b -> Tagged b (Identity b)) -> Identity b -> t
forall a b c (q :: * -> * -> *).
Coercible b a =>
(b -> c) -> q a b -> a -> c
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 a b c (q :: * -> * -> *).
Coercible b a =>
(b -> c) -> q a b -> a -> c
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
infixr 8 #


------------------------------------------------------------------------------
-- Prism Combinators
------------------------------------------------------------------------------

-- | Build a 'Control.Lens.Prism.Prism'.
--
-- @'Either' t a@ is used instead of @'Maybe' a@ to permit the types of @s@ and @t@ to differ.
--
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 = (s -> Either t a)
-> (Either t (f b) -> f t)
-> p (Either t a) (Either t (f b))
-> p s (f t)
forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
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 -> f t) -> (f b -> f t) -> Either t (f b) -> f t
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either t -> f t
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((b -> t) -> f b -> f t
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> t
bt)) (p (Either t a) (Either t (f b)) -> p s (f t))
-> (p a (f b) -> p (Either t a) (Either t (f b)))
-> p a (f b)
-> p s (f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f b) -> p (Either t a) (Either t (f b))
forall a b c. 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'
{-# INLINE prism #-}

-- | This is usually used to build a 'Prism'', when you have to use an operation like
-- 'Data.Typeable.cast' which already returns a 'Maybe'.
prism' :: (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' :: forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' b -> s
bs s -> Maybe a
sma = (b -> s) -> (s -> Either s a) -> Prism s s a b
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> s
bs (\s
s -> Either s a -> (a -> Either s a) -> Maybe a -> Either s a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (s -> Either s a
forall a b. a -> Either a b
Left s
s) a -> Either s a
forall a b. b -> Either a b
Right (s -> Maybe a
sma s
s))
{-# INLINE prism' #-}

_Left :: Prism (Either a c) (Either b c) a b
_Left :: forall a c b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Either a c) (f (Either b c))
_Left = (b -> Either b c)
-> (Either a c -> Either (Either b c) a)
-> forall {p :: * -> * -> *} {f :: * -> *}.
   (Choice p, Applicative f) =>
   p a (f b) -> p (Either a c) (f (Either b c))
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> Either b c
forall a b. a -> Either a b
Left ((Either a c -> Either (Either b c) a)
 -> forall {p :: * -> * -> *} {f :: * -> *}.
    (Choice p, Applicative f) =>
    p a (f b) -> p (Either a c) (f (Either b c)))
-> (Either a c -> Either (Either b c) a)
-> forall {p :: * -> * -> *} {f :: * -> *}.
   (Choice p, Applicative f) =>
   p a (f b) -> p (Either a c) (f (Either b c))
forall a b. (a -> b) -> a -> b
$ (a -> Either (Either b c) a)
-> (c -> Either (Either b c) a)
-> Either a c
-> Either (Either b c) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Either (Either b c) a
forall a b. b -> Either a b
Right (Either b c -> Either (Either b c) a
forall a b. a -> Either a b
Left (Either b c -> Either (Either b c) a)
-> (c -> Either b c) -> c -> Either (Either b c) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either b c
forall a b. b -> Either a b
Right)

_Right :: Prism (Either c a) (Either c b) a b
_Right :: forall c a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Either c a) (f (Either c b))
_Right = (b -> Either c b)
-> (Either c a -> Either (Either c b) a)
-> forall {p :: * -> * -> *} {f :: * -> *}.
   (Choice p, Applicative f) =>
   p a (f b) -> p (Either c a) (f (Either c b))
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> Either c b
forall a b. b -> Either a b
Right ((Either c a -> Either (Either c b) a)
 -> forall {p :: * -> * -> *} {f :: * -> *}.
    (Choice p, Applicative f) =>
    p a (f b) -> p (Either c a) (f (Either c b)))
-> (Either c a -> Either (Either c b) a)
-> forall {p :: * -> * -> *} {f :: * -> *}.
   (Choice p, Applicative f) =>
   p a (f b) -> p (Either c a) (f (Either c b))
forall a b. (a -> b) -> a -> b
$ (c -> Either (Either c b) a)
-> (a -> Either (Either c b) a)
-> Either c a
-> Either (Either c b) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either c b -> Either (Either c b) a
forall a b. a -> Either a b
Left (Either c b -> Either (Either c b) a)
-> (c -> Either c b) -> c -> Either (Either c b) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either c b
forall a b. a -> Either a b
Left) a -> Either (Either c b) a
forall a b. b -> Either a b
Right

_Just :: Prism (Maybe a) (Maybe b) a b
_Just :: forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just = (b -> Maybe b)
-> (Maybe a -> Either (Maybe b) a)
-> forall {p :: * -> * -> *} {f :: * -> *}.
   (Choice p, Applicative f) =>
   p a (f b) -> p (Maybe a) (f (Maybe b))
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> Maybe b
forall a. a -> Maybe a
Just ((Maybe a -> Either (Maybe b) a)
 -> forall {p :: * -> * -> *} {f :: * -> *}.
    (Choice p, Applicative f) =>
    p a (f b) -> p (Maybe a) (f (Maybe b)))
-> (Maybe a -> Either (Maybe b) a)
-> forall {p :: * -> * -> *} {f :: * -> *}.
   (Choice p, Applicative f) =>
   p a (f b) -> p (Maybe a) (f (Maybe b))
forall a b. (a -> b) -> a -> b
$ Either (Maybe b) a
-> (a -> Either (Maybe b) a) -> Maybe a -> Either (Maybe b) a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe b -> Either (Maybe b) a
forall a b. a -> Either a b
Left Maybe b
forall a. Maybe a
Nothing) a -> Either (Maybe b) a
forall a b. b -> Either a b
Right

_Nothing :: Prism' (Maybe a) ()
_Nothing :: forall a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p () (f ()) -> p (Maybe a) (f (Maybe a))
_Nothing = (() -> Maybe a)
-> (Maybe a -> Maybe ())
-> forall {p :: * -> * -> *} {f :: * -> *}.
   (Choice p, Applicative f) =>
   p () (f ()) -> p (Maybe a) (f (Maybe a))
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (Maybe a -> () -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) ((Maybe a -> Maybe ())
 -> forall {p :: * -> * -> *} {f :: * -> *}.
    (Choice p, Applicative f) =>
    p () (f ()) -> p (Maybe a) (f (Maybe a)))
-> (Maybe a -> Maybe ())
-> forall {p :: * -> * -> *} {f :: * -> *}.
   (Choice p, Applicative f) =>
   p () (f ()) -> p (Maybe a) (f (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe () -> (a -> Maybe ()) -> Maybe a -> Maybe ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Maybe ()
forall a. a -> Maybe a
Just ()) (Maybe () -> a -> Maybe ()
forall a b. a -> b -> a
const Maybe ()
forall a. Maybe a
Nothing)