{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeInType #-} -- | -- Module: Optics.ReadOnly -- Description: Converting read-write optics into their read-only counterparts. -- -- This module defines 'getting', which turns a read-write optic into its -- read-only counterpart. -- module Optics.ReadOnly ( ToReadOnly(..) ) where import Data.Profunctor.Indexed import Optics.Internal.Bi import Optics.Internal.Optic -- | Class for read-write optics that have their read-only counterparts. class ToReadOnly k s t a b where type ReadOnlyOptic k :: OpticKind -- | Turn read-write optic into its read-only counterpart (or leave read-only -- optics as-is). -- -- This is useful when you have an @optic :: 'Optic' k is s t a b@ of read-write -- kind @k@ such that @s@, @t@, @a@, @b@ are rigid, there is no evidence that -- @s ~ t@ and @a ~ b@ and you want to pass @optic@ to one of the functions -- that accept read-only optic kinds. -- -- Example: -- -- >>> let fstIntToChar = _1 :: Lens (Int, r) (Char, r) Int Char -- -- >>> :t view fstIntToChar -- ... -- ...Couldn't match type ‘Char’ with ‘Int’ -- ... -- -- >>> :t view (getting fstIntToChar) -- view (getting fstIntToChar) :: (Int, r) -> Int getting :: Optic k is s t a b -> Optic' (ReadOnlyOptic k) is s a instance ToReadOnly An_Iso s t a b where type ReadOnlyOptic An_Iso = A_Getter getting :: Optic An_Iso is s t a b -> Optic' (ReadOnlyOptic An_Iso) is s a getting Optic An_Iso is s t a b o = (forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ A_Getter p i (Curry is i) s s a a) -> Optic A_Getter is s s a a forall k (is :: IxList) s t a b. (forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ k p i (Curry is i) s t a b) -> Optic k is s t a b Optic (Optic An_Iso is s t a b -> Optic__ p i (Curry is i) s s a a forall (p :: * -> * -> * -> *) k (is :: IxList) s t a b i. (Profunctor p, Bicontravariant p, Constraints k p) => Optic k is s t a b -> Optic__ p i (Curry is i) s s a a getting__ Optic An_Iso is s t a b o) {-# INLINE getting #-} instance ToReadOnly A_Lens s t a b where type ReadOnlyOptic A_Lens = A_Getter getting :: Optic A_Lens is s t a b -> Optic' (ReadOnlyOptic A_Lens) is s a getting Optic A_Lens is s t a b o = (forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ A_Getter p i (Curry is i) s s a a) -> Optic A_Getter is s s a a forall k (is :: IxList) s t a b. (forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ k p i (Curry is i) s t a b) -> Optic k is s t a b Optic (Optic A_Lens is s t a b -> Optic__ p i (Curry is i) s s a a forall (p :: * -> * -> * -> *) k (is :: IxList) s t a b i. (Profunctor p, Bicontravariant p, Constraints k p) => Optic k is s t a b -> Optic__ p i (Curry is i) s s a a getting__ Optic A_Lens is s t a b o) {-# INLINE getting #-} instance ToReadOnly A_Prism s t a b where type ReadOnlyOptic A_Prism = An_AffineFold getting :: Optic A_Prism is s t a b -> Optic' (ReadOnlyOptic A_Prism) is s a getting Optic A_Prism is s t a b o = (forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ An_AffineFold p i (Curry is i) s s a a) -> Optic An_AffineFold is s s a a forall k (is :: IxList) s t a b. (forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ k p i (Curry is i) s t a b) -> Optic k is s t a b Optic (Optic A_Prism is s t a b -> Optic__ p i (Curry is i) s s a a forall (p :: * -> * -> * -> *) k (is :: IxList) s t a b i. (Profunctor p, Bicontravariant p, Constraints k p) => Optic k is s t a b -> Optic__ p i (Curry is i) s s a a getting__ Optic A_Prism is s t a b o) {-# INLINE getting #-} instance ToReadOnly An_AffineTraversal s t a b where type ReadOnlyOptic An_AffineTraversal = An_AffineFold getting :: Optic An_AffineTraversal is s t a b -> Optic' (ReadOnlyOptic An_AffineTraversal) is s a getting Optic An_AffineTraversal is s t a b o = (forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ An_AffineFold p i (Curry is i) s s a a) -> Optic An_AffineFold is s s a a forall k (is :: IxList) s t a b. (forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ k p i (Curry is i) s t a b) -> Optic k is s t a b Optic (Optic An_AffineTraversal is s t a b -> Optic__ p i (Curry is i) s s a a forall (p :: * -> * -> * -> *) k (is :: IxList) s t a b i. (Profunctor p, Bicontravariant p, Constraints k p) => Optic k is s t a b -> Optic__ p i (Curry is i) s s a a getting__ Optic An_AffineTraversal is s t a b o) {-# INLINE getting #-} instance ToReadOnly A_Traversal s t a b where type ReadOnlyOptic A_Traversal = A_Fold getting :: Optic A_Traversal is s t a b -> Optic' (ReadOnlyOptic A_Traversal) is s a getting Optic A_Traversal is s t a b o = (forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ A_Fold p i (Curry is i) s s a a) -> Optic A_Fold is s s a a forall k (is :: IxList) s t a b. (forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ k p i (Curry is i) s t a b) -> Optic k is s t a b Optic (Optic A_Traversal is s t a b -> Optic__ p i (Curry is i) s s a a forall (p :: * -> * -> * -> *) k (is :: IxList) s t a b i. (Profunctor p, Bicontravariant p, Constraints k p) => Optic k is s t a b -> Optic__ p i (Curry is i) s s a a getting__ Optic A_Traversal is s t a b o) {-# INLINE getting #-} instance ToReadOnly A_ReversedPrism s t a b where type ReadOnlyOptic A_ReversedPrism = A_Getter getting :: Optic A_ReversedPrism is s t a b -> Optic' (ReadOnlyOptic A_ReversedPrism) is s a getting Optic A_ReversedPrism is s t a b o = (forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ A_Getter p i (Curry is i) s s a a) -> Optic A_Getter is s s a a forall k (is :: IxList) s t a b. (forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ k p i (Curry is i) s t a b) -> Optic k is s t a b Optic (Optic A_ReversedPrism is s t a b -> Optic__ p i (Curry is i) s s a a forall (p :: * -> * -> * -> *) k (is :: IxList) s t a b i. (Profunctor p, Bicontravariant p, Constraints k p) => Optic k is s t a b -> Optic__ p i (Curry is i) s s a a getting__ Optic A_ReversedPrism is s t a b o) {-# INLINE getting #-} instance (s ~ t, a ~ b) => ToReadOnly A_Getter s t a b where type ReadOnlyOptic A_Getter = A_Getter getting :: Optic A_Getter is s t a b -> Optic' (ReadOnlyOptic A_Getter) is s a getting = Optic A_Getter is s t a b -> Optic' (ReadOnlyOptic A_Getter) is s a forall a. a -> a id {-# INLINE getting #-} instance (s ~ t, a ~ b) => ToReadOnly An_AffineFold s t a b where type ReadOnlyOptic An_AffineFold = An_AffineFold getting :: Optic An_AffineFold is s t a b -> Optic' (ReadOnlyOptic An_AffineFold) is s a getting = Optic An_AffineFold is s t a b -> Optic' (ReadOnlyOptic An_AffineFold) is s a forall a. a -> a id {-# INLINE getting #-} instance (s ~ t, a ~ b) => ToReadOnly A_Fold s t a b where type ReadOnlyOptic A_Fold = A_Fold getting :: Optic A_Fold is s t a b -> Optic' (ReadOnlyOptic A_Fold) is s a getting = Optic A_Fold is s t a b -> Optic' (ReadOnlyOptic A_Fold) is s a forall a. a -> a id {-# INLINE getting #-} -- | Internal implementation of 'getting'. getting__ :: (Profunctor p, Bicontravariant p, Constraints k p) => Optic k is s t a b -> Optic__ p i (Curry is i) s s a a getting__ :: Optic k is s t a b -> Optic__ p i (Curry is i) s s a a getting__ (Optic forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ k p i (Curry is i) s t a b o) = p (Curry is i) s t -> p (Curry is i) s s forall (p :: * -> * -> * -> *) i c a b. (Profunctor p, Bicontravariant p) => p i c a -> p i c b rphantom (p (Curry is i) s t -> p (Curry is i) s s) -> (p i a a -> p (Curry is i) s t) -> Optic__ p i (Curry is i) s s a a forall b c a. (b -> c) -> (a -> b) -> a -> c . Optic__ p i (Curry is i) s t a b forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ k p i (Curry is i) s t a b o Optic__ p i (Curry is i) s t a b -> (p i a a -> p i a b) -> p i a a -> p (Curry is i) s t forall b c a. (b -> c) -> (a -> b) -> a -> c . p i a a -> p i a b forall (p :: * -> * -> * -> *) i c a b. (Profunctor p, Bicontravariant p) => p i c a -> p i c b rphantom {-# INLINE getting__ #-} -- $setup -- >>> import Optics.Core