1-- | EXPERIMENTAL 2module Optics.View where 3 4import Control.Monad.Reader.Class 5import Control.Monad.State 6import Control.Monad.Writer 7import Data.Kind 8 9import Optics.Core 10 11-- | Generalized view (even more powerful than @view@ from the lens library). 12-- 13-- View the value(s) pointed to by an optic. 14-- 15-- The type of the result depends on the optic. You get: 16-- 17-- * Exactly one result @a@ with 'Iso', 'Lens', 'ReversedPrism' and 18-- 'Getter'. 19-- 20-- * At most one result @Maybe a@ with 'Prism', 'AffineTraversal' and 21-- 'AffineFold'. 22-- 23-- * Monoidal summary of all results @Monoid a => a@ with 'Traversal' 24-- and 'Fold'. 25-- 26-- When in doubt, use specific, flavour restricted versions. This function is 27-- mostly useful for things such as 'Optics.Passthrough.passthrough'. 28-- 29class ViewableOptic k r where 30 type ViewResult k r :: Type 31 gview 32 :: MonadReader s m 33 => Optic' k is s r 34 -> m (ViewResult k r) 35 gviews 36 :: MonadReader s m 37 => Optic' k is s a 38 -> (a -> r) 39 -> m (ViewResult k r) 40 41instance ViewableOptic An_Iso r where 42 type ViewResult An_Iso r = r 43 gview = asks . view 44 gviews o = asks . views o 45 {-# INLINE gview #-} 46 {-# INLINE gviews #-} 47 48instance ViewableOptic A_Lens r where 49 type ViewResult A_Lens r = r 50 gview = asks . view 51 gviews o = asks . views o 52 {-# INLINE gview #-} 53 {-# INLINE gviews #-} 54 55instance ViewableOptic A_ReversedPrism r where 56 type ViewResult A_ReversedPrism r = r 57 gview = asks . view 58 gviews o = asks . views o 59 {-# INLINE gview #-} 60 {-# INLINE gviews #-} 61 62instance ViewableOptic A_Getter r where 63 type ViewResult A_Getter r = r 64 gview = asks . view 65 gviews o = asks . views o 66 {-# INLINE gview #-} 67 {-# INLINE gviews #-} 68 69instance ViewableOptic A_Prism r where 70 type ViewResult A_Prism r = Maybe r 71 gview = asks . preview 72 gviews o = asks . previews o 73 {-# INLINE gview #-} 74 {-# INLINE gviews #-} 75 76instance ViewableOptic An_AffineTraversal r where 77 type ViewResult An_AffineTraversal r = Maybe r 78 gview = asks . preview 79 gviews o = asks . previews o 80 {-# INLINE gview #-} 81 {-# INLINE gviews #-} 82 83instance ViewableOptic An_AffineFold r where 84 type ViewResult An_AffineFold r = Maybe r 85 gview = asks . preview 86 gviews o = asks . previews o 87 {-# INLINE gview #-} 88 {-# INLINE gviews #-} 89 90instance Monoid r => ViewableOptic A_Traversal r where 91 type ViewResult A_Traversal r = r 92 gview = asks . foldOf 93 gviews o = asks . foldMapOf o 94 {-# INLINE gview #-} 95 {-# INLINE gviews #-} 96 97instance Monoid r => ViewableOptic A_Fold r where 98 type ViewResult A_Fold r = r 99 gview = asks . foldOf 100 gviews o = asks . foldMapOf o 101 {-# INLINE gview #-} 102 {-# INLINE gviews #-} 103 104-- | Use the target of a 'Lens', 'Iso', or 'Getter' in the current state, or use 105-- a summary of a 'Fold' or 'Traversal' that points to a monoidal value. 106-- 107-- >>> evalState (guse _1) ('a','b') 108-- 'a' 109-- 110-- >>> evalState (guse _2) ("hello","world") 111-- "world" 112-- 113-- @since 0.2 114guse 115 :: (ViewableOptic k a, MonadState s m) 116 => Optic' k is s a 117 -> m (ViewResult k a) 118guse o = gets (gview o) 119{-# INLINE guse #-} 120 121-- | Use the target of a 'Lens', 'Iso' or 'Getter' in the current state, or use 122-- a summary of a 'Fold' or 'Traversal' that points to a monoidal value. 123-- 124-- >>> evalState (guses _1 length) ("hello","world") 125-- 5 126-- 127-- @since 0.2 128guses 129 :: (ViewableOptic k r, MonadState s m) 130 => Optic' k is s a 131 -> (a -> r) 132 -> m (ViewResult k r) 133guses o f = gets (gviews o f) 134{-# INLINE guses #-} 135 136-- | This is a generalized form of 'listen' that only extracts the portion of 137-- the log that is focused on by a 'Getter'. If given a 'Fold' or a 'Traversal' 138-- then a monoidal summary of the parts of the log that are visited will be 139-- returned. 140-- 141-- @since 0.2 142glistening 143 :: (ViewableOptic k r, MonadWriter s m) 144 => Optic' k is s r 145 -> m a 146 -> m (a, ViewResult k r) 147glistening o m = do 148 (a, w) <- listen m 149 return (a, gview o w) 150{-# INLINE glistening #-} 151 152-- | This is a generalized form of 'listen' that only extracts the portion of 153-- the log that is focused on by a 'Getter'. If given a 'Fold' or a 'Traversal' 154-- then a monoidal summary of the parts of the log that are visited will be 155-- returned. 156-- 157-- @since 0.2 158glistenings 159 :: (ViewableOptic k r, MonadWriter s m) 160 => Optic' k is s a 161 -> (a -> r) 162 -> m b 163 -> m (b, ViewResult k r) 164glistenings o f m = do 165 (a, w) <- listen m 166 return (a, gviews o f w) 167{-# INLINE glistenings #-} 168