packages feed

optics-core 0.1 → 0.2

raw patch · 45 files changed

+376/−1001 lines, 45 filesdep +indexed-profunctors

Dependencies added: indexed-profunctors

Files

+ CHANGELOG.md view
@@ -0,0 +1,11 @@+# optics-core-0.2 (2019-10-18)+* Add `non`, `non'` and `anon` to `Optics.Iso`+* `ix` can produce optic kinds other than `AffineTraversal`+* Generalise type of `generic1`+* Move some internal definitions out to new `indexed-profunctors` package+* Introduce `OpticKind` and `IxList` type synonyms for better type inference+* Make `itraverse` for `Seq` faster for `containers >= 0.6.0`+* Assorted documentation improvements++# optics-core-0.1 (2019-09-02)+* Initial release
optics-core.cabal view
@@ -1,5 +1,5 @@ name:          optics-core-version:       0.1+version:       0.2 license:       BSD3 license-file:  LICENSE build-type:    Simple@@ -14,11 +14,12 @@   and other optics, using an abstract interface.   .   This variant provides core definitions with a minimal dependency footprint.-  See the @optics@ package (and its dependencies) for documentation and the-  "batteries-included" variant.+  See the @<https://hackage.haskell.org/package/optics optics>@ package (and its+  dependencies) for documentation and the "batteries-included" variant.  extra-doc-files:   diagrams/*.png+  CHANGELOG.md  bug-reports:   https://github.com/well-typed/optics/issues source-repository head@@ -34,6 +35,7 @@   build-depends: base                   >= 4.9        && <5                , array                  >= 0.5.1.1    && <0.6                , containers             >= 0.5.7.1    && <0.7+               , indexed-profunctors    >= 0.1        && <0.2                , transformers           >= 0.5        && <0.6    exposed-modules: Optics.Core@@ -92,7 +94,6 @@                     -- internal modules                    Optics.Internal.Bi-                   Optics.Internal.Concrete                    Optics.Internal.Fold                    Optics.Internal.Indexed                    Optics.Internal.IxFold@@ -102,9 +103,7 @@                    Optics.Internal.Optic.Subtyping                    Optics.Internal.Optic.TypeLevel                    Optics.Internal.Optic.Types-                   Optics.Internal.Profunctor                    Optics.Internal.Setter-                   Optics.Internal.Tagged                    Optics.Internal.Traversal                    Optics.Internal.Utils
src/Data/IntMap/Optics.hs view
@@ -11,7 +11,7 @@ -- >>> IntMap.empty & at 0 .~ Just "hello" -- fromList [(0,"hello")] ----- We can traverse, fold over, and map over key-value pairs in a 'IntMap',+-- We can traverse, fold over, and map over key-value pairs in an 'IntMap', -- thanks to indexed traversals, folds and setters. -- -- >>> iover imapped const $ IntMap.fromList [(1, "Venus")]
src/GHC/Generics/Optics.hs view
@@ -49,7 +49,7 @@ {-# INLINE generic #-}  -- | Convert from the data type to its representation (or back)-generic1 :: Generic1 f => Iso (f a) (f b) (Rep1 f a) (Rep1 f b)+generic1 :: (Generic1 f, Generic1 g) => Iso (f a) (g b) (Rep1 f a) (Rep1 g b) generic1 = iso GHC.from1 GHC.to1 {-# INLINE generic1 #-}
src/Optics/AffineFold.hs view
@@ -41,8 +41,9 @@  import Data.Maybe +import Data.Profunctor.Indexed+ import Optics.Internal.Bi-import Optics.Internal.Profunctor import Optics.Internal.Optic  -- | Type synonym for an affine fold.
src/Optics/AffineTraversal.hs view
@@ -60,9 +60,9 @@   )   where -import Optics.Internal.Concrete+import Data.Profunctor.Indexed+ import Optics.Internal.Optic-import Optics.Internal.Profunctor  -- | Type synonym for a type-modifying affine traversal. type AffineTraversal s t a b = Optic An_AffineTraversal NoIx s t a b
src/Optics/Arrow.hs view
@@ -10,12 +10,12 @@ import Data.Coerce import qualified Control.Category as C +import Data.Profunctor.Indexed+ import Optics.AffineTraversal import Optics.Prism import Optics.Setter import Optics.Internal.Optic-import Optics.Internal.Profunctor-import Optics.Internal.Utils  newtype WrappedArrow p i a b = WrapArrow { unwrapArrow :: p a b }
src/Optics/At/Core.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE TypeInType #-} -- | -- Module: Optics.At.Core -- Description: Optics for 'Map' and 'Set'-like containers.@@ -47,6 +48,7 @@ import Data.Functor.Identity import Data.IntMap as IntMap import Data.IntSet as IntSet+import Data.Kind (Type) import Data.List.NonEmpty as NonEmpty import Data.Map as Map import Data.Sequence as Seq@@ -63,7 +65,7 @@ -- | Type family that takes a key-value container type and returns the type of -- keys (indices) into the container, for example @'Index' ('Map' k a) ~ k@. -- This is shared by 'Ixed', 'At' and 'Contains'.-type family Index (s :: *) :: *+type family Index (s :: Type) :: Type type instance Index (e -> a) = e type instance Index IntSet = Int type instance Index (Set a) = a@@ -115,11 +117,19 @@ -- | Type family that takes a key-value container type and returns the type of -- values stored in the container, for example @'IxValue' ('Map' k a) ~ a@. This -- is shared by both 'Ixed' and 'At'.-type family IxValue (m :: *) :: *+type family IxValue (m :: Type) :: Type + -- | Provides a simple 'AffineTraversal' lets you traverse the value at a given -- key in a 'Map' or element at an ordinal position in a list or 'Seq'. class Ixed m where+  -- | Type family that takes a key-value container type and returns the kind+  -- of optic to index into it. For most containers, it's 'An_AffineTraversal',+  -- @Representable@ (Naperian) containers it is 'A_Lens', and multi-maps would+  -- have 'A_Traversal'.+  type IxKind (m :: Type) :: OpticKind+  type IxKind m = An_AffineTraversal+   -- | /NB:/ Setting the value of this 'AffineTraversal' will only set the value   -- in 'at' if it is already present.   --@@ -136,8 +146,8 @@   --   -- >>> [] ^? ix 2   -- Nothing-  ix :: Index m -> AffineTraversal' m (IxValue m)-  default ix :: At m => Index m -> AffineTraversal' m (IxValue m)+  ix :: Index m -> Optic' (IxKind m) NoIx m (IxValue m)+  default ix :: (At m, IxKind m ~ An_AffineTraversal) => Index m -> Optic' (IxKind m) NoIx m (IxValue m)   ix = ixAt   {-# INLINE ix #-} @@ -149,7 +159,8 @@  type instance IxValue (e -> a) = a instance Eq e => Ixed (e -> a) where-  ix e = atraversalVL $ \_ p f -> p (f e) <&> \a e' -> if e == e' then a else f e'+  type IxKind (e -> a) = A_Lens+  ix e = lensVL $ \p f -> p (f e) <&> \a e' -> if e == e' then a else f e'   {-# INLINE ix #-}  type instance IxValue (Maybe a) = a@@ -174,7 +185,8 @@  type instance IxValue (Identity a) = a instance Ixed (Identity a) where-  ix () = atraversalVL $ \_ f (Identity a) -> Identity <$> f a+  type IxKind (Identity a) = An_Iso+  ix () = coerced   {-# INLINE ix #-}  type instance IxValue (Tree a) = a@@ -361,7 +373,7 @@ -- @ -- 'ix' k ≡ 'at' k '%' '_Just' -- @-class Ixed m => At m where+class (Ixed m, IxKind m ~ An_AffineTraversal) => At m where   -- |   -- >>> Map.fromList [(1,"world")] ^. at 1   -- Just "world"
src/Optics/Coerce.hs view
@@ -24,8 +24,9 @@  import Data.Coerce +import Data.Profunctor.Indexed+ import Optics.Internal.Optic-import Optics.Internal.Profunctor  -- | Lift 'coerce' to the @s@ parameter of an optic. coerceS
src/Optics/Empty/Core.hs view
@@ -32,11 +32,12 @@ import Data.Set as Set import qualified Data.Sequence as Seq +import Data.Profunctor.Indexed+ import Data.Maybe.Optics import Optics.AffineTraversal-import Optics.Internal.Utils-import Optics.Iso import Optics.Fold+import Optics.Iso import Optics.Optic import Optics.Prism import Optics.Review
src/Optics/Fold.hs view
@@ -92,12 +92,13 @@ import Data.Function import Data.Monoid +import Data.Profunctor.Indexed++import Optics.AffineFold import Optics.Internal.Bi import Optics.Internal.Fold import Optics.Internal.Optic-import Optics.Internal.Profunctor import Optics.Internal.Utils-import Optics.AffineFold  -- | Type synonym for a fold. type Fold s a = Optic' A_Fold NoIx s a@@ -168,7 +169,7 @@ forOf_ = flip . traverseOf_ {-# INLINE forOf_ #-} --- | Evaluate each action in observed by a 'Fold' on a structure from left to+-- | Evaluate each action in a structure observed by a 'Fold' from left to -- right, ignoring the results. -- -- @
src/Optics/Getter.hs view
@@ -39,14 +39,19 @@   )   where +import Data.Profunctor.Indexed+ import Optics.Internal.Bi import Optics.Internal.Optic-import Optics.Internal.Profunctor  -- | Type synonym for a getter. type Getter s a = Optic' A_Getter NoIx s a  -- | View the value pointed to by a getter.+--+-- If you want to 'view' a type-modifying optic that is insufficiently+-- polymorphic to be type-preserving, use 'Optics.ReadOnly.getting'.+-- view :: Is k A_Getter => Optic' k is s a -> s -> a view o = views o id {-# INLINE view #-}
src/Optics/Indexed/Core.hs view
@@ -46,9 +46,10 @@   , ifor   ) where +import Data.Profunctor.Indexed+ import Optics.Internal.Indexed import Optics.Internal.Optic-import Optics.Internal.Profunctor  import Optics.AffineFold import Optics.AffineTraversal
src/Optics/Internal/Bi.hs view
@@ -6,15 +6,24 @@ -- in subsequent releases. module Optics.Internal.Bi where +import Data.Coerce import Data.Void -import Optics.Internal.Profunctor+import Data.Profunctor.Indexed  -- | Class for (covariant) bifunctors. class Bifunctor p where   bimap  :: (a -> b) -> (c -> d) -> p i a c -> p i b d   first  :: (a -> b)             -> p i a c -> p i b c   second ::             (c -> d) -> p i a c -> p i a d++instance Bifunctor Tagged where+  bimap  _f g = Tagged #. g .# unTagged+  first  _f   = coerce+  second    g = Tagged #. g .# unTagged+  {-# INLINE bimap #-}+  {-# INLINE first #-}+  {-# INLINE second #-}  -- | Class for contravariant bifunctors. class Bicontravariant p where
− src/Optics/Internal/Concrete.hs 
@@ -1,117 +0,0 @@-{-# OPTIONS_HADDOCK not-home #-}---- | Concrete representation types for certain optics.------ This module is intended for internal use only, and may change without warning--- in subsequent releases.-module Optics.Internal.Concrete-  ( Exchange(..)-  , Store(..)-  , Market(..)-  , AffineMarket(..)-  ) where--import Data.Bifunctor--import Optics.Internal.Profunctor---- | Type to represent the components of an isomorphism.-data Exchange a b i s t =-  Exchange (s -> a) (b -> t)--instance Profunctor (Exchange a b) where-  dimap ss tt (Exchange sa bt) = Exchange (sa . ss) (tt . bt)-  lmap  ss    (Exchange sa bt) = Exchange (sa . ss) bt-  rmap     tt (Exchange sa bt) = Exchange sa        (tt . bt)-  {-# INLINE dimap #-}-  {-# INLINE lmap #-}-  {-# INLINE rmap #-}---- | Type to represent the components of a lens.-data Store a b i s t = Store (s -> a) (s -> b -> t)--instance Profunctor (Store a b) where-  dimap f g (Store get set) = Store (get . f) (\s -> g . set (f s))-  lmap  f   (Store get set) = Store (get . f) (\s -> set (f s))-  rmap    g (Store get set) = Store get       (\s -> g . set s)-  {-# INLINE dimap #-}-  {-# INLINE lmap #-}-  {-# INLINE rmap #-}--instance Strong (Store a b) where-  first' (Store get set) = Store (get . fst) (\(s, c) b -> (set s b, c))-  second' (Store get set) = Store (get . snd) (\(c, s) b -> (c, set s b))-  {-# INLINE first' #-}-  {-# INLINE second' #-}---- | Type to represent the components of a prism.-data Market a b i s t = Market (b -> t) (s -> Either t a)--instance Functor (Market a b i s) where-  fmap f (Market bt seta) = Market (f . bt) (either (Left . f) Right . seta)-  {-# INLINE fmap #-}--instance Profunctor (Market a b) where-  dimap f g (Market bt seta) = Market (g . bt) (either (Left . g) Right . seta . f)-  lmap  f   (Market bt seta) = Market bt (seta . f)-  rmap    g (Market bt seta) = Market (g . bt) (either (Left . g) Right . seta)-  {-# INLINE dimap #-}-  {-# INLINE lmap #-}-  {-# INLINE rmap #-}--instance Choice (Market a b) where-  left' (Market bt seta) = Market (Left . bt) $ \sc -> case sc of-    Left s -> case seta s of-      Left t -> Left (Left t)-      Right a -> Right a-    Right c -> Left (Right c)-  right' (Market bt seta) = Market (Right . bt) $ \cs -> case cs of-    Left c -> Left (Left c)-    Right s -> case seta s of-      Left t -> Left (Right t)-      Right a -> Right a-  {-# INLINE left' #-}-  {-# INLINE right' #-}---- | Type to represent the components of an affine traversal.-data AffineMarket a b i s t = AffineMarket (s -> b -> t) (s -> Either t a)--instance Profunctor (AffineMarket a b) where-  dimap f g (AffineMarket sbt seta) = AffineMarket-    (\s b -> g (sbt (f s) b))-    (either (Left . g) Right . seta . f)-  lmap f (AffineMarket sbt seta) = AffineMarket-    (\s b -> sbt (f s) b)-    (seta . f)-  rmap g (AffineMarket sbt seta) = AffineMarket-    (\s b -> g (sbt s b))-    (either (Left . g) Right . seta)-  {-# INLINE dimap #-}-  {-# INLINE lmap #-}-  {-# INLINE rmap #-}--instance Choice (AffineMarket a b) where-  left' (AffineMarket sbt seta) = AffineMarket-    (\e b -> bimap (flip sbt b) id e)-    (\sc -> case sc of-      Left s -> bimap Left id (seta s)-      Right c -> Left (Right c))-  right' (AffineMarket sbt seta) = AffineMarket-    (\e b -> bimap id (flip sbt b) e)-    (\sc -> case sc of-      Left c -> Left (Left c)-      Right s -> bimap Right id (seta s))-  {-# INLINE left' #-}-  {-# INLINE right' #-}--instance Strong (AffineMarket a b) where-  first' (AffineMarket sbt seta) = AffineMarket-    (\(a, c) b -> (sbt a b, c))-    (\(a, c) -> bimap (,c) id (seta a))-  second' (AffineMarket sbt seta) = AffineMarket-    (\(c, a) b -> (c, sbt a b))-    (\(c, a) -> bimap (c,) id (seta a))-  {-# INLINE first' #-}-  {-# INLINE second' #-}--instance Visiting (AffineMarket a b)
src/Optics/Internal/Fold.hs view
@@ -11,9 +11,10 @@ import Data.Maybe import qualified Data.Semigroup as SG +import Data.Profunctor.Indexed+ import Optics.Internal.Bi import Optics.Internal.Optic-import Optics.Internal.Profunctor  -- | Internal implementation of 'Optics.Fold.foldVL'. foldVL__
src/Optics/Internal/Indexed.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeInType #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_HADDOCK not-home #-} @@ -19,6 +20,7 @@ import Data.Functor.Reverse import Data.Functor.Sum import Data.Ix+import Data.Kind (Type) import Data.List.NonEmpty import Data.Monoid hiding (Product, Sum) import Data.Proxy@@ -31,12 +33,13 @@ import qualified Data.Map as Map import qualified Data.Sequence as Seq +import Data.Profunctor.Indexed+ import Optics.Internal.Optic-import Optics.Internal.Profunctor import Optics.Internal.Utils  -- | Show useful error message when a function expects optics without indices.-class is ~ NoIx => AcceptsEmptyIndices (f :: Symbol) (is :: [*])+class is ~ NoIx => AcceptsEmptyIndices (f :: Symbol) (is :: IxList)  instance   ( TypeError@@ -48,7 +51,7 @@  -- | Check whether a list of indices is not empty and generate sensible error -- message if it's not.-class NonEmptyIndices (is :: [*])+class NonEmptyIndices (is :: IxList)  instance   ( TypeError@@ -60,7 +63,7 @@ -- | Generate sensible error messages in case a user tries to pass either an -- unindexed optic or indexed optic with unflattened indices where indexed optic -- with a single index is expected.-class is ~ '[i] => HasSingleIndex (is :: [*]) (i :: *)+class is ~ '[i] => HasSingleIndex (is :: IxList) (i :: Type)  instance HasSingleIndex '[i] i @@ -113,7 +116,7 @@ ---------------------------------------- -- Helpers for HasSingleIndex -type family ShowTypes (types :: [*]) :: ErrorMessage where+type family ShowTypes (types :: [Type]) :: ErrorMessage where   ShowTypes '[i]      = QuoteType i   ShowTypes '[i, j]   = QuoteType i ':<>: 'Text " and " ':<>: QuoteType j   ShowTypes (i ': is) = QuoteType i ':<>: 'Text ", " ':<>: ShowTypes is@@ -304,8 +307,13 @@   {-# INLINE ifoldr #-}  instance TraversableWithIndex Int Seq.Seq where-  -- This is much faster than Seq.traverseWithIndex. wut?+#if MIN_VERSION_containers(0,6,0)+  itraverse = Seq.traverseWithIndex+#else+  -- Much faster than Seq.traverseWithIndex for containers < 0.6.0, see+  -- https://github.com/haskell/containers/issues/603.   itraverse f = sequenceA . Seq.mapWithIndex f+#endif   {-# INLINE itraverse #-}  -- IntMap
src/Optics/Internal/IxFold.hs view
@@ -9,9 +9,10 @@ import Data.Functor import Data.Foldable +import Data.Profunctor.Indexed+ import Optics.Internal.Bi import Optics.Internal.Indexed-import Optics.Internal.Profunctor import Optics.Internal.Optic import Optics.Internal.Fold
src/Optics/Internal/IxSetter.hs view
@@ -6,9 +6,10 @@ -- in subsequent releases. module Optics.Internal.IxSetter where +import Data.Profunctor.Indexed+ import Optics.Internal.Indexed import Optics.Internal.Optic-import Optics.Internal.Profunctor  -- | Internal implementation of 'Optics.IxSetter.imapped'. imapped__
src/Optics/Internal/IxTraversal.hs view
@@ -6,12 +6,13 @@ -- in subsequent releases. module Optics.Internal.IxTraversal where +import Data.Profunctor.Indexed+ import Optics.Internal.Fold import Optics.Internal.Indexed import Optics.Internal.IxFold import Optics.Internal.IxSetter import Optics.Internal.Optic-import Optics.Internal.Profunctor import Optics.Internal.Setter  -- | Internal implementation of 'Optics.IxTraversal.itraversed'.
src/Optics/Internal/Optic.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeInType #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_HADDOCK not-home #-} @@ -21,8 +22,6 @@   , Optic'   , Optic_   , Optic__-  , NoIx-  , WithIx   , castOptic   , (%)   , (%%)@@ -38,25 +37,21 @@   ) where  import Data.Function ((&))+import Data.Kind (Type) import Data.Proxy (Proxy (..)) import Data.Type.Equality import GHC.OverloadedLabels import GHC.TypeLits +import Data.Profunctor.Indexed+ import Optics.Internal.Optic.Subtyping import Optics.Internal.Optic.TypeLevel import Optics.Internal.Optic.Types-import Optics.Internal.Profunctor  -- to make %% simpler import Unsafe.Coerce (unsafeCoerce) --- | An alias for an empty index-list-type NoIx = '[]---- | Singleton index list-type WithIx i = '[i]- -- | Wrapper newtype for the whole family of optics. -- -- The first parameter @k@ identifies the particular optic kind (e.g. 'A_Lens'@@ -70,7 +65,7 @@ -- The parameters @s@ and @t@ represent the "big" structure, -- whereas @a@ and @b@ represent the "small" structure. ---newtype Optic (k :: *) (is :: [*]) s t a b = Optic+newtype Optic (k :: OpticKind) (is :: IxList) s t a b = Optic   { getOptic :: forall p i. Profunctor p              => Optic_ k p i (Curry is i) s t a b   }@@ -94,7 +89,7 @@  -- | Proxy type for use as an argument to 'implies'. ---data IsProxy (k :: *) (l :: *) (p :: * -> * -> * -> *) =+data IsProxy (k :: Type) (l :: Type) (p :: Type -> Type -> Type -> Type) =   IsProxy  -- | Explicit cast from one optic flavour to another.@@ -183,7 +178,7 @@ -- -- It shows that usage of 'unsafeCoerce' in '(%%)' is, in fact, safe. ---class Append xs ys ~ zs => AppendProof (xs :: [*]) (ys :: [*]) (zs :: [*])+class Append xs ys ~ zs => AppendProof (xs :: [Type]) (ys :: [Type]) (zs :: [Type])   | xs ys -> zs, zs xs -> ys {- , zs ys -> xs -} where   appendProof :: Proxy i -> Curry xs (Curry ys i) :~: Curry zs i
src/Optics/Internal/Optic/Subtyping.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeInType #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_HADDOCK not-home #-} @@ -96,7 +97,7 @@ -- l@. This means in particular that composition of an @Optic k@ and an @Optic -- k@ will yield an @Optic (Join k l)@. ---type family Join (k :: *) (l :: *) where+type family Join (k :: OpticKind) (l :: OpticKind) where   -- BEGIN GENERATED CONTENT   -- An_Iso-----   Join An_Iso             A_ReversedLens     = A_ReversedLens
src/Optics/Internal/Optic/TypeLevel.hs view
@@ -1,15 +1,28 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeInType #-} {-# OPTIONS_HADDOCK not-home #-}  -- | This module is intended for internal use only, and may change without -- warning in subsequent releases. module Optics.Internal.Optic.TypeLevel where +import Data.Kind (Type) import GHC.TypeLits +-- | A list of index types, used for indexed optics.+--+-- @since 0.2+type IxList = [Type]++-- | An alias for an empty index-list+type NoIx = ('[] :: IxList)++-- | Singleton index list+type WithIx i = ('[i] :: IxList)+ -- | Show a type surrounded by quote marks.-type family QuoteType (x :: *) :: ErrorMessage where+type family QuoteType (x :: Type) :: ErrorMessage where   QuoteType x = 'Text "‘" ':<>: 'ShowType x ':<>: 'Text "’"  -- | Curry a type-level list.@@ -19,12 +32,12 @@ -- @ -- 'Curry' xs y = 'foldr' (->) y xs -- @-type family Curry (xs :: [*]) (y :: *) :: * where+type family Curry (xs :: IxList) (y :: Type) :: Type where   Curry '[]       y = y   Curry (x ': xs) y = x -> Curry xs y  -- | Append two type-level lists together.-type family Append (xs :: [*]) (ys :: [*]) :: [*] where+type family Append (xs :: IxList) (ys :: IxList) :: IxList where   Append '[]       ys  = ys -- needed for (<%>) and (%>)   Append xs        '[] = xs -- needed for (<%)   Append (x ': xs) ys  = x ': Append xs ys
src/Optics/Internal/Optic/Types.hs view
@@ -1,45 +1,53 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeInType #-} {-# OPTIONS_HADDOCK not-home #-}  -- | This module is intended for internal use only, and may change without -- warning in subsequent releases. module Optics.Internal.Optic.Types where -import GHC.Exts (Constraint)+import Data.Kind (Constraint, Type) +import Data.Profunctor.Indexed+ import Optics.Internal.Bi-import Optics.Internal.Profunctor +-- | Kind for types used as optic tags, such as 'A_Lens'.+--+-- @since 0.2+type OpticKind = Type+ -- | Tag for an iso.-data An_Iso+data An_Iso :: OpticKind -- | Tag for a lens.-data A_Lens+data A_Lens :: OpticKind -- | Tag for a prism.-data A_Prism+data A_Prism :: OpticKind -- | Tag for an affine traversal.-data An_AffineTraversal+data An_AffineTraversal :: OpticKind -- | Tag for a traversal.-data A_Traversal+data A_Traversal :: OpticKind -- | Tag for a setter.-data A_Setter+data A_Setter :: OpticKind -- | Tag for a reversed prism.-data A_ReversedPrism+data A_ReversedPrism :: OpticKind -- | Tag for a getter.-data A_Getter+data A_Getter :: OpticKind -- | Tag for an affine fold.-data An_AffineFold+data An_AffineFold :: OpticKind -- | Tag for a fold.-data A_Fold+data A_Fold :: OpticKind -- | Tag for a reversed lens.-data A_ReversedLens+data A_ReversedLens :: OpticKind -- | Tag for a review.-data A_Review+data A_Review :: OpticKind  -- | Mapping tag types @k@ to constraints on @p@. -- -- Using this type family we define the constraints that the various flavours of -- optics have to fulfill. ---type family Constraints (k :: *) (p :: * -> * -> * -> *) :: Constraint where+type family Constraints (k :: OpticKind) (p :: Type -> Type -> Type -> Type) :: Constraint where   Constraints An_Iso             p = Profunctor p   Constraints A_Lens             p = Strong p   Constraints A_ReversedLens     p = Costrong p
− src/Optics/Internal/Profunctor.hs 
@@ -1,705 +0,0 @@-{-# OPTIONS_HADDOCK not-home #-}---- | Definitions of concrete profunctors and profunctor classes.------ This module is intended for internal use only, and may change without warning--- in subsequent releases.-module Optics.Internal.Profunctor where--import Data.Coerce (Coercible, coerce)-import Data.Functor.Const-import Data.Functor.Identity--import Optics.Internal.Utils--------------------------------------------- Concrete profunctors---- | Needed for traversals.-newtype Star f i a b = Star { runStar :: a -> f b }---- | Needed for getters and folds.-newtype Forget r i a b = Forget { runForget :: a -> r }---- | Needed for affine folds.-newtype ForgetM r i a b = ForgetM { runForgetM :: a -> Maybe r }---- | Needed for setters.-newtype FunArrow i a b = FunArrow { runFunArrow :: a -> b }---- | Needed for indexed traversals.-newtype IxStar f i a b = IxStar { runIxStar :: i -> a -> f b }---- | Needed for indexed folds.-newtype IxForget r i a b = IxForget { runIxForget :: i -> a -> r }---- | Needed for indexed affine folds.-newtype IxForgetM r i a b = IxForgetM { runIxForgetM :: i -> a -> Maybe r }---- | Needed for indexed setters.-newtype IxFunArrow i a b = IxFunArrow { runIxFunArrow :: i -> a -> b }--------------------------------------------- Utils---- Needed for strict application of (indexed) setters.------ Credit for this goes to Eric Mertens, see--- <https://github.com/glguy/irc-core/commit/2d5fc45b05f1>.-data Identity' a = Identity' {-# UNPACK #-} !() a-  deriving Functor--instance Applicative Identity' where-  pure a = Identity' () a-  {-# INLINE pure #-}-  Identity' () f <*> Identity' () x = Identity' () (f x)-  {-# INLINE (<*>) #-}---- | Mark a value for evaluation to whnf.------ This allows us to, when applying a setter to a structure, evaluate only the--- parts that we modify. If an optic focuses on multiple targets, Applicative--- instance of Identity' makes sure that we force evaluation of all of them, but--- we leave anything else alone.----wrapIdentity' :: a -> Identity' a-wrapIdentity' a = Identity' (a `seq` ()) a-{-# INLINE wrapIdentity' #-}--unwrapIdentity' :: Identity' a -> a-unwrapIdentity' (Identity' () a) = a-{-# INLINE unwrapIdentity' #-}---------------------------------------------- | Needed for conversion of affine traversal back to its VL representation.-data StarA f i a b = StarA (forall r. r -> f r) (a -> f b)---- | Unwrap 'StarA'.-runStarA :: StarA f i a b -> a -> f b-runStarA (StarA _ k) = k-{-# INLINE runStarA #-}---- | Needed for conversion of indexed affine traversal back to its VL--- representation.-data IxStarA f i a b = IxStarA (forall r. r -> f r) (i -> a -> f b)---- | Unwrap 'StarA'.-runIxStarA :: IxStarA f i a b -> i -> a -> f b-runIxStarA (IxStarA _ k) = k-{-# INLINE runIxStarA #-}---------------------------------------------- | Repack 'Star' to change its index type.-reStar :: Star f i a b -> Star f j a b-reStar (Star k) = Star k-{-# INLINE reStar #-}---- | Repack 'Forget' to change its index type.-reForget :: Forget r i a b -> Forget r j a b-reForget (Forget k) = Forget k-{-# INLINE reForget #-}---- | Repack 'FunArrow' to change its index type.-reFunArrow :: FunArrow i a b -> FunArrow j a b-reFunArrow (FunArrow k) = FunArrow k-{-# INLINE reFunArrow #-}--------------------------------------------- Classes and instances--class Profunctor p where-  dimap :: (a -> b) -> (c -> d) -> p i b c -> p i a d-  lmap  :: (a -> b)             -> p i b c -> p i a c-  rmap  ::             (c -> d) -> p i b c -> p i b d--  lcoerce' :: Coercible a b => p i a c -> p i b c-  default lcoerce'-    :: Coercible (p i a c) (p i b c)-    => p i a c-    -> p i b c-  lcoerce' = coerce-  {-# INLINE lcoerce' #-}--  rcoerce' :: Coercible a b => p i c a -> p i c b-  default rcoerce'-    :: Coercible (p i c a) (p i c b)-    => p i c a-    -> p i c b-  rcoerce' = coerce-  {-# INLINE rcoerce' #-}--  conjoined__-    :: (p i a b -> p i s t)-    -> (p i a b -> p j s t)-    -> (p i a b -> p j s t)-  default conjoined__-    :: Coercible (p i s t) (p j s t)-    => (p i a b -> p i s t)-    -> (p i a b -> p j s t)-    -> (p i a b -> p j s t)-  conjoined__ f _ = coerce . f-  {-# INLINE conjoined__ #-}--  ixcontramap :: (j -> i) -> p i a b -> p j a b-  default ixcontramap-    :: Coercible (p i a b) (p j a b)-    => (j -> i)-    -> p i a b-    -> p j a b-  ixcontramap _ = coerce-  {-# INLINE ixcontramap #-}---- | 'rcoerce'' with type arguments rearranged for TypeApplications.-rcoerce :: (Coercible a b, Profunctor p) => p i c a -> p i c b-rcoerce = rcoerce'-{-# INLINE rcoerce #-}---- | 'lcoerce'' with type arguments rearranged for TypeApplications.-lcoerce :: (Coercible a b, Profunctor p) => p i a c -> p i b c-lcoerce = lcoerce'-{-# INLINE lcoerce #-}--instance Functor f => Profunctor (StarA f) where-  dimap f g (StarA point k) = StarA point (fmap g . k . f)-  lmap  f   (StarA point k) = StarA point (k . f)-  rmap    g (StarA point k) = StarA point (fmap g . k)-  {-# INLINE dimap #-}-  {-# INLINE lmap #-}-  {-# INLINE rmap #-}--  rcoerce' = rmap coerce-  {-# INLINE rcoerce' #-}--instance Functor f => Profunctor (Star f) where-  dimap f g (Star k) = Star (fmap g . k . f)-  lmap  f   (Star k) = Star (k . f)-  rmap    g (Star k) = Star (fmap g . k)-  {-# INLINE dimap #-}-  {-# INLINE lmap #-}-  {-# INLINE rmap #-}--  rcoerce' = rmap coerce-  {-# INLINE rcoerce' #-}--instance Profunctor (Forget r) where-  dimap f _ (Forget k) = Forget (k . f)-  lmap  f   (Forget k) = Forget (k . f)-  rmap   _g (Forget k) = Forget k-  {-# INLINE dimap #-}-  {-# INLINE lmap #-}-  {-# INLINE rmap #-}--instance Profunctor (ForgetM r) where-  dimap f _ (ForgetM k) = ForgetM (k . f)-  lmap  f   (ForgetM k) = ForgetM (k . f)-  rmap   _g (ForgetM k) = ForgetM k-  {-# INLINE dimap #-}-  {-# INLINE lmap #-}-  {-# INLINE rmap #-}--instance Profunctor FunArrow where-  dimap f g (FunArrow k) = FunArrow (g . k . f)-  lmap  f   (FunArrow k) = FunArrow (k . f)-  rmap    g (FunArrow k) = FunArrow (g . k)-  {-# INLINE dimap #-}-  {-# INLINE lmap #-}-  {-# INLINE rmap #-}--instance Functor f => Profunctor (IxStarA f) where-  dimap f g (IxStarA point k) = IxStarA point (\i -> fmap g . k i . f)-  lmap  f   (IxStarA point k) = IxStarA point (\i -> k i . f)-  rmap    g (IxStarA point k) = IxStarA point (\i -> fmap g . k i)-  {-# INLINE dimap #-}-  {-# INLINE lmap #-}-  {-# INLINE rmap #-}--  rcoerce' = rmap coerce-  {-# INLINE rcoerce' #-}--  conjoined__ _ f = f-  ixcontramap ij (IxStarA point k) = IxStarA point $ \i -> k (ij i)-  {-# INLINE conjoined__ #-}-  {-# INLINE ixcontramap #-}--instance Functor f => Profunctor (IxStar f) where-  dimap f g (IxStar k) = IxStar (\i -> fmap g . k i . f)-  lmap  f   (IxStar k) = IxStar (\i -> k i . f)-  rmap    g (IxStar k) = IxStar (\i -> fmap g . k i)-  {-# INLINE dimap #-}-  {-# INLINE lmap #-}-  {-# INLINE rmap #-}--  rcoerce' = rmap coerce-  {-# INLINE rcoerce' #-}--  conjoined__ _ f = f-  ixcontramap ij (IxStar k) = IxStar $ \i -> k (ij i)-  {-# INLINE conjoined__ #-}-  {-# INLINE ixcontramap #-}--instance Profunctor (IxForget r) where-  dimap f _ (IxForget k) = IxForget (\i -> k i . f)-  lmap  f   (IxForget k) = IxForget (\i -> k i . f)-  rmap   _g (IxForget k) = IxForget k-  {-# INLINE dimap #-}-  {-# INLINE lmap #-}-  {-# INLINE rmap #-}--  conjoined__ _ f = f-  ixcontramap ij (IxForget k) = IxForget $ \i -> k (ij i)-  {-# INLINE conjoined__ #-}-  {-# INLINE ixcontramap #-}--instance Profunctor (IxForgetM r) where-  dimap f _ (IxForgetM k) = IxForgetM (\i -> k i . f)-  lmap  f   (IxForgetM k) = IxForgetM (\i -> k i . f)-  rmap   _g (IxForgetM k) = IxForgetM k-  {-# INLINE dimap #-}-  {-# INLINE lmap #-}-  {-# INLINE rmap #-}--  conjoined__ _ f = f-  ixcontramap ij (IxForgetM k) = IxForgetM $ \i -> k (ij i)-  {-# INLINE conjoined__ #-}-  {-# INLINE ixcontramap #-}--instance Profunctor IxFunArrow where-  dimap f g (IxFunArrow k) = IxFunArrow (\i -> g . k i . f)-  lmap  f   (IxFunArrow k) = IxFunArrow (\i -> k i . f)-  rmap    g (IxFunArrow k) = IxFunArrow (\i -> g . k i)-  {-# INLINE dimap #-}-  {-# INLINE lmap #-}-  {-# INLINE rmap #-}--  conjoined__ _ f = f-  ixcontramap ij (IxFunArrow k) = IxFunArrow $ \i -> k (ij i)-  {-# INLINE conjoined__ #-}-  {-# INLINE ixcontramap #-}--------------------------------------------class Profunctor p => Strong p where-  first'  :: p i a b -> p i (a, c) (b, c)-  second' :: p i a b -> p i (c, a) (c, b)--  -- There are a few places where default implementation is good enough.-  linear-    :: (forall f. Functor f => (a -> f b) -> s -> f t)-    -> p i a b-    -> p i s t-  linear f = dimap-    ((\(Context bt a) -> (a, bt)) . f (Context id))-    (\(b, bt) -> bt b)-    . first'-  {-# INLINE linear #-}--  -- There are a few places where default implementation is good enough.-  ilinear-    :: (forall f. Functor f => (i -> a -> f b) -> s -> f t)-    -> p       j  a b-    -> p (i -> j) s t-  default ilinear-    :: Coercible (p j s t) (p (i -> j) s t)-    => (forall f. Functor f => (i -> a -> f b) -> s -> f t)-    -> p       j  a b-    -> p (i -> j) s t-  ilinear f = coerce . linear (\afb -> f $ \_ -> afb)-  {-# INLINE ilinear #-}--instance Functor f => Strong (StarA f) where-  first'  (StarA point k) = StarA point $ \ ~(a, c) -> (\b' -> (b', c)) <$> k a-  second' (StarA point k) = StarA point $ \ ~(c, a) -> (,) c <$> k a-  {-# INLINE first' #-}-  {-# INLINE second' #-}--  linear f (StarA point k) = StarA point (f k)-  {-# INLINE linear #-}--instance Functor f => Strong (Star f) where-  first'  (Star k) = Star $ \ ~(a, c) -> (\b' -> (b', c)) <$> k a-  second' (Star k) = Star $ \ ~(c, a) -> (,) c <$> k a-  {-# INLINE first' #-}-  {-# INLINE second' #-}--  linear f (Star k) = Star (f k)-  {-# INLINE linear #-}--instance Strong (Forget r) where-  first'  (Forget k) = Forget (k . fst)-  second' (Forget k) = Forget (k . snd)-  {-# INLINE first' #-}-  {-# INLINE second' #-}--  linear f (Forget k) = Forget (getConst #. f (Const #. k))-  {-# INLINE linear #-}--instance Strong (ForgetM r) where-  first'  (ForgetM k) = ForgetM (k . fst)-  second' (ForgetM k) = ForgetM (k . snd)-  {-# INLINE first' #-}-  {-# INLINE second' #-}--  linear f (ForgetM k) = ForgetM (getConst #. f (Const #. k))-  {-# INLINE linear #-}--instance Strong FunArrow where-  first'  (FunArrow k) = FunArrow $ \ ~(a, c) -> (k a, c)-  second' (FunArrow k) = FunArrow $ \ ~(c, a) -> (c, k a)-  {-# INLINE first' #-}-  {-# INLINE second' #-}--  linear f (FunArrow k) = FunArrow $ runIdentity #. f (Identity #. k)-  {-# INLINE linear #-}--instance Functor f => Strong (IxStarA f) where-  first'  (IxStarA point k) = IxStarA point $ \i ~(a, c) -> (\b' -> (b', c)) <$> k i a-  second' (IxStarA point k) = IxStarA point $ \i ~(c, a) -> (,) c <$> k i a-  {-# INLINE first' #-}-  {-# INLINE second' #-}--  linear f (IxStarA point k) = IxStarA point $ \i -> f (k i)-  ilinear f (IxStarA point k) = IxStarA point $ \ij -> f $ \i -> k (ij i)-  {-# INLINE linear #-}-  {-# INLINE ilinear #-}--instance Functor f => Strong (IxStar f) where-  first'  (IxStar k) = IxStar $ \i ~(a, c) -> (\b' -> (b', c)) <$> k i a-  second' (IxStar k) = IxStar $ \i ~(c, a) -> (,) c <$> k i a-  {-# INLINE first' #-}-  {-# INLINE second' #-}--  linear f (IxStar k) = IxStar $ \i -> f (k i)-  ilinear f (IxStar k) = IxStar $ \ij -> f $ \i -> k (ij i)-  {-# INLINE linear #-}-  {-# INLINE ilinear #-}--instance Strong (IxForget r) where-  first'  (IxForget k) = IxForget $ \i -> k i . fst-  second' (IxForget k) = IxForget $ \i -> k i . snd-  {-# INLINE first' #-}-  {-# INLINE second' #-}--  linear f (IxForget k) = IxForget $ \i -> getConst #. f (Const #. k i)-  ilinear f (IxForget k) = IxForget $ \ij -> getConst #. f (\i -> Const #. k (ij i))-  {-# INLINE linear #-}-  {-# INLINE ilinear #-}--instance Strong (IxForgetM r) where-  first'  (IxForgetM k) = IxForgetM $ \i -> k i . fst-  second' (IxForgetM k) = IxForgetM $ \i -> k i . snd-  {-# INLINE first' #-}-  {-# INLINE second' #-}--  linear f (IxForgetM k) = IxForgetM $ \i -> getConst #. f (Const #. k i)-  ilinear f (IxForgetM k) = IxForgetM $ \ij -> getConst #. f (\i -> Const #. k (ij i))-  {-# INLINE linear #-}-  {-# INLINE ilinear #-}--instance Strong IxFunArrow where-  first'  (IxFunArrow k) = IxFunArrow $ \i ~(a, c) -> (k i a, c)-  second' (IxFunArrow k) = IxFunArrow $ \i ~(c, a) -> (c, k i a)-  {-# INLINE first' #-}-  {-# INLINE second' #-}--  linear f (IxFunArrow k) = IxFunArrow $ \i ->-    runIdentity #. f (Identity #. k i)-  ilinear f (IxFunArrow k) = IxFunArrow $ \ij ->-    runIdentity #. f (\i -> Identity #. k (ij i))-  {-# INLINE linear #-}-  {-# INLINE ilinear #-}--------------------------------------------class Profunctor p => Costrong p where-  unfirst  :: p i (a, d) (b, d) -> p i a b-  unsecond :: p i (d, a) (d, b) -> p i a b--------------------------------------------class Profunctor p => Choice p where-  left'  :: p i a b -> p i (Either a c) (Either b c)-  right' :: p i a b -> p i (Either c a) (Either c b)--instance Functor f => Choice (StarA f) where-  left'  (StarA point k) = StarA point $ either (fmap Left . k) (point . Right)-  right' (StarA point k) = StarA point $ either (point . Left) (fmap Right . k)-  {-# INLINE left' #-}-  {-# INLINE right' #-}--instance Applicative f => Choice (Star f) where-  left'  (Star k) = Star $ either (fmap Left . k) (pure . Right)-  right' (Star k) = Star $ either (pure . Left) (fmap Right . k)-  {-# INLINE left' #-}-  {-# INLINE right' #-}--instance Monoid r => Choice (Forget r) where-  left'  (Forget k) = Forget $ either k (const mempty)-  right' (Forget k) = Forget $ either (const mempty) k-  {-# INLINE left' #-}-  {-# INLINE right' #-}--instance Choice (ForgetM r) where-  left'  (ForgetM k) = ForgetM $ either k (const Nothing)-  right' (ForgetM k) = ForgetM $ either (const Nothing) k-  {-# INLINE left' #-}-  {-# INLINE right' #-}--instance Choice FunArrow where-  left'  (FunArrow k) = FunArrow $ either (Left . k) Right-  right' (FunArrow k) = FunArrow $ either Left (Right . k)-  {-# INLINE left' #-}-  {-# INLINE right' #-}--instance Functor f => Choice (IxStarA f) where-  left'  (IxStarA point k) =-    IxStarA point $ \i -> either (fmap Left . k i) (point . Right)-  right' (IxStarA point k) =-    IxStarA point $ \i -> either (point . Left) (fmap Right . k i)-  {-# INLINE left' #-}-  {-# INLINE right' #-}--instance Applicative f => Choice (IxStar f) where-  left'  (IxStar k) = IxStar $ \i -> either (fmap Left . k i) (pure . Right)-  right' (IxStar k) = IxStar $ \i -> either (pure . Left) (fmap Right . k i)-  {-# INLINE left' #-}-  {-# INLINE right' #-}--instance Monoid r => Choice (IxForget r) where-  left'  (IxForget k) = IxForget $ \i -> either (k i) (const mempty)-  right' (IxForget k) = IxForget $ \i -> either (const mempty) (k i)-  {-# INLINE left' #-}-  {-# INLINE right' #-}--instance Choice (IxForgetM r) where-  left'  (IxForgetM k) = IxForgetM $ \i -> either (k i) (const Nothing)-  right' (IxForgetM k) = IxForgetM $ \i -> either (const Nothing) (k i)-  {-# INLINE left' #-}-  {-# INLINE right' #-}--instance Choice IxFunArrow where-  left'  (IxFunArrow k) = IxFunArrow $ \i -> either (Left . k i) Right-  right' (IxFunArrow k) = IxFunArrow $ \i -> either Left (Right . k i)-  {-# INLINE left' #-}-  {-# INLINE right' #-}--------------------------------------------class Profunctor p => Cochoice p where-  unleft  :: p i (Either a d) (Either b d) -> p i a b-  unright :: p i (Either d a) (Either d b) -> p i a b--instance Cochoice (Forget r) where-  unleft  (Forget k) = Forget (k . Left)-  unright (Forget k) = Forget (k . Right)-  {-# INLINE unleft #-}-  {-# INLINE unright #-}--instance Cochoice (ForgetM r) where-  unleft  (ForgetM k) = ForgetM (k . Left)-  unright (ForgetM k) = ForgetM (k . Right)-  {-# INLINE unleft #-}-  {-# INLINE unright #-}--instance Cochoice (IxForget r) where-  unleft  (IxForget k) = IxForget $ \i -> k i . Left-  unright (IxForget k) = IxForget $ \i -> k i . Right-  {-# INLINE unleft #-}-  {-# INLINE unright #-}--instance Cochoice (IxForgetM r) where-  unleft  (IxForgetM k) = IxForgetM (\i -> k i . Left)-  unright (IxForgetM k) = IxForgetM (\i -> k i . Right)-  {-# INLINE unleft #-}-  {-# INLINE unright #-}--------------------------------------------class (Choice p, Strong p) => Visiting p where-  visit-    :: forall i s t a b-    . (forall f. Functor f => (forall r. r -> f r) -> (a -> f b) -> s -> f t)-    -> p i a b-    -> p i s t-  visit f =-    let match :: s -> Either a t-        match s = f Right Left s-        update :: s -> b -> t-        update s b = runIdentity $ f Identity (\_ -> Identity b) s-    in dimap (\s -> (match s, s))-             (\(ebt, s) -> either (update s) id ebt)-       . first'-       . left'-  {-# INLINE visit #-}--  ivisit-    :: (forall f. Functor f => (forall r. r -> f r) -> (i -> a -> f b) -> s -> f t)-    -> p       j  a b-    -> p (i -> j) s t-  default ivisit-    :: Coercible (p j s t) (p (i -> j) s t)-    => (forall f. Functor f => (forall r. r -> f r) -> (i -> a -> f b) -> s -> f t)-    -> p       j  a b-    -> p (i -> j) s t-  ivisit f = coerce . visit (\point afb -> f point $ \_ -> afb)-  {-# INLINE ivisit #-}---instance Functor f => Visiting (StarA f) where-  visit  f (StarA point k) = StarA point $ f point k-  ivisit f (StarA point k) = StarA point $ f point (\_ -> k)-  {-# INLINE visit #-}-  {-# INLINE ivisit #-}--instance Applicative f => Visiting (Star f) where-  visit  f (Star k) = Star $ f pure k-  ivisit f (Star k) = Star $ f pure (\_ -> k)-  {-# INLINE visit #-}-  {-# INLINE ivisit #-}--instance Monoid r => Visiting (Forget r) where-  visit  f (Forget k) = Forget $ getConst #. f pure (Const #. k)-  ivisit f (Forget k) = Forget $ getConst #. f pure (\_ -> Const #. k)-  {-# INLINE visit #-}-  {-# INLINE ivisit #-}--instance Visiting (ForgetM r) where-  visit  f (ForgetM k) =-    ForgetM $ getConst #. f (\_ -> Const Nothing) (Const #. k)-  ivisit f (ForgetM k) =-    ForgetM $ getConst #. f (\_ -> Const Nothing) (\_ -> Const #. k)-  {-# INLINE visit #-}-  {-# INLINE ivisit #-}--instance Visiting FunArrow where-  visit  f (FunArrow k) = FunArrow $ runIdentity #. f pure (Identity #. k)-  ivisit f (FunArrow k) = FunArrow $ runIdentity #. f pure (\_ -> Identity #. k)-  {-# INLINE visit #-}-  {-# INLINE ivisit #-}--instance Functor f => Visiting (IxStarA f) where-  visit  f (IxStarA point k) = IxStarA point $ \i  -> f point (k i)-  ivisit f (IxStarA point k) = IxStarA point $ \ij -> f point $ \i -> k (ij i)-  {-# INLINE visit #-}-  {-# INLINE ivisit #-}--instance Applicative f => Visiting (IxStar f) where-  visit  f (IxStar k) = IxStar $ \i  -> f pure (k i)-  ivisit f (IxStar k) = IxStar $ \ij -> f pure $ \i -> k (ij i)-  {-# INLINE visit #-}-  {-# INLINE ivisit #-}--instance Monoid r => Visiting (IxForget r) where-  visit  f (IxForget k) =-    IxForget $ \i  -> getConst #. f pure (Const #. k i)-  ivisit f (IxForget k) =-    IxForget $ \ij -> getConst #. f pure (\i -> Const #. k (ij i))-  {-# INLINE visit #-}-  {-# INLINE ivisit #-}--instance Visiting (IxForgetM r) where-  visit  f (IxForgetM k) =-    IxForgetM $ \i  -> getConst #. f (\_ -> Const Nothing) (Const #. k i)-  ivisit f (IxForgetM k) =-    IxForgetM $ \ij -> getConst #. f (\_ -> Const Nothing) (\i -> Const #. k (ij i))-  {-# INLINE visit #-}-  {-# INLINE ivisit #-}--instance Visiting IxFunArrow where-  visit  f (IxFunArrow k) =-    IxFunArrow $ \i  -> runIdentity #. f pure (Identity #. k i)-  ivisit f (IxFunArrow k) =-    IxFunArrow $ \ij -> runIdentity #. f pure (\i -> Identity #. k (ij i))-  {-# INLINE visit #-}-  {-# INLINE ivisit #-}--------------------------------------------class Visiting p => Traversing p where-  wander-    :: (forall f. Applicative f => (a -> f b) -> s -> f t)-    -> p i a b-    -> p i s t-  iwander-    :: (forall f. Applicative f => (i -> a -> f b) -> s -> f t)-    -> p       j  a b-    -> p (i -> j) s t--instance Applicative f => Traversing (Star f) where-  wander  f (Star k) = Star $ f k-  iwander f (Star k) = Star $ f (\_ -> k)-  {-# INLINE wander #-}-  {-# INLINE iwander #-}--instance Monoid r => Traversing (Forget r) where-  wander  f (Forget k) = Forget $ getConst #. f (Const #. k)-  iwander f (Forget k) = Forget $ getConst #. f (\_ -> Const #. k)-  {-# INLINE wander #-}-  {-# INLINE iwander #-}--instance Traversing FunArrow where-  wander  f (FunArrow k) = FunArrow $ runIdentity #. f (Identity #. k)-  iwander f (FunArrow k) = FunArrow $ runIdentity #. f (\_ -> Identity #. k)-  {-# INLINE wander #-}-  {-# INLINE iwander #-}--instance Applicative f => Traversing (IxStar f) where-  wander  f (IxStar k) = IxStar $ \i -> f (k i)-  iwander f (IxStar k) = IxStar $ \ij -> f $ \i -> k (ij i)-  {-# INLINE wander #-}-  {-# INLINE iwander #-}--instance Monoid r => Traversing (IxForget r) where-  wander  f (IxForget k) =-    IxForget $ \i -> getConst #. f (Const #. k i)-  iwander f (IxForget k) =-    IxForget $ \ij -> getConst #. f (\i -> Const #. k (ij i))-  {-# INLINE wander #-}-  {-# INLINE iwander #-}--instance Traversing IxFunArrow where-  wander  f (IxFunArrow k) =-    IxFunArrow $ \i -> runIdentity #. f (Identity #. k i)-  iwander f (IxFunArrow k) =-    IxFunArrow $ \ij -> runIdentity #. f (\i -> Identity #. k (ij i))-  {-# INLINE wander #-}-  {-# INLINE iwander #-}--------------------------------------------class Traversing p => Mapping p where-  roam-    :: ((a -> b) -> s -> t)-    -> p i a b-    -> p i s t-  iroam-    :: ((i -> a -> b) -> s -> t)-    -> p       j  a b-    -> p (i -> j) s t--instance Mapping (Star Identity') where-  roam  f (Star k) = Star $ wrapIdentity' . f (unwrapIdentity' . k)-  iroam f (Star k) = Star $ wrapIdentity' . f (\_ -> unwrapIdentity' . k)-  {-# INLINE roam #-}-  {-# INLINE iroam #-}--instance Mapping FunArrow where-  roam  f (FunArrow k) = FunArrow $ f k-  iroam f (FunArrow k) = FunArrow $ f (const k)-  {-# INLINE roam #-}-  {-# INLINE iroam #-}--instance Mapping (IxStar Identity') where-  roam  f (IxStar k) =-    IxStar $ \i -> wrapIdentity' . f (unwrapIdentity' . k i)-  iroam f (IxStar k) =-    IxStar $ \ij -> wrapIdentity' . f (\i -> unwrapIdentity' . k (ij i))-  {-# INLINE roam #-}-  {-# INLINE iroam #-}--instance Mapping IxFunArrow where-  roam  f (IxFunArrow k) = IxFunArrow $ \i -> f (k i)-  iroam f (IxFunArrow k) = IxFunArrow $ \ij -> f $ \i -> k (ij i)-  {-# INLINE roam #-}-  {-# INLINE iroam #-}
src/Optics/Internal/Setter.hs view
@@ -6,7 +6,8 @@ -- in subsequent releases. module Optics.Internal.Setter where -import Optics.Internal.Profunctor+import Data.Profunctor.Indexed+ import Optics.Internal.Optic  -- | Internal implementation of 'Optics.Setter.mapped'.
− src/Optics/Internal/Tagged.hs 
@@ -1,50 +0,0 @@-{-# OPTIONS_HADDOCK not-home #-}---- | Based on the @tagged@ package.------ This module is intended for internal use only, and may change without warning--- in subsequent releases.----module Optics.Internal.Tagged where--import Data.Coerce--import Optics.Internal.Bi-import Optics.Internal.Profunctor-import Optics.Internal.Utils---- | Tag a value with not one but two phantom type parameters (so that 'Tagged'--- can be used as an indexed profunctor).-newtype Tagged i a b = Tagged { unTagged :: b }--instance Functor (Tagged i a) where-  fmap f = Tagged #. f .# unTagged-  {-# INLINE fmap #-}--instance Bifunctor Tagged where-  bimap  _f g = Tagged #. g .# unTagged-  first  _f   = coerce-  second    g = Tagged #. g .# unTagged-  {-# INLINE bimap #-}-  {-# INLINE first #-}-  {-# INLINE second #-}--instance Profunctor Tagged where-  dimap _f g = Tagged #. g .# unTagged-  lmap  _f   = coerce-  rmap     g = Tagged #. g .# unTagged-  {-# INLINE dimap #-}-  {-# INLINE lmap #-}-  {-# INLINE rmap #-}--instance Choice Tagged where-  left'  = Tagged #. Left  .# unTagged-  right' = Tagged #. Right .# unTagged-  {-# INLINE left' #-}-  {-# INLINE right' #-}--instance Costrong Tagged where-  unfirst (Tagged bd) = Tagged (fst bd)-  unsecond (Tagged db) = Tagged (snd db)-  {-# INLINE unfirst #-}-  {-# INLINE unsecond #-}
src/Optics/Internal/Traversal.hs view
@@ -6,8 +6,9 @@ -- in subsequent releases. module Optics.Internal.Traversal where +import Data.Profunctor.Indexed+ import Optics.Internal.Optic-import Optics.Internal.Profunctor import Optics.Internal.Fold import Optics.Internal.Setter
src/Optics/Internal/Utils.hs view
@@ -2,29 +2,67 @@  -- | This module is intended for internal use only, and may change without warning -- in subsequent releases.-module Optics.Internal.Utils where+module Optics.Internal.Utils+  ( Identity'(..)+  , wrapIdentity'+  , unwrapIdentity' -import Data.Coerce+  , Traversed(..)+  , runTraversed++  , OrT(..)+  , wrapOrT++  , (#.)+  , (.#)+  ) where+ import qualified Data.Semigroup as SG -data Context a b t = Context (b -> t) a+import Data.Profunctor.Indexed++-- Needed for strict application of (indexed) setters.+--+-- Credit for this goes to Eric Mertens, see+-- <https://github.com/glguy/irc-core/commit/2d5fc45b05f1>.+data Identity' a = Identity' {-# UNPACK #-} !() a   deriving Functor --- | Composition operator where the first argument must be an identity--- function up to representational equivalence (e.g. a newtype wrapper--- or unwrapper), and will be ignored at runtime.-(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)-(#.) _f = coerce-infixl 8 .#-{-# INLINE (#.) #-}+instance Applicative Identity' where+  pure a = Identity' () a+  {-# INLINE pure #-}+  Identity' () f <*> Identity' () x = Identity' () (f x)+  {-# INLINE (<*>) #-} --- | Composition operator where the second argument must be an--- identity function up to representational equivalence (e.g. a--- newtype wrapper or unwrapper), and will be ignored at runtime.-(.#) :: Coercible a b => (b -> c) -> (a -> b) -> (a -> c)-(.#) f _g = coerce f-infixr 9 #.-{-# INLINE (.#) #-}+instance Mapping (Star Identity') where+  roam  f (Star k) = Star $ wrapIdentity' . f (unwrapIdentity' . k)+  iroam f (Star k) = Star $ wrapIdentity' . f (\_ -> unwrapIdentity' . k)+  {-# INLINE roam #-}+  {-# INLINE iroam #-}++instance Mapping (IxStar Identity') where+  roam  f (IxStar k) =+    IxStar $ \i -> wrapIdentity' . f (unwrapIdentity' . k i)+  iroam f (IxStar k) =+    IxStar $ \ij -> wrapIdentity' . f (\i -> unwrapIdentity' . k (ij i))+  {-# INLINE roam #-}+  {-# INLINE iroam #-}+++-- | Mark a value for evaluation to whnf.+--+-- This allows us to, when applying a setter to a structure, evaluate only the+-- parts that we modify. If an optic focuses on multiple targets, Applicative+-- instance of Identity' makes sure that we force evaluation of all of them, but+-- we leave anything else alone.+--+wrapIdentity' :: a -> Identity' a+wrapIdentity' a = Identity' (a `seq` ()) a+{-# INLINE wrapIdentity' #-}++unwrapIdentity' :: Identity' a -> a+unwrapIdentity' (Identity' () a) = a+{-# INLINE unwrapIdentity' #-}  ----------------------------------------
src/Optics/Iso.hs view
@@ -21,14 +21,22 @@   -- specialise types to obtain:   --   -- @-  -- 'Optics.Getter.view'   :: 'Iso' s t a b -> s -> a-  -- 'Optics.Review.review' :: 'Iso' s t a b -> b -> t+  -- 'Optics.Getter.view'   :: 'Iso'' s a -> s -> a+  -- 'Optics.Review.review' :: 'Iso'' s a -> a -> s   -- @   --   -- @   -- 'Optics.Setter.over'   :: 'Iso' s t a b -> (a -> b) -> s -> t   -- 'Optics.Setter.set'    :: 'Iso' s t a b ->       b  -> s -> t   -- @+  --+  -- If you want to 'Optics.Getter.view' a type-modifying 'Iso' that is+  -- insufficiently polymorphic to be used as a type-preserving 'Iso'', use+  -- 'Optics.ReadOnly.getting':+  --+  -- @+  -- 'Optics.Getter.view' . 'Optics.ReadOnly.getting' :: 'Iso' s t a b -> s -> a+  -- @    -- * Computation   -- |@@ -52,6 +60,9 @@   , coerced   , coercedTo   , coerced1+  , non+  , non'+  , anon   , curried   , uncurried   , flipped@@ -80,10 +91,14 @@ import Data.Tuple import Data.Bifunctor import Data.Coerce+import Data.Maybe -import Optics.Internal.Concrete+import Data.Profunctor.Indexed++import Optics.AffineFold+import Optics.Prism+import Optics.Review import Optics.Internal.Optic-import Optics.Internal.Profunctor  -- | Type synonym for a type-modifying iso. type Iso s t a b = Optic An_Iso NoIx s t a b@@ -190,6 +205,96 @@ coerced1 = Optic (lcoerce' . rcoerce') {-# INLINE coerced1 #-} +-- | If @v@ is an element of a type @a@, and @a'@ is @a@ sans the element @v@,+-- then @'non' v@ is an isomorphism from @'Maybe' a'@ to @a@.+--+-- @+-- 'non' ≡ 'non'' '.' 'only'+-- @+--+-- Keep in mind this is only a real isomorphism if you treat the domain as being+-- @'Maybe' (a sans v)@.+--+-- This is practically quite useful when you want to have a 'Data.Map.Map' where+-- all the entries should have non-zero values.+--+-- >>> Map.fromList [("hello",1)] & at "hello" % non 0 %~ (+2)+-- fromList [("hello",3)]+--+-- >>> Map.fromList [("hello",1)] & at "hello" % non 0 %~ (subtract 1)+-- fromList []+--+-- >>> Map.fromList [("hello",1)] ^. at "hello" % non 0+-- 1+--+-- >>> Map.fromList [] ^. at "hello" % non 0+-- 0+--+-- This combinator is also particularly useful when working with nested maps.+--+-- /e.g./ When you want to create the nested 'Data.Map.Map' when it is missing:+--+-- >>> Map.empty & at "hello" % non Map.empty % at "world" ?~ "!!!"+-- fromList [("hello",fromList [("world","!!!")])]+--+-- and when have deleting the last entry from the nested 'Data.Map.Map' mean+-- that we should delete its entry from the surrounding one:+--+-- >>> Map.fromList [("hello", Map.fromList [("world","!!!")])] & at "hello" % non Map.empty % at "world" .~ Nothing+-- fromList []+--+-- It can also be used in reverse to exclude a given value:+--+-- >>> non 0 # rem 10 4+-- Just 2+--+-- >>> non 0 # rem 10 5+-- Nothing+--+-- @since 0.2+non :: Eq a => a -> Iso' (Maybe a) a+non = non' . only+{-# INLINE non #-}++-- | @'non'' p@ generalizes @'non' (p # ())@ to take any unit 'Prism'+--+-- This function generates an isomorphism between @'Maybe' (a | 'isn't' p a)@+-- and @a@.+--+-- >>> Map.singleton "hello" Map.empty & at "hello" % non' _Empty % at "world" ?~ "!!!"+-- fromList [("hello",fromList [("world","!!!")])]+--+-- >>> Map.fromList [("hello", Map.fromList [("world","!!!")])] & at "hello" % non' _Empty % at "world" .~ Nothing+-- fromList []+--+-- @since 0.2+non' :: Prism' a () -> Iso' (Maybe a) a+non' p = iso (fromMaybe def) go where+  def                = review p ()+  go b | p `isn't` b = Just b+       | otherwise   = Nothing+{-# INLINE non' #-}++-- | @'anon' a p@ generalizes @'non' a@ to take any value and a predicate.+--+-- @+-- 'anon' a ≡ 'non'' '.' 'nearly' a+-- @+--+-- This function assumes that @p a@ holds @'True'@ and generates an isomorphism+-- between @'Maybe' (a | 'not' (p a))@ and @a@.+--+-- >>> Map.empty & at "hello" % anon Map.empty Map.null % at "world" ?~ "!!!"+-- fromList [("hello",fromList [("world","!!!")])]+--+-- >>> Map.fromList [("hello", Map.fromList [("world","!!!")])] & at "hello" % anon Map.empty Map.null % at "world" .~ Nothing+-- fromList []+--+-- @since 0.2+anon :: a -> (a -> Bool) -> Iso' (Maybe a) a+anon a = non' . nearly a+{-# INLINE anon #-}+ -- | The canonical isomorphism for currying and uncurrying a function. -- -- @@@ -269,6 +374,7 @@   {-# INLINE swapped #-}  -- $setup+-- >>> import qualified Data.Map as Map -- >>> import Data.Functor.Identity -- >>> import Data.Monoid -- >>> import Optics.Core
src/Optics/IxAffineFold.hs view
@@ -33,10 +33,11 @@   , An_AffineFold   ) where +import Data.Profunctor.Indexed+ import Optics.AffineFold import Optics.Internal.Bi import Optics.Internal.Indexed-import Optics.Internal.Profunctor import Optics.Internal.Optic  -- | Type synonym for an indexed affine fold.
src/Optics/IxAffineTraversal.hs view
@@ -40,9 +40,10 @@   , toIxAtraversalVL   ) where +import Data.Profunctor.Indexed+ import Optics.Internal.Indexed import Optics.Internal.Optic-import Optics.Internal.Profunctor  -- | Type synonym for a type-modifying indexed affine traversal. type IxAffineTraversal i s t a b = Optic An_AffineTraversal (WithIx i) s t a b
src/Optics/IxFold.hs view
@@ -2,9 +2,9 @@ {-# LANGUAGE DataKinds #-} -- | -- Module: Optics.IxFold--- Description: An indexed version of an 'Optics.Fold.Fold'.+-- Description: An indexed version of a 'Optics.Fold.Fold'. ----- An 'IxFold' is an indexed version of an 'Optics.Fold.Fold'. See the "Indexed+-- An 'IxFold' is an indexed version of a 'Optics.Fold.Fold'. See the "Indexed -- optics" section of the overview documentation in the @Optics@ module of the -- main @optics@ package for more details on indexed optics. --@@ -58,12 +58,13 @@ import Control.Applicative.Backwards import Data.Monoid +import Data.Profunctor.Indexed+ import Optics.Internal.Bi import Optics.Internal.Indexed import Optics.Internal.Fold import Optics.Internal.IxFold import Optics.Internal.Optic-import Optics.Internal.Profunctor import Optics.Internal.Utils import Optics.IxAffineFold import Optics.Fold
src/Optics/IxGetter.hs view
@@ -1,8 +1,8 @@ -- | -- Module: Optics.IxGetter--- Description: An indexed version of an 'Optics.Getter.Getter'.+-- Description: An indexed version of a 'Optics.Getter.Getter'. ----- An 'IxGetter' is an indexed version of an 'Optics.Getter.Getter'. See the+-- An 'IxGetter' is an indexed version of a 'Optics.Getter.Getter'. See the -- "Indexed optics" section of the overview documentation in the @Optics@ module -- of the main @optics@ package for more details on indexed optics. --@@ -23,10 +23,11 @@   , A_Getter   ) where +import Data.Profunctor.Indexed+ import Optics.Internal.Bi import Optics.Internal.Indexed import Optics.Internal.Optic-import Optics.Internal.Profunctor  -- | Type synonym for an indexed getter. type IxGetter i s a = Optic' A_Getter (WithIx i) s a
src/Optics/IxLens.hs view
@@ -1,8 +1,8 @@ -- | -- Module: Optics.IxLens--- Description: An indexed version of an 'Optics.Lens.Lens'.+-- Description: An indexed version of a 'Optics.Lens.Lens'. ----- An 'IxLens' is an indexed version of an 'Optics.Lens.Lens'. See the "Indexed+-- An 'IxLens' is an indexed version of a 'Optics.Lens.Lens'. See the "Indexed -- optics" section of the overview documentation in the @Optics@ module of the -- main @optics@ package for more details on indexed optics. --@@ -44,9 +44,10 @@  import Data.Void +import Data.Profunctor.Indexed+ import Optics.Internal.Indexed import Optics.Internal.Optic-import Optics.Internal.Profunctor  -- | Type synonym for a type-modifying indexed lens. type IxLens i s t a b = Optic A_Lens (WithIx i) s t a b
src/Optics/IxSetter.hs view
@@ -1,9 +1,9 @@ {-# LANGUAGE DataKinds #-} -- | -- Module: Optics.IxSetter--- Description: An indexed version of an 'Optics.Setter.Setter'.+-- Description: An indexed version of a 'Optics.Setter.Setter'. ----- An 'IxSetter' is an indexed version of an 'Optics.Setter.Setter'. See the+-- An 'IxSetter' is an indexed version of a 'Optics.Setter.Setter'. See the -- "Indexed optics" section of the overview documentation in the @Optics@ module -- of the main @optics@ package for more details on indexed optics. --@@ -57,10 +57,12 @@   , FunctorWithIndex(..)   ) where +import Data.Profunctor.Indexed+ import Optics.Internal.Indexed import Optics.Internal.IxSetter import Optics.Internal.Optic-import Optics.Internal.Profunctor+import Optics.Internal.Utils  -- | Type synonym for a type-modifying indexed setter. type IxSetter i s t a b = Optic A_Setter (WithIx i) s t a b
src/Optics/IxTraversal.hs view
@@ -1,9 +1,9 @@ {-# LANGUAGE DataKinds #-} -- | -- Module: Optics.IxTraversal--- Description: An indexed version of an 'Optics.Traversal.Traversal'.+-- Description: An indexed version of a 'Optics.Traversal.Traversal'. ----- An 'IxTraversal' is an indexed version of an 'Optics.Traversal.Traversal'.+-- An 'IxTraversal' is an indexed version of a 'Optics.Traversal.Traversal'. -- See the "Indexed optics" section of the overview documentation in the -- @Optics@ module of the main @optics@ package for more details on indexed -- optics.@@ -66,7 +66,7 @@   -- | The van Laarhoven representation of an 'IxTraversal' directly expresses   -- how it lifts an effectful operation @I -> A -> F B@ on elements and their   -- indices to act on structures @S -> F T@.  Thus 'itraverseOf' converts an-  -- 'IxTraversal' to a 'IxTraversalVL'.+  -- 'IxTraversal' to an 'IxTraversalVL'.   , IxTraversalVL   , IxTraversalVL' @@ -78,9 +78,10 @@ import Control.Monad.Trans.State import Data.Functor.Identity +import Data.Profunctor.Indexed+ import Optics.Internal.Indexed import Optics.Internal.IxTraversal-import Optics.Internal.Profunctor import Optics.Internal.Optic import Optics.Internal.Utils import Optics.IxLens@@ -113,7 +114,7 @@  ---------------------------------------- --- | Map each element of a structure targeted by a 'IxTraversal' (supplying the+-- | Map each element of a structure targeted by an 'IxTraversal' (supplying the -- index), evaluate these actions from left to right, and collect the results. -- -- This yields the van Laarhoven representation of an indexed traversal.
src/Optics/Lens.hs view
@@ -42,7 +42,7 @@   -- 'Optics.Setter.Setter', therefore you can specialise types to obtain:   --   -- @-  -- 'Optics.Getter.view' :: 'Lens' s t a b -> s -> a+  -- 'Optics.Getter.view' :: 'Lens'' s a -> s -> a   -- @   --   -- @@@ -50,6 +50,13 @@   -- 'Optics.Setter.set'  :: 'Lens' s t a b ->       b  -> s -> t   -- @   --+  -- If you want to 'Optics.Getter.view' a type-modifying 'Lens' that is+  -- insufficiently polymorphic to be used as a type-preserving 'Lens'', use+  -- 'Optics.ReadOnly.getting':+  --+  -- @+  -- 'Optics.Getter.view' . 'Optics.ReadOnly.getting' :: 'Lens' s t a b -> s -> a+  -- @    -- * Computation   -- |@@ -107,10 +114,9 @@   )   where -import Optics.Internal.Concrete+import Data.Profunctor.Indexed+ import Optics.Internal.Optic-import Optics.Internal.Profunctor-import Optics.Internal.Utils  -- | Type synonym for a type-modifying lens. type Lens s t a b = Optic A_Lens NoIx s t a b
src/Optics/Optic.hs view
@@ -24,7 +24,8 @@ -- documentation. -- module Optics.Optic-  ( Optic+  ( OpticKind+  , Optic   , Optic'    -- * Subtyping@@ -38,6 +39,10 @@   , (%&)    -- * Indexed optics+  -- | See the "Indexed optics" section of the overview documentation in the+  -- @Optics@ module of the main @optics@ package for more details on indexed+  -- optics.+  , IxList   , NoIx   , WithIx   , Append
src/Optics/Prism.hs view
@@ -20,14 +20,22 @@   -- specialise types to obtain:   --   -- @-  -- 'Optics.AffineFold.preview' :: 'Prism' s t a b -> s -> Maybe a-  -- 'Optics.Review.review'  :: 'Prism' s t a b -> b -> t+  -- 'Optics.AffineFold.preview' :: 'Prism'' s a -> s -> Maybe a+  -- 'Optics.Review.review'  :: 'Prism'' s a -> a -> s   -- @   --   -- @   -- 'Optics.Setter.over'    :: 'Prism' s t a b -> (a -> b) -> s -> t   -- 'Optics.Setter.set'     :: 'Prism' s t a b ->       b  -> s -> t   -- @+  --+  -- If you want to 'Optics.AffineFold.preview' a type-modifying 'Prism' that is+  -- insufficiently polymorphic to be used as a type-preserving 'Prism'', use+  -- 'Optics.ReadOnly.getting':+  --+  -- @+  -- 'Optics.AffineFold.preview' . 'Optics.ReadOnly.getting' :: 'Prism' s t a b -> s -> 'Maybe' a+  -- @    -- * Computation   -- |@@ -70,9 +78,9 @@ import Control.Monad import Data.Bifunctor -import Optics.Internal.Concrete+import Data.Profunctor.Indexed+ import Optics.Internal.Optic-import Optics.Internal.Profunctor  -- | Type synonym for a type-modifying prism. type Prism s t a b = Optic A_Prism NoIx s t a b
src/Optics/Re.hs view
@@ -30,10 +30,11 @@  import Data.Coerce +import Data.Profunctor.Indexed+ import Optics.Internal.Bi import Optics.Internal.Indexed import Optics.Internal.Optic-import Optics.Internal.Profunctor  -- | Class for optics that can be 're'versed. class ReversibleOptic k where
src/Optics/ReadOnly.hs view
@@ -9,9 +9,10 @@   ( ToReadOnly(..)   ) where +import Data.Profunctor.Indexed+ import Optics.Internal.Bi import Optics.Internal.Optic-import Optics.Internal.Profunctor  -- | Class for read-write optics that have their read-only counterparts. class ToReadOnly k s t a b where
src/Optics/Review.hs view
@@ -29,11 +29,10 @@   )   where +import Data.Profunctor.Indexed+ import Optics.Internal.Bi import Optics.Internal.Optic-import Optics.Internal.Profunctor-import Optics.Internal.Tagged-import Optics.Internal.Utils  -- | Type synonym for a review. type Review t b = Optic' A_Review NoIx t b
src/Optics/Setter.hs view
@@ -60,9 +60,11 @@   -- | <<diagrams/Setter.png Setter in the optics hierarchy>>   ) where +import Data.Profunctor.Indexed+ import Optics.Internal.Optic-import Optics.Internal.Profunctor import Optics.Internal.Setter+import Optics.Internal.Utils  -- | Type synonym for a type-modifying setter. type Setter s t a b = Optic A_Setter NoIx s t a b
src/Optics/Traversal.hs view
@@ -80,12 +80,13 @@ import Control.Monad.Trans.State import Data.Functor.Identity +import Data.Profunctor.Indexed++import Optics.Fold import Optics.Internal.Optic-import Optics.Internal.Profunctor import Optics.Internal.Traversal import Optics.Internal.Utils import Optics.Lens-import Optics.Fold import Optics.ReadOnly  -- | Type synonym for a type-modifying traversal.