-- |
-- Module: Optics.Mapping
-- Description: Lifting optics using 'Functor's 'map'.
--
-- This module defines 'mapping', which turns an @'Optic'' k 'NoIx' s a@ into an
-- @'Optic'' ('MappedOptic' k) 'NoIx' (f s) (f a)@, in other words optic operating on values
-- in a 'Functor'.
--
{-# LANGUAGE DataKinds #-}
module Optics.Mapping
  ( MappingOptic (..)
  ) where

import Optics.Getter
import Optics.Internal.Indexed
import Optics.Internal.Optic
import Optics.Iso
import Optics.Review

-- $setup
-- >>> import Optics.Core
-- >>> import Optics.Operators

-- | Class for optics supporting 'mapping' through a 'Functor'.
--
-- @since 0.3
class MappingOptic k f g s t a b where
  -- | Type family that maps an optic to the optic kind produced by
  -- 'mapping' using it.
  type MappedOptic k

  -- | The 'Optics.Mapping.mapping' can be used to lift optic through a 'Functor'.
  --
  -- @
  -- 'mapping' :: 'Iso'    s t a b -> 'Iso'    (f s) (g t) (f a) (g b)
  -- 'mapping' :: 'Optics.Lens.Lens'   s   a   -> 'Getter' (f s)       (f a)
  -- 'mapping' :: 'Getter' s   a   -> 'Getter' (f s)       (f a)
  -- 'mapping' :: 'Optics.Prism.Prism'    t   b -> 'Review'       (g t)       (g b)
  -- 'mapping' :: 'Review'   t   b -> 'Review'       (g t)       (g b)
  -- @
  mapping
    :: "mapping" `AcceptsEmptyIndices` is
    => Optic k               is s t a b
    -> Optic (MappedOptic k) is (f s) (g t) (f a) (g b)

instance (Functor f, Functor g) => MappingOptic An_Iso f g s t a b where
  type MappedOptic An_Iso = An_Iso
  mapping :: Optic An_Iso is s t a b
-> Optic (MappedOptic An_Iso) is (f s) (g t) (f a) (g b)
mapping Optic An_Iso is s t a b
k = Iso s t a b
-> ((s -> a) -> (b -> t) -> Iso (f s) (g t) (f a) (g b))
-> Iso (f s) (g t) (f a) (g b)
forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind) (r :: OpticKind).
Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Optic An_Iso is s t a b
Iso s t a b
k (((s -> a) -> (b -> t) -> Iso (f s) (g t) (f a) (g b))
 -> Iso (f s) (g t) (f a) (g b))
-> ((s -> a) -> (b -> t) -> Iso (f s) (g t) (f a) (g b))
-> Iso (f s) (g t) (f a) (g b)
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \s -> a
sa b -> t
bt -> (f s -> f a) -> (g b -> g t) -> Iso (f s) (g t) (f a) (g b)
forall (s :: OpticKind) (a :: OpticKind) (b :: OpticKind)
       (t :: OpticKind).
(s -> a) -> (b -> t) -> Iso s t a b
iso ((s -> a) -> f s -> f a
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap s -> a
sa) ((b -> t) -> g b -> g t
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap b -> t
bt)
  {-# INLINE mapping #-}

-- Getter-y optics

-- | 
-- >>> [('a', True), ('b', False)] ^. _1 %& mapping
-- "ab"
--
-- >>> let v = [[ (('a', True), "foo"), (('b', False), "bar")], [ (('c', True), "xyz") ] ]
-- >>> v ^. _1 % _2 %& mapping %& mapping
-- [[True,False],[True]]
--
instance (Functor f, f ~ g, s ~ t, a ~ b) => MappingOptic A_Getter f g s t a b where
  type MappedOptic A_Getter = A_Getter
  mapping :: Optic A_Getter is s t a b
-> Optic (MappedOptic A_Getter) is (f s) (g t) (f a) (g b)
mapping Optic A_Getter is s t a b
o = (f s -> f a) -> Getter (f s) (f a)
forall (s :: OpticKind) (a :: OpticKind). (s -> a) -> Getter s a
to ((s -> a) -> f s -> f a
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap (Optic' A_Getter is s a -> s -> a
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Getter is s a
Optic A_Getter is s t a b
o))
  {-# INLINE mapping #-}

instance (Functor f, f ~ g, s ~ t, a ~ b) => MappingOptic A_ReversedPrism f g s t a b where
  type MappedOptic A_ReversedPrism = A_Getter
  mapping :: Optic A_ReversedPrism is s t a b
-> Optic (MappedOptic A_ReversedPrism) is (f s) (g t) (f a) (g b)
mapping Optic A_ReversedPrism is s t a b
o = (f s -> f a) -> Getter (f s) (f a)
forall (s :: OpticKind) (a :: OpticKind). (s -> a) -> Getter s a
to ((s -> a) -> f s -> f a
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap (Optic' A_ReversedPrism is s a -> s -> a
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_ReversedPrism is s a
Optic A_ReversedPrism is s t a b
o))
  {-# INLINE mapping #-}

instance (Functor f, f ~ g, s ~ t, a ~ b) => MappingOptic A_Lens f g s t a b where
  type MappedOptic A_Lens = A_Getter
  mapping :: Optic A_Lens is s t a b
-> Optic (MappedOptic A_Lens) is (f s) (g t) (f a) (g b)
mapping Optic A_Lens is s t a b
o = (f s -> f a) -> Getter (f s) (f a)
forall (s :: OpticKind) (a :: OpticKind). (s -> a) -> Getter s a
to ((s -> a) -> f s -> f a
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap (Optic' A_Lens is s a -> s -> a
forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (a :: OpticKind).
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens is s a
Optic A_Lens is s t a b
o))
  {-# INLINE mapping #-}

-- Review-y optics

instance (Functor f, f ~ g, s ~ t, a ~ b) => MappingOptic A_Review f g s t a b where
  type MappedOptic A_Review = A_Review
  mapping :: Optic A_Review is s t a b
-> Optic (MappedOptic A_Review) is (f s) (g t) (f a) (g b)
mapping Optic A_Review is s t a b
o = (f a -> f s) -> Review (f s) (f a)
forall (b :: OpticKind) (t :: OpticKind). (b -> t) -> Review t b
unto ((a -> s) -> f a -> f s
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap (Optic' A_Review is s a -> a -> s
forall (k :: OpticKind) (is :: IxList) (t :: OpticKind)
       (b :: OpticKind).
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' A_Review is s a
Optic A_Review is s t a b
o))
  {-# INLINE mapping #-}

instance (Functor f, f ~ g, s ~ t, a ~ b) => MappingOptic A_Prism f g s t a b where
  type MappedOptic A_Prism = A_Review
  mapping :: Optic A_Prism is s t a b
-> Optic (MappedOptic A_Prism) is (f s) (g t) (f a) (g b)
mapping Optic A_Prism is s t a b
o = (f a -> f s) -> Review (f s) (f a)
forall (b :: OpticKind) (t :: OpticKind). (b -> t) -> Review t b
unto ((a -> s) -> f a -> f s
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap (Optic' A_Prism is s a -> a -> s
forall (k :: OpticKind) (is :: IxList) (t :: OpticKind)
       (b :: OpticKind).
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' A_Prism is s a
Optic A_Prism is s t a b
o))
  {-# INLINE mapping #-}

instance (Functor f, f ~ g, s ~ t, a ~ b) => MappingOptic A_ReversedLens f g s t a b where
  type MappedOptic A_ReversedLens = A_Review
  mapping :: Optic A_ReversedLens is s t a b
-> Optic (MappedOptic A_ReversedLens) is (f s) (g t) (f a) (g b)
mapping Optic A_ReversedLens is s t a b
o = (f a -> f s) -> Review (f s) (f a)
forall (b :: OpticKind) (t :: OpticKind). (b -> t) -> Review t b
unto ((a -> s) -> f a -> f s
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap (Optic' A_ReversedLens is s a -> a -> s
forall (k :: OpticKind) (is :: IxList) (t :: OpticKind)
       (b :: OpticKind).
Is k A_Review =>
Optic' k is t b -> b -> t
review Optic' A_ReversedLens is s a
Optic A_ReversedLens is s t a b
o))
  {-# INLINE mapping #-}