-- | EXPERIMENTAL
module Optics.View where

import Control.Monad.Reader.Class
import Control.Monad.State
import Control.Monad.Writer
import Data.Kind

import Optics.Core

-- | Generalized view (even more powerful than @view@ from the lens library).
--
-- View the value(s) pointed to by an optic.
--
-- The type of the result depends on the optic. You get:
--
--   * Exactly one result @a@ with 'Iso', 'Lens', 'ReversedPrism' and
--   'Getter'.
--
--   * At most one result @Maybe a@ with 'Prism', 'AffineTraversal' and
--   'AffineFold'.
--
--   * Monoidal summary of all results @Monoid a => a@ with 'Traversal'
--   and 'Fold'.
--
-- When in doubt, use specific, flavour restricted versions. This function is
-- mostly useful for things such as 'Optics.Passthrough.passthrough'.
--
class ViewableOptic k r where
  type ViewResult k r :: Type
  gview
    :: MonadReader s m
    => Optic' k is s r
    -> m (ViewResult k r)
  gviews
    :: MonadReader s m
    => Optic' k is s a
    -> (a -> r)
    -> m (ViewResult k r)

instance ViewableOptic An_Iso r where
  type ViewResult An_Iso r = r
  gview :: Optic' An_Iso is s r -> m (ViewResult An_Iso r)
gview    = (s -> r) -> m r
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((s -> r) -> m r)
-> (Optic' An_Iso is s r -> s -> r) -> Optic' An_Iso is s r -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' An_Iso is s r -> s -> r
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view
  gviews :: Optic' An_Iso is s a -> (a -> r) -> m (ViewResult An_Iso r)
gviews Optic' An_Iso is s a
o = (s -> r) -> m r
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((s -> r) -> m r) -> ((a -> r) -> s -> r) -> (a -> r) -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' An_Iso is s a -> (a -> r) -> s -> r
forall k (is :: IxList) s a r.
Is k A_Getter =>
Optic' k is s a -> (a -> r) -> s -> r
views Optic' An_Iso is s a
o
  {-# INLINE gview #-}
  {-# INLINE gviews #-}

instance ViewableOptic A_Lens r where
  type ViewResult A_Lens r = r
  gview :: Optic' A_Lens is s r -> m (ViewResult A_Lens r)
gview    = (s -> r) -> m r
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((s -> r) -> m r)
-> (Optic' A_Lens is s r -> s -> r) -> Optic' A_Lens is s r -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Lens is s r -> s -> r
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view
  gviews :: Optic' A_Lens is s a -> (a -> r) -> m (ViewResult A_Lens r)
gviews Optic' A_Lens is s a
o = (s -> r) -> m r
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((s -> r) -> m r) -> ((a -> r) -> s -> r) -> (a -> r) -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Lens is s a -> (a -> r) -> s -> r
forall k (is :: IxList) s a r.
Is k A_Getter =>
Optic' k is s a -> (a -> r) -> s -> r
views Optic' A_Lens is s a
o
  {-# INLINE gview #-}
  {-# INLINE gviews #-}

instance ViewableOptic A_ReversedPrism r where
  type ViewResult A_ReversedPrism r = r
  gview :: Optic' A_ReversedPrism is s r -> m (ViewResult A_ReversedPrism r)
gview    = (s -> r) -> m r
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((s -> r) -> m r)
-> (Optic' A_ReversedPrism is s r -> s -> r)
-> Optic' A_ReversedPrism is s r
-> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_ReversedPrism is s r -> s -> r
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view
  gviews :: Optic' A_ReversedPrism is s a
-> (a -> r) -> m (ViewResult A_ReversedPrism r)
gviews Optic' A_ReversedPrism is s a
o = (s -> r) -> m r
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((s -> r) -> m r) -> ((a -> r) -> s -> r) -> (a -> r) -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_ReversedPrism is s a -> (a -> r) -> s -> r
forall k (is :: IxList) s a r.
Is k A_Getter =>
Optic' k is s a -> (a -> r) -> s -> r
views Optic' A_ReversedPrism is s a
o
  {-# INLINE gview #-}
  {-# INLINE gviews #-}

instance ViewableOptic A_Getter r where
  type ViewResult A_Getter r = r
  gview :: Optic' A_Getter is s r -> m (ViewResult A_Getter r)
gview    = (s -> r) -> m r
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((s -> r) -> m r)
-> (Optic' A_Getter is s r -> s -> r)
-> Optic' A_Getter is s r
-> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Getter is s r -> s -> r
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view
  gviews :: Optic' A_Getter is s a -> (a -> r) -> m (ViewResult A_Getter r)
gviews Optic' A_Getter is s a
o = (s -> r) -> m r
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((s -> r) -> m r) -> ((a -> r) -> s -> r) -> (a -> r) -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Getter is s a -> (a -> r) -> s -> r
forall k (is :: IxList) s a r.
Is k A_Getter =>
Optic' k is s a -> (a -> r) -> s -> r
views Optic' A_Getter is s a
o
  {-# INLINE gview #-}
  {-# INLINE gviews #-}

instance ViewableOptic A_Prism r where
  type ViewResult A_Prism r = Maybe r
  gview :: Optic' A_Prism is s r -> m (ViewResult A_Prism r)
gview    = (s -> Maybe r) -> m (Maybe r)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((s -> Maybe r) -> m (Maybe r))
-> (Optic' A_Prism is s r -> s -> Maybe r)
-> Optic' A_Prism is s r
-> m (Maybe r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Prism is s r -> s -> Maybe r
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview
  gviews :: Optic' A_Prism is s a -> (a -> r) -> m (ViewResult A_Prism r)
gviews Optic' A_Prism is s a
o = (s -> Maybe r) -> m (Maybe r)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((s -> Maybe r) -> m (Maybe r))
-> ((a -> r) -> s -> Maybe r) -> (a -> r) -> m (Maybe r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Prism is s a -> (a -> r) -> s -> Maybe r
forall k (is :: IxList) s a r.
Is k An_AffineFold =>
Optic' k is s a -> (a -> r) -> s -> Maybe r
previews Optic' A_Prism is s a
o
  {-# INLINE gview #-}
  {-# INLINE gviews #-}

instance ViewableOptic An_AffineTraversal r where
  type ViewResult An_AffineTraversal r = Maybe r
  gview :: Optic' An_AffineTraversal is s r
-> m (ViewResult An_AffineTraversal r)
gview    = (s -> Maybe r) -> m (Maybe r)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((s -> Maybe r) -> m (Maybe r))
-> (Optic' An_AffineTraversal is s r -> s -> Maybe r)
-> Optic' An_AffineTraversal is s r
-> m (Maybe r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' An_AffineTraversal is s r -> s -> Maybe r
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview
  gviews :: Optic' An_AffineTraversal is s a
-> (a -> r) -> m (ViewResult An_AffineTraversal r)
gviews Optic' An_AffineTraversal is s a
o = (s -> Maybe r) -> m (Maybe r)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((s -> Maybe r) -> m (Maybe r))
-> ((a -> r) -> s -> Maybe r) -> (a -> r) -> m (Maybe r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' An_AffineTraversal is s a -> (a -> r) -> s -> Maybe r
forall k (is :: IxList) s a r.
Is k An_AffineFold =>
Optic' k is s a -> (a -> r) -> s -> Maybe r
previews Optic' An_AffineTraversal is s a
o
  {-# INLINE gview #-}
  {-# INLINE gviews #-}

instance ViewableOptic An_AffineFold r where
  type ViewResult An_AffineFold r = Maybe r
  gview :: Optic' An_AffineFold is s r -> m (ViewResult An_AffineFold r)
gview    = (s -> Maybe r) -> m (Maybe r)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((s -> Maybe r) -> m (Maybe r))
-> (Optic' An_AffineFold is s r -> s -> Maybe r)
-> Optic' An_AffineFold is s r
-> m (Maybe r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' An_AffineFold is s r -> s -> Maybe r
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview
  gviews :: Optic' An_AffineFold is s a
-> (a -> r) -> m (ViewResult An_AffineFold r)
gviews Optic' An_AffineFold is s a
o = (s -> Maybe r) -> m (Maybe r)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((s -> Maybe r) -> m (Maybe r))
-> ((a -> r) -> s -> Maybe r) -> (a -> r) -> m (Maybe r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' An_AffineFold is s a -> (a -> r) -> s -> Maybe r
forall k (is :: IxList) s a r.
Is k An_AffineFold =>
Optic' k is s a -> (a -> r) -> s -> Maybe r
previews Optic' An_AffineFold is s a
o
  {-# INLINE gview #-}
  {-# INLINE gviews #-}

instance Monoid r => ViewableOptic A_Traversal r where
  type ViewResult A_Traversal r = r
  gview :: Optic' A_Traversal is s r -> m (ViewResult A_Traversal r)
gview    = (s -> r) -> m r
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((s -> r) -> m r)
-> (Optic' A_Traversal is s r -> s -> r)
-> Optic' A_Traversal is s r
-> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Traversal is s r -> s -> r
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf
  gviews :: Optic' A_Traversal is s a
-> (a -> r) -> m (ViewResult A_Traversal r)
gviews Optic' A_Traversal is s a
o = (s -> r) -> m r
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((s -> r) -> m r) -> ((a -> r) -> s -> r) -> (a -> r) -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Traversal is s a -> (a -> r) -> s -> r
forall k m (is :: IxList) s a.
(Is k A_Fold, Monoid m) =>
Optic' k is s a -> (a -> m) -> s -> m
foldMapOf Optic' A_Traversal is s a
o
  {-# INLINE gview #-}
  {-# INLINE gviews #-}

instance Monoid r => ViewableOptic A_Fold r where
  type ViewResult A_Fold r = r
  gview :: Optic' A_Fold is s r -> m (ViewResult A_Fold r)
gview    = (s -> r) -> m r
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((s -> r) -> m r)
-> (Optic' A_Fold is s r -> s -> r) -> Optic' A_Fold is s r -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Fold is s r -> s -> r
forall k a (is :: IxList) s.
(Is k A_Fold, Monoid a) =>
Optic' k is s a -> s -> a
foldOf
  gviews :: Optic' A_Fold is s a -> (a -> r) -> m (ViewResult A_Fold r)
gviews Optic' A_Fold is s a
o = (s -> r) -> m r
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((s -> r) -> m r) -> ((a -> r) -> s -> r) -> (a -> r) -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Fold is s a -> (a -> r) -> s -> r
forall k m (is :: IxList) s a.
(Is k A_Fold, Monoid m) =>
Optic' k is s a -> (a -> m) -> s -> m
foldMapOf Optic' A_Fold is s a
o
  {-# INLINE gview #-}
  {-# INLINE gviews #-}

-- | Use the target of a 'Lens', 'Iso', or 'Getter' in the current state, or use
-- a summary of a 'Fold' or 'Traversal' that points to a monoidal value.
--
-- >>> evalState (guse _1) ('a','b')
-- 'a'
--
-- >>> evalState (guse _2) ("hello","world")
-- "world"
--
-- @since 0.2
guse
  :: (ViewableOptic k a, MonadState s m)
  => Optic' k is s a
  -> m (ViewResult k a)
guse :: Optic' k is s a -> m (ViewResult k a)
guse Optic' k is s a
o = (s -> ViewResult k a) -> m (ViewResult k a)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Optic' k is s a -> s -> ViewResult k a
forall k r s (m :: * -> *) (is :: IxList).
(ViewableOptic k r, MonadReader s m) =>
Optic' k is s r -> m (ViewResult k r)
gview Optic' k is s a
o)
{-# INLINE guse #-}

-- | Use the target of a 'Lens', 'Iso' or 'Getter' in the current state, or use
-- a summary of a 'Fold' or 'Traversal' that points to a monoidal value.
--
-- >>> evalState (guses _1 length) ("hello","world")
-- 5
--
-- @since 0.2
guses
  :: (ViewableOptic k r, MonadState s m)
  => Optic' k is s a
  -> (a -> r)
  -> m (ViewResult k r)
guses :: Optic' k is s a -> (a -> r) -> m (ViewResult k r)
guses Optic' k is s a
o a -> r
f = (s -> ViewResult k r) -> m (ViewResult k r)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Optic' k is s a -> (a -> r) -> s -> ViewResult k r
forall k r s (m :: * -> *) (is :: IxList) a.
(ViewableOptic k r, MonadReader s m) =>
Optic' k is s a -> (a -> r) -> m (ViewResult k r)
gviews Optic' k is s a
o a -> r
f)
{-# INLINE guses #-}

-- | This is a generalized form of 'listen' that only extracts the portion of
-- the log that is focused on by a 'Getter'. If given a 'Fold' or a 'Traversal'
-- then a monoidal summary of the parts of the log that are visited will be
-- returned.
--
-- @since 0.2
glistening
  :: (ViewableOptic k r, MonadWriter s m)
  => Optic' k is s r
  -> m a
  -> m (a, ViewResult k r)
glistening :: Optic' k is s r -> m a -> m (a, ViewResult k r)
glistening Optic' k is s r
o m a
m = do
  (a
a, s
w) <- m a -> m (a, s)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen m a
m
  (a, ViewResult k r) -> m (a, ViewResult k r)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, Optic' k is s r -> s -> ViewResult k r
forall k r s (m :: * -> *) (is :: IxList).
(ViewableOptic k r, MonadReader s m) =>
Optic' k is s r -> m (ViewResult k r)
gview Optic' k is s r
o s
w)
{-# INLINE glistening #-}

-- | This is a generalized form of 'listen' that only extracts the portion of
-- the log that is focused on by a 'Getter'. If given a 'Fold' or a 'Traversal'
-- then a monoidal summary of the parts of the log that are visited will be
-- returned.
--
-- @since 0.2
glistenings
  :: (ViewableOptic k r, MonadWriter s m)
  => Optic' k is s a
  -> (a -> r)
  -> m b
  -> m (b, ViewResult k r)
glistenings :: Optic' k is s a -> (a -> r) -> m b -> m (b, ViewResult k r)
glistenings Optic' k is s a
o a -> r
f m b
m = do
  (b
a, s
w) <- m b -> m (b, s)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen m b
m
  (b, ViewResult k r) -> m (b, ViewResult k r)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
a, Optic' k is s a -> (a -> r) -> s -> ViewResult k r
forall k r s (m :: * -> *) (is :: IxList) a.
(ViewableOptic k r, MonadReader s m) =>
Optic' k is s a -> (a -> r) -> m (ViewResult k r)
gviews Optic' k is s a
o a -> r
f s
w)
{-# INLINE glistenings #-}