1-- |
2-- Module: Optics.IxGetter
3-- Description: An indexed version of a 'Optics.Getter.Getter'.
4--
5-- An 'IxGetter' is an indexed version of a 'Optics.Getter.Getter'. See the
6-- "Indexed optics" section of the overview documentation in the @Optics@ module
7-- of the main @optics@ package for more details on indexed optics.
8--
9module Optics.IxGetter
10  (
11  -- * Formation
12    IxGetter
13
14  -- * Introduction
15  , ito
16  , selfIndex
17
18  -- * Elimination
19  , iview
20  , iviews
21
22  -- * Subtyping
23  , A_Getter
24  ) where
25
26import Data.Profunctor.Indexed
27
28import Optics.Internal.Bi
29import Optics.Internal.Indexed
30import Optics.Internal.Optic
31import Optics.Internal.Utils
32
33-- | Type synonym for an indexed getter.
34type IxGetter i s a = Optic' A_Getter (WithIx i) s a
35
36-- | Build an indexed getter from a function.
37--
38-- >>> iview (ito id) ('i', 'x')
39-- ('i','x')
40ito :: (s -> (i, a)) -> IxGetter i s a
41ito f = Optic (lmap f . ilinear uncurry' . rphantom)
42{-# INLINE ito #-}
43
44-- | Use a value itself as its own index. This is essentially an indexed version
45-- of 'Optics.Iso.equality'.
46selfIndex :: IxGetter a a a
47selfIndex = ito (\a -> (a, a))
48{-# INLINE selfIndex #-}
49
50-- | View the value pointed to by an indexed getter.
51iview
52  :: (Is k A_Getter, is `HasSingleIndex` i)
53  => Optic' k is s a -> s -> (i, a)
54iview o = iviews o (,)
55{-# INLINE iview #-}
56
57-- | View the function of the value pointed to by an indexed getter.
58iviews
59  :: (Is k A_Getter,  is `HasSingleIndex` i)
60  => Optic' k is s a -> (i -> a -> r) -> s -> r
61iviews o = \f ->
62  runIxForget (getOptic (castOptic @A_Getter o) (IxForget f)) id
63{-# INLINE iviews #-}
64