{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE Trustworthy #-}

{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-trustworthy-safe #-}
-------------------------------------------------------------------------------

-- |

-- Module      :  Control.Lens.Review

-- Copyright   :  (C) 2012-16 Edward Kmett

-- License     :  BSD-style (see the file LICENSE)

-- Maintainer  :  Edward Kmett <ekmett@gmail.com>

-- Stability   :  provisional

-- Portability :  non-portable

--

-- A 'Review' is a type-restricted form of a 'Prism' that can only be used for

-- writing back via 're', 'review', 'reuse'.

-------------------------------------------------------------------------------

module Control.Lens.Review
  (
  -- * Reviewing

    Review
  , AReview
  , unto
  , un
  , re
  , review, reviews
  , reuse, reuses
  , (#)
  , Bifunctor(bimap)
  , retagged
  , Reviewable
  , reviewing
  ) where

import Control.Monad.Reader as Reader
import Control.Monad.State as State
import Control.Lens.Getter
import Control.Lens.Internal.Review
import Control.Lens.Type
import Data.Bifunctor
import Data.Functor.Identity
import Data.Profunctor
import Data.Profunctor.Unsafe
import Data.Tagged
import Data.Void

-- $setup

-- >>> :set -XNoOverloadedStrings

-- >>> import Control.Lens

-- >>> import Control.Monad.State

-- >>> import Numeric.Lens

-- >>> import Data.Semigroup (Semigroup (..))

-- >>> let isLeft  (Left  _) = True; isLeft  _ = False

-- >>> let isRight (Right _) = True; isRight _ = False


infixr 8 #

------------------------------------------------------------------------------

-- Review

------------------------------------------------------------------------------


-- | An analogue of 'to' for 'review'.

--

-- @

-- 'unto' :: (b -> t) -> 'Review'' t b

-- @

--

-- @

-- 'unto' = 'un' . 'to'

-- @

unto :: (Profunctor p, Bifunctor p, Functor f) => (b -> t) -> Optic p f s t a b
unto :: forall (p :: * -> * -> *) (f :: * -> *) b t s a.
(Profunctor p, Bifunctor p, Functor f) =>
(b -> t) -> Optic p f s t a b
unto b -> t
f = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Void -> a
absurd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap forall a. Void -> a
absurd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> t
f)
{-# INLINE unto #-}

-- | Turn a 'Getter' around to get a 'Review'

--

-- @

-- 'un' = 'unto' . 'view'

-- 'unto' = 'un' . 'to'

-- @

--

-- >>> un (to length) # [1,2,3]

-- 3

un :: (Profunctor p, Bifunctor p, Functor f) => Getting a s a -> Optic' p f a s
un :: forall (p :: * -> * -> *) (f :: * -> *) a s.
(Profunctor p, Bifunctor p, Functor f) =>
Getting a s a -> Optic' p f a s
un = forall (p :: * -> * -> *) (f :: * -> *) b t s a.
(Profunctor p, Bifunctor p, Functor f) =>
(b -> t) -> Optic p f s t a b
unto forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view

-- | Turn a 'Prism' or 'Control.Lens.Iso.Iso' around to build a 'Getter'.

--

-- If you have an 'Control.Lens.Iso.Iso', 'Control.Lens.Iso.from' is a more powerful version of this function

-- that will return an 'Control.Lens.Iso.Iso' instead of a mere 'Getter'.

--

-- >>> 5 ^.re _Left

-- Left 5

--

-- >>> 6 ^.re (_Left.unto succ)

-- Left 7

--

-- @

-- 'review'  ≡ 'view'  '.' 're'

-- 'reviews' ≡ 'views' '.' 're'

-- 'reuse'   ≡ 'use'   '.' 're'

-- 'reuses'  ≡ 'uses'  '.' 're'

-- @

--

-- @

-- 're' :: 'Prism' s t a b -> 'Getter' b t

-- 're' :: 'Iso' s t a b   -> 'Getter' b t

-- @

re :: AReview t b -> Getter b t
re :: forall t b. AReview t b -> Getter b t
re AReview t b
p = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (forall a. Identity a -> a
runIdentity forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall {k} (s :: k) b. Tagged s b -> b
unTagged forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. AReview t b
p forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall {k} (s :: k) b. b -> Tagged s b
Tagged forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall a. a -> Identity a
Identity)
{-# INLINE re #-}

-- | This can be used to turn an 'Control.Lens.Iso.Iso' or 'Prism' around and 'view' a value (or the current environment) through it the other way.

--

-- @

-- 'review' ≡ 'view' '.' 're'

-- 'review' . 'unto' ≡ 'id'

-- @

--

-- >>> review _Left "mustard"

-- Left "mustard"

--

-- >>> review (unto succ) 5

-- 6

--

-- Usually 'review' is used in the @(->)@ 'Monad' with a 'Prism' or 'Control.Lens.Iso.Iso', in which case it may be useful to think of

-- it as having one of these more restricted type signatures:

--

-- @

-- 'review' :: 'Iso'' s a   -> a -> s

-- 'review' :: 'Prism'' s a -> a -> s

-- @

--

-- However, when working with a 'Monad' transformer stack, it is sometimes useful to be able to 'review' the current environment, in which case

-- it may be beneficial to think of it as having one of these slightly more liberal type signatures:

--

-- @

-- 'review' :: 'MonadReader' a m => 'Iso'' s a   -> m s

-- 'review' :: 'MonadReader' a m => 'Prism'' s a -> m s

-- @

review :: MonadReader b m => AReview t b -> m t
review :: forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview t b
p = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall a. Identity a -> a
runIdentity forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall {k} (s :: k) b. Tagged s b -> b
unTagged forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. AReview t b
p forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall {k} (s :: k) b. b -> Tagged s b
Tagged forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall a. a -> Identity a
Identity)
{-# INLINE review #-}

-- | An infix alias for 'review'.

--

-- @

-- 'unto' f # x ≡ f x

-- l # x ≡ x '^.' 're' l

-- @

--

-- This is commonly used when using a 'Prism' as a smart constructor.

--

-- >>> _Left # 4

-- Left 4

--

-- But it can be used for any 'Prism'

--

-- >>> base 16 # 123

-- "7b"

--

-- @

-- (#) :: 'Iso''      s a -> a -> s

-- (#) :: 'Prism''    s a -> a -> s

-- (#) :: 'Review'    s a -> a -> s

-- (#) :: 'Equality'' s a -> a -> s

-- @

(#) :: AReview t b -> b -> t
# :: forall t b. AReview t b -> b -> t
(#) AReview t b
p = forall a. Identity a -> a
runIdentity forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall {k} (s :: k) b. Tagged s b -> b
unTagged forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. AReview t b
p forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall {k} (s :: k) b. b -> Tagged s b
Tagged forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall a. a -> Identity a
Identity
{-# INLINE (#) #-}

-- | This can be used to turn an 'Control.Lens.Iso.Iso' or 'Prism' around and 'view' a value (or the current environment) through it the other way,

-- applying a function.

--

-- @

-- 'reviews' ≡ 'views' '.' 're'

-- 'reviews' ('unto' f) g ≡ g '.' f

-- @

--

-- >>> reviews _Left isRight "mustard"

-- False

--

-- >>> reviews (unto succ) (*2) 3

-- 8

--

-- Usually this function is used in the @(->)@ 'Monad' with a 'Prism' or 'Control.Lens.Iso.Iso', in which case it may be useful to think of

-- it as having one of these more restricted type signatures:

--

-- @

-- 'reviews' :: 'Iso'' s a   -> (s -> r) -> a -> r

-- 'reviews' :: 'Prism'' s a -> (s -> r) -> a -> r

-- @

--

-- However, when working with a 'Monad' transformer stack, it is sometimes useful to be able to 'review' the current environment, in which case

-- it may be beneficial to think of it as having one of these slightly more liberal type signatures:

--

-- @

-- 'reviews' :: 'MonadReader' a m => 'Iso'' s a   -> (s -> r) -> m r

-- 'reviews' :: 'MonadReader' a m => 'Prism'' s a -> (s -> r) -> m r

-- @

reviews :: MonadReader b m => AReview t b -> (t -> r) -> m r
reviews :: forall b (m :: * -> *) t r.
MonadReader b m =>
AReview t b -> (t -> r) -> m r
reviews AReview t b
p t -> r
tr = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (t -> r
tr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall {k} (s :: k) b. Tagged s b -> b
unTagged forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. AReview t b
p forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall {k} (s :: k) b. b -> Tagged s b
Tagged forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall a. a -> Identity a
Identity)
{-# INLINE reviews #-}

-- | This can be used to turn an 'Control.Lens.Iso.Iso' or 'Prism' around and 'use' a value (or the current environment) through it the other way.

--

-- @

-- 'reuse' ≡ 'use' '.' 're'

-- 'reuse' '.' 'unto' ≡ 'gets'

-- @

--

-- >>> evalState (reuse _Left) 5

-- Left 5

--

-- >>> evalState (reuse (unto succ)) 5

-- 6

--

-- @

-- 'reuse' :: 'MonadState' a m => 'Prism'' s a -> m s

-- 'reuse' :: 'MonadState' a m => 'Iso'' s a   -> m s

-- @

reuse :: MonadState b m => AReview t b -> m t
reuse :: forall b (m :: * -> *) t. MonadState b m => AReview t b -> m t
reuse AReview t b
p = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. Identity a -> a
runIdentity forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall {k} (s :: k) b. Tagged s b -> b
unTagged forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. AReview t b
p forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall {k} (s :: k) b. b -> Tagged s b
Tagged forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall a. a -> Identity a
Identity)
{-# INLINE reuse #-}

-- | This can be used to turn an 'Control.Lens.Iso.Iso' or 'Prism' around and 'use' the current state through it the other way,

-- applying a function.

--

-- @

-- 'reuses' ≡ 'uses' '.' 're'

-- 'reuses' ('unto' f) g ≡ 'gets' (g '.' f)

-- @

--

-- >>> evalState (reuses _Left isLeft) (5 :: Int)

-- True

--

-- @

-- 'reuses' :: 'MonadState' a m => 'Prism'' s a -> (s -> r) -> m r

-- 'reuses' :: 'MonadState' a m => 'Iso'' s a   -> (s -> r) -> m r

-- @

reuses :: MonadState b m => AReview t b -> (t -> r) -> m r
reuses :: forall b (m :: * -> *) t r.
MonadState b m =>
AReview t b -> (t -> r) -> m r
reuses AReview t b
p t -> r
tr = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (t -> r
tr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. forall {k} (s :: k) b. Tagged s b -> b
unTagged forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. AReview t b
p forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall {k} (s :: k) b. b -> Tagged s b
Tagged forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# forall a. a -> Identity a
Identity)
{-# INLINE reuses #-}

-- | Coerce a polymorphic 'Prism' to a 'Review'.

--

-- @

-- 'reviewing' :: 'Iso' s t a b -> 'Review' t b

-- 'reviewing' :: 'Prism' s t a b -> 'Review' t b

-- @

reviewing :: (Bifunctor p, Functor f) => Optic Tagged Identity s t a b -> Optic' p f t b
reviewing :: forall (p :: * -> * -> *) (f :: * -> *) s t a b.
(Bifunctor p, Functor f) =>
Optic Tagged Identity s t a b -> Optic' p f t b
reviewing Optic Tagged Identity s t a b
p = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap b -> t
f (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> t
f) where
  f :: b -> t
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (s :: k) b. Tagged s b -> b
unTagged forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic Tagged Identity s t a b
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (s :: k) b. b -> Tagged s b
Tagged forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Identity a
Identity