{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeInType #-} {-# OPTIONS_HADDOCK not-home #-} -- | Core optic types and subtyping machinery. -- -- This module contains the core 'Optic' types, and the underlying -- machinery that we need in order to implement the subtyping between -- various different flavours of optics. -- -- The composition operator for optics is also defined here. -- -- This module is intended for internal use only, and may change without -- warning in subsequent releases. -- module Optics.Internal.Optic ( Optic(..) , Optic' , Optic_ , Optic__ , getOptic , castOptic , (%) , (%%) , (%&) -- * Re-exports , module Optics.Internal.Optic.Subtyping , module Optics.Internal.Optic.Types , module Optics.Internal.Optic.TypeLevel ) where import Data.Function ((&)) import Data.Profunctor.Indexed import Optics.Internal.Optic.Subtyping import Optics.Internal.Optic.TypeLevel import Optics.Internal.Optic.Types -- | Wrapper newtype for the whole family of optics. -- -- The first parameter @k@ identifies the particular optic kind (e.g. 'A_Lens' -- or 'A_Traversal'). -- -- The parameter @is@ is a list of types available as indices. This will -- typically be 'NoIx' for unindexed optics, or 'WithIx' for optics with a -- single index. See the "Indexed optics" section of the overview documentation -- in the @Optics@ module of the main @optics@ package for more details. -- -- The parameters @s@ and @t@ represent the "big" structure, -- whereas @a@ and @b@ represent the "small" structure. -- newtype Optic (k :: OpticKind) (is :: IxList) s t a b = Optic (forall p i. Profunctor p => Optic_ k p i (Curry is i) s t a b) -- | Strip the newtype wrapper off. getOptic :: Profunctor p => Optic k is s t a b -> Optic_ k p i (Curry is i) s t a b -- Note: This is not part of the definition of 'Optic' because it needs to be -- marked INLINE for GHC to optimize away profunctor classes when profiling. -- See https://github.com/well-typed/optics/issues/324 for more details. getOptic :: Optic k is s t a b -> Optic_ k p i (Curry is i) s t a b getOptic (Optic 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 forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ k p i (Curry is i) s t a b o {-# INLINE getOptic #-} -- | Common special case of 'Optic' where source and target types are equal. -- -- Here, we need only one "big" and one "small" type. For lenses, this -- means that in the restricted form we cannot do type-changing updates. -- type Optic' k is s a = Optic k is s s a a -- | Type representing the various kinds of optics. -- -- The tag parameter @k@ is translated into constraints on @p@ -- via the type family 'Constraints'. -- type Optic_ k p i j s t a b = Constraints k p => Optic__ p i j s t a b -- | Optic internally as a profunctor transformation. type Optic__ p i j s t a b = p i a b -> p j s t -- | Explicit cast from one optic flavour to another. -- -- The resulting optic kind is given in the first type argument, so you can use -- TypeApplications to set it. For example -- -- @ -- 'castOptic' @'A_Lens' o -- @ -- -- turns @o@ into a 'Optics.Lens.Lens'. -- -- This is the identity function, modulo some constraint jiggery-pokery. -- castOptic :: forall destKind srcKind is s t a b . Is srcKind destKind => Optic srcKind is s t a b -> Optic destKind is s t a b castOptic :: Optic srcKind is s t a b -> Optic destKind is s t a b castOptic (Optic forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ srcKind p i (Curry is i) s t a b o) = (forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ destKind p i (Curry is i) s t a b) -> Optic destKind is s t a b 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_ srcKind p i (Curry is i) s t a b -> Optic_ destKind p i (Curry is i) s t a b forall (p :: * -> * -> * -> *) i. Optic_ srcKind p i (Curry is i) s t a b -> Optic_ destKind p i (Curry is i) s t a b cast Optic_ srcKind p i (Curry is i) s t a b forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ srcKind p i (Curry is i) s t a b o) where cast :: forall p i . Optic_ srcKind p i (Curry is i) s t a b -> Optic_ destKind p i (Curry is i) s t a b cast :: Optic_ srcKind p i (Curry is i) s t a b -> Optic_ destKind p i (Curry is i) s t a b cast Optic_ srcKind p i (Curry is i) s t a b x = Optic_ srcKind p i (Curry is i) s t a b -> Optic_ destKind p i (Curry is i) s t a b forall k l (p :: * -> * -> * -> *) r. Is k l => (Constraints k p => r) -> Constraints l p => r implies @srcKind @destKind @p Optic_ srcKind p i (Curry is i) s t a b x -- | Compose two optics of compatible flavours. -- -- Returns an optic of the appropriate supertype. If either or both optics are -- indexed, the composition preserves all the indices. -- infixl 9 % (%) :: forall k l m is js ks s t u v a b. (JoinKinds k l m, AppendIndices is js ks) => Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b Optic forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ k p i (Curry is i) s t u v k % :: Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b % Optic forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ l p i (Curry js i) u v a b l = (forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ m p i (Curry ks i) s t a b) -> Optic m ks s t a b 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 forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ m p i (Curry ks i) s t a b m where km :: forall p i. Profunctor p => Optic_ m p i (Curry is i) s t u v km :: Optic__ p i (Curry is i) s t u v km = ((Constraints k p, Constraints l p) => Optic__ p i (Curry is i) s t u v) -> Constraints m p => Optic__ p i (Curry is i) s t u v forall k l m (p :: * -> * -> * -> *) r. JoinKinds k l m => ((Constraints k p, Constraints l p) => r) -> Constraints m p => r joinKinds @k @l @m @p (Constraints k p, Constraints l p) => Optic__ p i (Curry is i) s t u v forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ k p i (Curry is i) s t u v k lm :: forall p i. Profunctor p => Optic_ m p i (Curry js i) u v a b lm :: Optic__ p i (Curry js i) u v a b lm = ((Constraints k p, Constraints l p) => Optic__ p i (Curry js i) u v a b) -> Constraints m p => Optic__ p i (Curry js i) u v a b forall k l m (p :: * -> * -> * -> *) r. JoinKinds k l m => ((Constraints k p, Constraints l p) => r) -> Constraints m p => r joinKinds @k @l @m @p (Constraints k p, Constraints l p) => Optic__ p i (Curry js i) u v a b forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ l p i (Curry js i) u v a b l m :: forall p i. (Profunctor p, Constraints m p) => Optic__ p i (Curry ks i) s t a b m :: Optic__ p i (Curry ks i) s t a b m | IxEq i (Curry is (Curry js i)) (Curry ks i) IxEq <- IxEq i (Curry is (Curry js i)) (Curry ks i) forall (xs :: IxList) (ys :: IxList) (ks :: IxList) i. AppendIndices xs ys ks => IxEq i (Curry xs (Curry ys i)) (Curry ks i) appendIndices @is @js @ks @i = p (Curry js i) u v -> p (Curry is (Curry js i)) s t forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ m p i (Curry is i) s t u v km (p (Curry js i) u v -> p (Curry is (Curry js i)) s t) -> (p i a b -> p (Curry js i) u v) -> p i a b -> p (Curry is (Curry js i)) s t forall b c a. (b -> c) -> (a -> b) -> a -> c . p i a b -> p (Curry js i) u v forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ m p i (Curry js i) u v a b lm -- | Compose two optics of the same flavour. -- -- Normally you can simply use ('%') instead, but this may be useful to help -- type inference if the type of one of the optics is otherwise -- under-constrained. infixl 9 %% (%%) :: forall k is js ks s t u v a b. AppendIndices is js ks => Optic k is s t u v -> Optic k js u v a b -> Optic k ks s t a b Optic forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ k p i (Curry is i) s t u v o %% :: Optic k is s t u v -> Optic k js u v a b -> Optic k ks s t a b %% Optic forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ k p i (Curry js i) u v a b o' = (forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ k p i (Curry ks i) s t a b) -> Optic k ks s t a b 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 forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ k p i (Curry ks i) s t a b oo where oo :: forall p i. (Profunctor p, Constraints k p) => Optic__ p i (Curry ks i) s t a b oo :: Optic__ p i (Curry ks i) s t a b oo | IxEq i (Curry is (Curry js i)) (Curry ks i) IxEq <- IxEq i (Curry is (Curry js i)) (Curry ks i) forall (xs :: IxList) (ys :: IxList) (ks :: IxList) i. AppendIndices xs ys ks => IxEq i (Curry xs (Curry ys i)) (Curry ks i) appendIndices @is @js @ks @i = p (Curry js i) u v -> p (Curry is (Curry js i)) s t forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ k p i (Curry is i) s t u v o (p (Curry js i) u v -> p (Curry is (Curry js i)) s t) -> (p i a b -> p (Curry js i) u v) -> p i a b -> p (Curry is (Curry js i)) s t forall b c a. (b -> c) -> (a -> b) -> a -> c . p i a b -> p (Curry js i) u v forall (p :: * -> * -> * -> *) i. Profunctor p => Optic_ k p i (Curry js i) u v a b o' -- | Flipped function application, specialised to optics and binding tightly. -- -- Useful for post-composing optics transformations: -- -- >>> toListOf (ifolded %& ifiltered (\i s -> length s <= i)) ["", "a","abc"] -- ["","a"] -- infixl 9 %& (%&) :: Optic k is s t a b -> (Optic k is s t a b -> Optic l js s' t' a' b') -> Optic l js s' t' a' b' %& :: Optic k is s t a b -> (Optic k is s t a b -> Optic l js s' t' a' b') -> Optic l js s' t' a' b' (%&) = Optic k is s t a b -> (Optic k is s t a b -> Optic l js s' t' a' b') -> Optic l js s' t' a' b' forall a b. a -> (a -> b) -> b (&) -- $setup -- >>> import Optics.Core