1{-# LANGUAGE AllowAmbiguousTypes #-} 2{-# LANGUAGE DataKinds #-} 3{-# LANGUAGE TypeInType #-} 4{-# LANGUAGE UndecidableInstances #-} 5{-# OPTIONS_HADDOCK not-home #-} 6 7-- | Instances to implement the subtyping hierarchy between optics. 8-- 9-- This module is intended for internal use only, and may change without warning 10-- in subsequent releases. 11module Optics.Internal.Optic.Subtyping where 12 13import GHC.TypeLits (ErrorMessage(..), TypeError) 14 15import Optics.Internal.Optic.TypeLevel 16import Optics.Internal.Optic.Types 17 18-- | Subtyping relationship between kinds of optics. 19-- 20-- An instance of @'Is' k l@ means that any @'Optics.Optic.Optic' k@ can be used 21-- as an @'Optics.Optic.Optic' l@. For example, we have an @'Is' 'A_Lens' 22-- 'A_Traversal'@ instance, but not @'Is' 'A_Traversal' 'A_Lens'@. 23-- 24-- This class needs instances for all possible combinations of tags. 25-- 26class Is k l where 27 -- | Witness of the subtyping relationship. 28 implies :: (Constraints k p => r) -> (Constraints l p => r) 29 30-- | Every kind of optic can be used as itself. 31instance Is k k where 32 implies r = r 33 34-- | Overlappable instance for a custom type error. 35instance {-# OVERLAPPABLE #-} TypeError 36 ('ShowType k ':<>: 'Text " cannot be used as " ':<>: 'ShowType l 37 ':$$: 'Text "Perhaps you meant one of these:" 38 ':$$: ShowEliminations (EliminationForms k) 39 ) => Is k l where 40 implies _ = error "unreachable" 41 42type family EliminationForms (k :: OpticKind) where 43 EliminationForms An_AffineFold = AffineFoldEliminations 44 EliminationForms An_AffineTraversal = AffineTraversalEliminations 45 EliminationForms A_Fold = FoldEliminations 46 EliminationForms A_Getter = GetterEliminations 47 EliminationForms An_Iso = IsoEliminations 48 EliminationForms A_Lens = LensEliminations 49 EliminationForms A_Prism = PrismEliminations 50 EliminationForms A_ReversedLens = ReviewEliminations 51 EliminationForms A_ReversedPrism = GetterEliminations 52 EliminationForms A_Review = ReviewEliminations 53 EliminationForms A_Setter = SetterEliminations 54 EliminationForms A_Traversal = TraversalEliminations 55 56type AffineFoldEliminations = '( '[ '("preview", "Optics.AffineFold") ] 57 , '[ "(^?)" ]) 58 59type AffineTraversalEliminations = AffineFoldEliminations 60 `AppendEliminations` SetterEliminations 61 62type FoldEliminations = '( '[ '("traverseOf_", "Optics.Fold") 63 , '("foldMapOf", "Optics.Fold") 64 , '("toListOf", "Optics.Fold") 65 ] 66 , '[ "(^..)" ]) 67 68type GetterEliminations = '( '[ '("view", "Optics.Getter") ] 69 , '[ "(^.)" ]) 70 71type IsoEliminations = GetterEliminations 72 `AppendEliminations` ReviewEliminations 73 `AppendEliminations` SetterEliminations 74 75type LensEliminations = GetterEliminations 76 `AppendEliminations` SetterEliminations 77 78type PrismEliminations = AffineFoldEliminations 79 `AppendEliminations` ReviewEliminations 80 `AppendEliminations` SetterEliminations 81 82type ReviewEliminations = '( '[ '("review", "Optics.Review") ] 83 , '[ "(#)" ]) 84 85type SetterEliminations = '( '[ '("over", "Optics.Setter") 86 , '("set", "Optics.Setter") 87 ] 88 , '[ "(%~)", "(.~)" ]) 89 90type TraversalEliminations = '( '[ '("traverseOf", "Optics.Traversal") ] 91 , '[]) `AppendEliminations` FoldEliminations 92 `AppendEliminations` SetterEliminations 93 94---------------------------------------- 95 96-- BEGIN GENERATED CONTENT 97 98-- An_Iso 99instance Is An_Iso A_ReversedLens where implies r = r 100instance Is An_Iso A_ReversedPrism where implies r = r 101instance Is An_Iso A_Prism where implies r = r 102instance Is An_Iso A_Review where implies r = r 103instance Is An_Iso A_Lens where implies r = r 104instance Is An_Iso A_Getter where implies r = r 105instance Is An_Iso An_AffineTraversal where implies r = r 106instance Is An_Iso An_AffineFold where implies r = r 107instance Is An_Iso A_Traversal where implies r = r 108instance Is An_Iso A_Fold where implies r = r 109instance Is An_Iso A_Setter where implies r = r 110-- A_ReversedLens 111instance Is A_ReversedLens A_Review where implies r = r 112-- A_ReversedPrism 113instance Is A_ReversedPrism A_Getter where implies r = r 114instance Is A_ReversedPrism An_AffineFold where implies r = r 115instance Is A_ReversedPrism A_Fold where implies r = r 116-- A_Prism 117instance Is A_Prism A_Review where implies r = r 118instance Is A_Prism An_AffineTraversal where implies r = r 119instance Is A_Prism An_AffineFold where implies r = r 120instance Is A_Prism A_Traversal where implies r = r 121instance Is A_Prism A_Fold where implies r = r 122instance Is A_Prism A_Setter where implies r = r 123-- A_Lens 124instance Is A_Lens A_Getter where implies r = r 125instance Is A_Lens An_AffineTraversal where implies r = r 126instance Is A_Lens An_AffineFold where implies r = r 127instance Is A_Lens A_Traversal where implies r = r 128instance Is A_Lens A_Fold where implies r = r 129instance Is A_Lens A_Setter where implies r = r 130-- A_Getter 131instance Is A_Getter An_AffineFold where implies r = r 132instance Is A_Getter A_Fold where implies r = r 133-- An_AffineTraversal 134instance Is An_AffineTraversal An_AffineFold where implies r = r 135instance Is An_AffineTraversal A_Traversal where implies r = r 136instance Is An_AffineTraversal A_Fold where implies r = r 137instance Is An_AffineTraversal A_Setter where implies r = r 138-- An_AffineFold 139instance Is An_AffineFold A_Fold where implies r = r 140-- A_Traversal 141instance Is A_Traversal A_Fold where implies r = r 142instance Is A_Traversal A_Setter where implies r = r 143 144-- END GENERATED CONTENT 145 146---------------------------------------- 147 148-- | Computes the least upper bound of two optics kinds. 149-- 150-- @Join k l@ represents the least upper bound of an @Optic k@ and an @Optic 151-- l@. This means in particular that composition of an @Optic k@ and an @Optic 152-- k@ will yield an @Optic (Join k l)@. 153-- 154type family Join (k :: OpticKind) (l :: OpticKind) where 155 -- BEGIN GENERATED CONTENT 156 -- An_Iso----- 157 Join An_Iso A_ReversedLens = A_ReversedLens 158 Join An_Iso A_ReversedPrism = A_ReversedPrism 159 Join An_Iso A_Prism = A_Prism 160 Join An_Iso A_Review = A_Review 161 Join An_Iso A_Lens = A_Lens 162 Join An_Iso A_Getter = A_Getter 163 Join An_Iso An_AffineTraversal = An_AffineTraversal 164 Join An_Iso An_AffineFold = An_AffineFold 165 Join An_Iso A_Traversal = A_Traversal 166 Join An_Iso A_Fold = A_Fold 167 Join An_Iso A_Setter = A_Setter 168 169 -- A_ReversedLens----- 170 Join A_ReversedLens An_Iso = A_ReversedLens 171 -- no Join with A_ReversedPrism 172 Join A_ReversedLens A_Prism = A_Review 173 Join A_ReversedLens A_Review = A_Review 174 -- no Join with A_Lens 175 -- no Join with A_Getter 176 -- no Join with An_AffineTraversal 177 -- no Join with An_AffineFold 178 -- no Join with A_Traversal 179 -- no Join with A_Fold 180 -- no Join with A_Setter 181 182 -- A_ReversedPrism----- 183 Join A_ReversedPrism An_Iso = A_ReversedPrism 184 -- no Join with A_ReversedLens 185 Join A_ReversedPrism A_Prism = An_AffineFold 186 -- no Join with A_Review 187 Join A_ReversedPrism A_Lens = A_Getter 188 Join A_ReversedPrism A_Getter = A_Getter 189 Join A_ReversedPrism An_AffineTraversal = An_AffineFold 190 Join A_ReversedPrism An_AffineFold = An_AffineFold 191 Join A_ReversedPrism A_Traversal = A_Fold 192 Join A_ReversedPrism A_Fold = A_Fold 193 -- no Join with A_Setter 194 195 -- A_Prism----- 196 Join A_Prism An_Iso = A_Prism 197 Join A_Prism A_ReversedLens = A_Review 198 Join A_Prism A_ReversedPrism = An_AffineFold 199 Join A_Prism A_Review = A_Review 200 Join A_Prism A_Lens = An_AffineTraversal 201 Join A_Prism A_Getter = An_AffineFold 202 Join A_Prism An_AffineTraversal = An_AffineTraversal 203 Join A_Prism An_AffineFold = An_AffineFold 204 Join A_Prism A_Traversal = A_Traversal 205 Join A_Prism A_Fold = A_Fold 206 Join A_Prism A_Setter = A_Setter 207 208 -- A_Review----- 209 Join A_Review An_Iso = A_Review 210 Join A_Review A_ReversedLens = A_Review 211 -- no Join with A_ReversedPrism 212 Join A_Review A_Prism = A_Review 213 -- no Join with A_Lens 214 -- no Join with A_Getter 215 -- no Join with An_AffineTraversal 216 -- no Join with An_AffineFold 217 -- no Join with A_Traversal 218 -- no Join with A_Fold 219 -- no Join with A_Setter 220 221 -- A_Lens----- 222 Join A_Lens An_Iso = A_Lens 223 -- no Join with A_ReversedLens 224 Join A_Lens A_ReversedPrism = A_Getter 225 Join A_Lens A_Prism = An_AffineTraversal 226 -- no Join with A_Review 227 Join A_Lens A_Getter = A_Getter 228 Join A_Lens An_AffineTraversal = An_AffineTraversal 229 Join A_Lens An_AffineFold = An_AffineFold 230 Join A_Lens A_Traversal = A_Traversal 231 Join A_Lens A_Fold = A_Fold 232 Join A_Lens A_Setter = A_Setter 233 234 -- A_Getter----- 235 Join A_Getter An_Iso = A_Getter 236 -- no Join with A_ReversedLens 237 Join A_Getter A_ReversedPrism = A_Getter 238 Join A_Getter A_Prism = An_AffineFold 239 -- no Join with A_Review 240 Join A_Getter A_Lens = A_Getter 241 Join A_Getter An_AffineTraversal = An_AffineFold 242 Join A_Getter An_AffineFold = An_AffineFold 243 Join A_Getter A_Traversal = A_Fold 244 Join A_Getter A_Fold = A_Fold 245 -- no Join with A_Setter 246 247 -- An_AffineTraversal----- 248 Join An_AffineTraversal An_Iso = An_AffineTraversal 249 -- no Join with A_ReversedLens 250 Join An_AffineTraversal A_ReversedPrism = An_AffineFold 251 Join An_AffineTraversal A_Prism = An_AffineTraversal 252 -- no Join with A_Review 253 Join An_AffineTraversal A_Lens = An_AffineTraversal 254 Join An_AffineTraversal A_Getter = An_AffineFold 255 Join An_AffineTraversal An_AffineFold = An_AffineFold 256 Join An_AffineTraversal A_Traversal = A_Traversal 257 Join An_AffineTraversal A_Fold = A_Fold 258 Join An_AffineTraversal A_Setter = A_Setter 259 260 -- An_AffineFold----- 261 Join An_AffineFold An_Iso = An_AffineFold 262 -- no Join with A_ReversedLens 263 Join An_AffineFold A_ReversedPrism = An_AffineFold 264 Join An_AffineFold A_Prism = An_AffineFold 265 -- no Join with A_Review 266 Join An_AffineFold A_Lens = An_AffineFold 267 Join An_AffineFold A_Getter = An_AffineFold 268 Join An_AffineFold An_AffineTraversal = An_AffineFold 269 Join An_AffineFold A_Traversal = A_Fold 270 Join An_AffineFold A_Fold = A_Fold 271 -- no Join with A_Setter 272 273 -- A_Traversal----- 274 Join A_Traversal An_Iso = A_Traversal 275 -- no Join with A_ReversedLens 276 Join A_Traversal A_ReversedPrism = A_Fold 277 Join A_Traversal A_Prism = A_Traversal 278 -- no Join with A_Review 279 Join A_Traversal A_Lens = A_Traversal 280 Join A_Traversal A_Getter = A_Fold 281 Join A_Traversal An_AffineTraversal = A_Traversal 282 Join A_Traversal An_AffineFold = A_Fold 283 Join A_Traversal A_Fold = A_Fold 284 Join A_Traversal A_Setter = A_Setter 285 286 -- A_Fold----- 287 Join A_Fold An_Iso = A_Fold 288 -- no Join with A_ReversedLens 289 Join A_Fold A_ReversedPrism = A_Fold 290 Join A_Fold A_Prism = A_Fold 291 -- no Join with A_Review 292 Join A_Fold A_Lens = A_Fold 293 Join A_Fold A_Getter = A_Fold 294 Join A_Fold An_AffineTraversal = A_Fold 295 Join A_Fold An_AffineFold = A_Fold 296 Join A_Fold A_Traversal = A_Fold 297 -- no Join with A_Setter 298 299 -- A_Setter----- 300 Join A_Setter An_Iso = A_Setter 301 -- no Join with A_ReversedLens 302 -- no Join with A_ReversedPrism 303 Join A_Setter A_Prism = A_Setter 304 -- no Join with A_Review 305 Join A_Setter A_Lens = A_Setter 306 -- no Join with A_Getter 307 Join A_Setter An_AffineTraversal = A_Setter 308 -- no Join with An_AffineFold 309 Join A_Setter A_Traversal = A_Setter 310 -- no Join with A_Fold 311 312 -- END GENERATED CONTENT 313 314 -- Every optic kinds can be joined with itself. 315 Join k k = k 316 317 -- Everything else is a type error. 318 Join k l = TypeError ('ShowType k 319 ':<>: 'Text " cannot be composed with " 320 ':<>: 'ShowType l) 321