optics-core-0.3: src/Optics/Internal/Optic/Subtyping.hs
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK not-home #-}
-- | Instances to implement the subtyping hierarchy between optics.
--
-- This module is intended for internal use only, and may change without warning
-- in subsequent releases.
module Optics.Internal.Optic.Subtyping where
import GHC.TypeLits (ErrorMessage(..), TypeError)
import Optics.Internal.Optic.TypeLevel
import Optics.Internal.Optic.Types
-- | Subtyping relationship between kinds of optics.
--
-- An instance of @'Is' k l@ means that any @'Optics.Optic.Optic' k@ can be used
-- as an @'Optics.Optic.Optic' l@. For example, we have an @'Is' 'A_Lens'
-- 'A_Traversal'@ instance, but not @'Is' 'A_Traversal' 'A_Lens'@.
--
-- This class needs instances for all possible combinations of tags.
--
class Is k l where
-- | Witness of the subtyping relationship.
implies :: (Constraints k p => r) -> (Constraints l p => r)
-- | Every kind of optic can be used as itself.
instance Is k k where
implies r = r
-- | Overlappable instance for a custom type error.
instance {-# OVERLAPPABLE #-} TypeError
('ShowType k ':<>: 'Text " cannot be used as " ':<>: 'ShowType l
':$$: 'Text "Perhaps you meant one of these:"
':$$: ShowEliminations (EliminationForms k)
) => Is k l where
implies _ = error "unreachable"
type family EliminationForms (k :: OpticKind) where
EliminationForms An_AffineFold = AffineFoldEliminations
EliminationForms An_AffineTraversal = AffineTraversalEliminations
EliminationForms A_Fold = FoldEliminations
EliminationForms A_Getter = GetterEliminations
EliminationForms An_Iso = IsoEliminations
EliminationForms A_Lens = LensEliminations
EliminationForms A_Prism = PrismEliminations
EliminationForms A_ReversedLens = ReviewEliminations
EliminationForms A_ReversedPrism = GetterEliminations
EliminationForms A_Review = ReviewEliminations
EliminationForms A_Setter = SetterEliminations
EliminationForms A_Traversal = TraversalEliminations
type AffineFoldEliminations = '( '[ '("preview", "Optics.AffineFold") ]
, '[ "(^?)" ])
type AffineTraversalEliminations = AffineFoldEliminations
`AppendEliminations` SetterEliminations
type FoldEliminations = '( '[ '("traverseOf_", "Optics.Fold")
, '("foldMapOf", "Optics.Fold")
, '("toListOf", "Optics.Fold")
]
, '[ "(^..)" ])
type GetterEliminations = '( '[ '("view", "Optics.Getter") ]
, '[ "(^.)" ])
type IsoEliminations = GetterEliminations
`AppendEliminations` ReviewEliminations
`AppendEliminations` SetterEliminations
type LensEliminations = GetterEliminations
`AppendEliminations` SetterEliminations
type PrismEliminations = AffineFoldEliminations
`AppendEliminations` ReviewEliminations
`AppendEliminations` SetterEliminations
type ReviewEliminations = '( '[ '("review", "Optics.Review") ]
, '[ "(#)" ])
type SetterEliminations = '( '[ '("over", "Optics.Setter")
, '("set", "Optics.Setter")
]
, '[ "(%~)", "(.~)" ])
type TraversalEliminations = '( '[ '("traverseOf", "Optics.Traversal") ]
, '[]) `AppendEliminations` FoldEliminations
`AppendEliminations` SetterEliminations
----------------------------------------
-- BEGIN GENERATED CONTENT
-- An_Iso
instance Is An_Iso A_ReversedLens where implies r = r
instance Is An_Iso A_ReversedPrism where implies r = r
instance Is An_Iso A_Prism where implies r = r
instance Is An_Iso A_Review where implies r = r
instance Is An_Iso A_Lens where implies r = r
instance Is An_Iso A_Getter where implies r = r
instance Is An_Iso An_AffineTraversal where implies r = r
instance Is An_Iso An_AffineFold where implies r = r
instance Is An_Iso A_Traversal where implies r = r
instance Is An_Iso A_Fold where implies r = r
instance Is An_Iso A_Setter where implies r = r
-- A_ReversedLens
instance Is A_ReversedLens A_Review where implies r = r
-- A_ReversedPrism
instance Is A_ReversedPrism A_Getter where implies r = r
instance Is A_ReversedPrism An_AffineFold where implies r = r
instance Is A_ReversedPrism A_Fold where implies r = r
-- A_Prism
instance Is A_Prism A_Review where implies r = r
instance Is A_Prism An_AffineTraversal where implies r = r
instance Is A_Prism An_AffineFold where implies r = r
instance Is A_Prism A_Traversal where implies r = r
instance Is A_Prism A_Fold where implies r = r
instance Is A_Prism A_Setter where implies r = r
-- A_Lens
instance Is A_Lens A_Getter where implies r = r
instance Is A_Lens An_AffineTraversal where implies r = r
instance Is A_Lens An_AffineFold where implies r = r
instance Is A_Lens A_Traversal where implies r = r
instance Is A_Lens A_Fold where implies r = r
instance Is A_Lens A_Setter where implies r = r
-- A_Getter
instance Is A_Getter An_AffineFold where implies r = r
instance Is A_Getter A_Fold where implies r = r
-- An_AffineTraversal
instance Is An_AffineTraversal An_AffineFold where implies r = r
instance Is An_AffineTraversal A_Traversal where implies r = r
instance Is An_AffineTraversal A_Fold where implies r = r
instance Is An_AffineTraversal A_Setter where implies r = r
-- An_AffineFold
instance Is An_AffineFold A_Fold where implies r = r
-- A_Traversal
instance Is A_Traversal A_Fold where implies r = r
instance Is A_Traversal A_Setter where implies r = r
-- END GENERATED CONTENT
----------------------------------------
-- | Computes the least upper bound of two optics kinds.
--
-- @Join k l@ represents the least upper bound of an @Optic k@ and an @Optic
-- 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 :: OpticKind) (l :: OpticKind) where
-- BEGIN GENERATED CONTENT
-- An_Iso-----
Join An_Iso A_ReversedLens = A_ReversedLens
Join An_Iso A_ReversedPrism = A_ReversedPrism
Join An_Iso A_Prism = A_Prism
Join An_Iso A_Review = A_Review
Join An_Iso A_Lens = A_Lens
Join An_Iso A_Getter = A_Getter
Join An_Iso An_AffineTraversal = An_AffineTraversal
Join An_Iso An_AffineFold = An_AffineFold
Join An_Iso A_Traversal = A_Traversal
Join An_Iso A_Fold = A_Fold
Join An_Iso A_Setter = A_Setter
-- A_ReversedLens-----
Join A_ReversedLens An_Iso = A_ReversedLens
-- no Join with A_ReversedPrism
Join A_ReversedLens A_Prism = A_Review
Join A_ReversedLens A_Review = A_Review
-- no Join with A_Lens
-- no Join with A_Getter
-- no Join with An_AffineTraversal
-- no Join with An_AffineFold
-- no Join with A_Traversal
-- no Join with A_Fold
-- no Join with A_Setter
-- A_ReversedPrism-----
Join A_ReversedPrism An_Iso = A_ReversedPrism
-- no Join with A_ReversedLens
Join A_ReversedPrism A_Prism = An_AffineFold
-- no Join with A_Review
Join A_ReversedPrism A_Lens = A_Getter
Join A_ReversedPrism A_Getter = A_Getter
Join A_ReversedPrism An_AffineTraversal = An_AffineFold
Join A_ReversedPrism An_AffineFold = An_AffineFold
Join A_ReversedPrism A_Traversal = A_Fold
Join A_ReversedPrism A_Fold = A_Fold
-- no Join with A_Setter
-- A_Prism-----
Join A_Prism An_Iso = A_Prism
Join A_Prism A_ReversedLens = A_Review
Join A_Prism A_ReversedPrism = An_AffineFold
Join A_Prism A_Review = A_Review
Join A_Prism A_Lens = An_AffineTraversal
Join A_Prism A_Getter = An_AffineFold
Join A_Prism An_AffineTraversal = An_AffineTraversal
Join A_Prism An_AffineFold = An_AffineFold
Join A_Prism A_Traversal = A_Traversal
Join A_Prism A_Fold = A_Fold
Join A_Prism A_Setter = A_Setter
-- A_Review-----
Join A_Review An_Iso = A_Review
Join A_Review A_ReversedLens = A_Review
-- no Join with A_ReversedPrism
Join A_Review A_Prism = A_Review
-- no Join with A_Lens
-- no Join with A_Getter
-- no Join with An_AffineTraversal
-- no Join with An_AffineFold
-- no Join with A_Traversal
-- no Join with A_Fold
-- no Join with A_Setter
-- A_Lens-----
Join A_Lens An_Iso = A_Lens
-- no Join with A_ReversedLens
Join A_Lens A_ReversedPrism = A_Getter
Join A_Lens A_Prism = An_AffineTraversal
-- no Join with A_Review
Join A_Lens A_Getter = A_Getter
Join A_Lens An_AffineTraversal = An_AffineTraversal
Join A_Lens An_AffineFold = An_AffineFold
Join A_Lens A_Traversal = A_Traversal
Join A_Lens A_Fold = A_Fold
Join A_Lens A_Setter = A_Setter
-- A_Getter-----
Join A_Getter An_Iso = A_Getter
-- no Join with A_ReversedLens
Join A_Getter A_ReversedPrism = A_Getter
Join A_Getter A_Prism = An_AffineFold
-- no Join with A_Review
Join A_Getter A_Lens = A_Getter
Join A_Getter An_AffineTraversal = An_AffineFold
Join A_Getter An_AffineFold = An_AffineFold
Join A_Getter A_Traversal = A_Fold
Join A_Getter A_Fold = A_Fold
-- no Join with A_Setter
-- An_AffineTraversal-----
Join An_AffineTraversal An_Iso = An_AffineTraversal
-- no Join with A_ReversedLens
Join An_AffineTraversal A_ReversedPrism = An_AffineFold
Join An_AffineTraversal A_Prism = An_AffineTraversal
-- no Join with A_Review
Join An_AffineTraversal A_Lens = An_AffineTraversal
Join An_AffineTraversal A_Getter = An_AffineFold
Join An_AffineTraversal An_AffineFold = An_AffineFold
Join An_AffineTraversal A_Traversal = A_Traversal
Join An_AffineTraversal A_Fold = A_Fold
Join An_AffineTraversal A_Setter = A_Setter
-- An_AffineFold-----
Join An_AffineFold An_Iso = An_AffineFold
-- no Join with A_ReversedLens
Join An_AffineFold A_ReversedPrism = An_AffineFold
Join An_AffineFold A_Prism = An_AffineFold
-- no Join with A_Review
Join An_AffineFold A_Lens = An_AffineFold
Join An_AffineFold A_Getter = An_AffineFold
Join An_AffineFold An_AffineTraversal = An_AffineFold
Join An_AffineFold A_Traversal = A_Fold
Join An_AffineFold A_Fold = A_Fold
-- no Join with A_Setter
-- A_Traversal-----
Join A_Traversal An_Iso = A_Traversal
-- no Join with A_ReversedLens
Join A_Traversal A_ReversedPrism = A_Fold
Join A_Traversal A_Prism = A_Traversal
-- no Join with A_Review
Join A_Traversal A_Lens = A_Traversal
Join A_Traversal A_Getter = A_Fold
Join A_Traversal An_AffineTraversal = A_Traversal
Join A_Traversal An_AffineFold = A_Fold
Join A_Traversal A_Fold = A_Fold
Join A_Traversal A_Setter = A_Setter
-- A_Fold-----
Join A_Fold An_Iso = A_Fold
-- no Join with A_ReversedLens
Join A_Fold A_ReversedPrism = A_Fold
Join A_Fold A_Prism = A_Fold
-- no Join with A_Review
Join A_Fold A_Lens = A_Fold
Join A_Fold A_Getter = A_Fold
Join A_Fold An_AffineTraversal = A_Fold
Join A_Fold An_AffineFold = A_Fold
Join A_Fold A_Traversal = A_Fold
-- no Join with A_Setter
-- A_Setter-----
Join A_Setter An_Iso = A_Setter
-- no Join with A_ReversedLens
-- no Join with A_ReversedPrism
Join A_Setter A_Prism = A_Setter
-- no Join with A_Review
Join A_Setter A_Lens = A_Setter
-- no Join with A_Getter
Join A_Setter An_AffineTraversal = A_Setter
-- no Join with An_AffineFold
Join A_Setter A_Traversal = A_Setter
-- no Join with A_Fold
-- END GENERATED CONTENT
-- Every optic kinds can be joined with itself.
Join k k = k
-- Everything else is a type error.
Join k l = TypeError ('ShowType k
':<>: 'Text " cannot be composed with "
':<>: 'ShowType l)