-- |
-- Module: Optics.Iso
-- Description: Translates between types with the same structure.
--
-- An 'Iso'morphism expresses the fact that two types have the
-- same structure, and hence can be converted from one to the other in
-- either direction.
--
module Optics.Iso
  (
  -- * Formation
    Iso
  , Iso'

  -- * Introduction
  , iso

  -- * Elimination
  -- | An 'Iso' is in particular a 'Optics.Getter.Getter', a
  -- 'Optics.Review.Review' and a 'Optics.Setter.Setter', therefore you can
  -- specialise types to obtain:
  --
  -- @
  -- 'Optics.Getter.view'   :: 'Iso'' s a -> s -> a
  -- 'Optics.Review.review' :: 'Iso'' s a -> a -> s
  -- @
  --
  -- @
  -- 'Optics.Setter.over'   :: 'Iso' s t a b -> (a -> b) -> s -> t
  -- 'Optics.Setter.set'    :: 'Iso' s t a b ->       b  -> s -> t
  -- @
  --
  -- If you want to 'Optics.Getter.view' a type-modifying 'Iso' that is
  -- insufficiently polymorphic to be used as a type-preserving 'Iso'', use
  -- 'Optics.ReadOnly.getting':
  --
  -- @
  -- 'Optics.Getter.view' . 'Optics.ReadOnly.getting' :: 'Iso' s t a b -> s -> a
  -- @

  -- * Computation
  -- |
  --
  -- @
  -- 'Optics.Getter.view'   ('iso' f g) ≡ f
  -- 'Optics.Review.review' ('iso' f g) ≡ g
  -- @

  -- * Well-formedness
  -- | The functions translating back and forth must be mutually inverse:
  --
  -- @
  -- 'Optics.Getter.view' i . 'Optics.Getter.review' i ≡ 'id'
  -- 'Optics.Getter.review' i . 'Optics.Getter.view' i ≡ 'id'
  -- @

  -- * Additional introduction forms
  , equality
  , simple
  , coerced
  , coercedTo
  , coerced1
  , non
  , non'
  , anon
  , curried
  , uncurried
  , flipped
  , involuted
  , Swapped(..)

  -- * Additional elimination forms
  , withIso
  , au
  , under

  -- * Combinators
  -- | The 'Optics.Re.re' combinator can be used to reverse an 'Iso', and the
  -- 'Optics.Mapping.mapping' combinator to lift an 'Iso' to an 'Iso' on
  -- functorial values.
  --
  -- @
  -- 'Optics.Re.re'      ::                           'Iso' s t a b -> 'Iso' b a t s
  -- 'Optics.Mapping.mapping' :: (Functor f, Functor g) => 'Iso' s t a b -> 'Iso' (f s) (g t) (f a) (g b)
  -- @

  -- * Subtyping
  , An_Iso
  -- | <<diagrams/Iso.png Iso in the optics hierarchy>>
  )
  where

import Data.Tuple
import Data.Bifunctor
import Data.Coerce
import Data.Maybe

import Data.Profunctor.Indexed

import Optics.AffineFold
import Optics.Prism
import Optics.Review
import Optics.Internal.Optic

-- | Type synonym for a type-modifying iso.
type Iso s t a b = Optic An_Iso NoIx s t a b

-- | Type synonym for a type-preserving iso.
type Iso' s a = Optic' An_Iso NoIx s a

-- | Build an iso from a pair of inverse functions.
--
-- If you want to build an 'Iso' from the van Laarhoven representation, use
-- @isoVL@ from the @optics-vl@ package.
iso :: (s -> a) -> (b -> t) -> Iso s t a b
iso :: (s -> a) -> (b -> t) -> Iso s t a b
iso s -> a
f b -> t
g = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ An_Iso p i (Curry NoIx i) s t a b)
-> Iso 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 ((s -> a) -> (b -> t) -> p i a b -> p i s t
forall (p :: * -> * -> * -> *) a b c d i.
Profunctor p =>
(a -> b) -> (c -> d) -> p i b c -> p i a d
dimap s -> a
f b -> t
g)
{-# INLINE iso #-}

-- | Extract the two components of an isomorphism.
withIso :: Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso :: Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s t a b
o (s -> a) -> (b -> t) -> r
k = case Iso s t a b -> Optic__ (Exchange a b) Any (Curry NoIx Any) s t a b
forall (p :: * -> * -> * -> *) k (is :: IxList) s t a b i.
Profunctor p =>
Optic k is s t a b -> Optic_ k p i (Curry is i) s t a b
getOptic Iso s t a b
o ((a -> a) -> (b -> b) -> Exchange a b Any a b
forall a b i s t. (s -> a) -> (b -> t) -> Exchange a b i s t
Exchange a -> a
forall a. a -> a
id b -> b
forall a. a -> a
id) of
  Exchange sa bt -> (s -> a) -> (b -> t) -> r
k s -> a
sa b -> t
bt
{-# INLINE withIso #-}

-- | Based on @ala@ from Conor McBride's work on Epigram.
--
-- This version is generalized to accept any 'Iso', not just a @newtype@.
--
-- >>> au (coerced1 @Sum) foldMap [1,2,3,4]
-- 10
--
-- You may want to think of this combinator as having the following, simpler
-- type:
--
-- @
-- au :: 'Iso' s t a b -> ((b -> t) -> e -> s) -> e -> a
-- @
au :: Functor f => Iso s t a b -> ((b -> t) -> f s) -> f a
au :: Iso s t a b -> ((b -> t) -> f s) -> f a
au Iso s t a b
k = Iso s t a b
-> ((s -> a) -> (b -> t) -> ((b -> t) -> f s) -> f a)
-> ((b -> t) -> f s)
-> f a
forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s t a b
k (((s -> a) -> (b -> t) -> ((b -> t) -> f s) -> f a)
 -> ((b -> t) -> f s) -> f a)
-> ((s -> a) -> (b -> t) -> ((b -> t) -> f s) -> f a)
-> ((b -> t) -> f s)
-> f a
forall a b. (a -> b) -> a -> b
$ \s -> a
sa b -> t
bt (b -> t) -> f s
f -> s -> a
sa (s -> a) -> f s -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (b -> t) -> f s
f b -> t
bt
{-# INLINE au #-}

-- | The opposite of working 'Optics.Setter.over' a 'Optics.Setter.Setter' is
-- working 'under' an isomorphism.
--
-- @
-- 'under' ≡ 'Optics.Setter.over' '.' 'Optics.Re.re'
-- @
under :: Iso s t a b -> (t -> s) -> b -> a
under :: Iso s t a b -> (t -> s) -> b -> a
under Iso s t a b
k = Iso s t a b
-> ((s -> a) -> (b -> t) -> (t -> s) -> b -> a)
-> (t -> s)
-> b
-> a
forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s t a b
k (((s -> a) -> (b -> t) -> (t -> s) -> b -> a)
 -> (t -> s) -> b -> a)
-> ((s -> a) -> (b -> t) -> (t -> s) -> b -> a)
-> (t -> s)
-> b
-> a
forall a b. (a -> b) -> a -> b
$ \s -> a
sa b -> t
bt t -> s
ts -> s -> a
sa (s -> a) -> (b -> s) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> s
ts (t -> s) -> (b -> t) -> b -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> t
bt
{-# INLINE under #-}

----------------------------------------
-- Isomorphisms

-- | Capture type constraints as an isomorphism.
--
-- /Note:/ This is the identity optic:
--
-- >>> :t view equality
-- view equality :: a -> a
equality :: (s ~ a, t ~ b) => Iso s t a b
equality :: Iso s t a b
equality = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ An_Iso p i (Curry NoIx i) s t a b)
-> Iso 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 a. a -> a
forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ An_Iso p i (Curry NoIx i) s t a b
id
{-# INLINE equality #-}

-- | Proof of reflexivity.
simple :: Iso' a a
simple :: Iso' a a
simple = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ An_Iso p i (Curry NoIx i) a a a a)
-> Iso' a a
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 a. a -> a
forall (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ An_Iso p i (Curry NoIx i) a a a a
id
{-# INLINE simple #-}

-- | Data types that are representationally equal are isomorphic.
--
-- >>> view coerced 'x' :: Identity Char
-- Identity 'x'
--
coerced :: (Coercible s a, Coercible t b) => Iso s t a b
coerced :: Iso s t a b
coerced = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ An_Iso p i (Curry NoIx i) s t a b)
-> Iso 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 (p i a t -> p i s t
forall (p :: * -> * -> * -> *) a b i c.
(Profunctor p, Coercible a b) =>
p i a c -> p i b c
lcoerce' (p i a t -> p i s t) -> (p i a b -> p i a t) -> p i a b -> p i s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i a b -> p i a t
forall (p :: * -> * -> * -> *) a b i c.
(Profunctor p, Coercible a b) =>
p i c a -> p i c b
rcoerce')
{-# INLINE coerced #-}

-- | Type-preserving version of 'coerced' with type parameters rearranged for
-- TypeApplications.
--
-- >>> newtype MkInt = MkInt Int deriving Show
--
-- >>> over (coercedTo @Int) (*3) (MkInt 2)
-- MkInt 6
--
coercedTo :: forall a s. Coercible s a => Iso' s a
coercedTo :: Iso' s a
coercedTo = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ An_Iso p i (Curry NoIx i) s s a a)
-> Iso' s a
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 (p i a s -> p i s s
forall (p :: * -> * -> * -> *) a b i c.
(Profunctor p, Coercible a b) =>
p i a c -> p i b c
lcoerce' (p i a s -> p i s s) -> (p i a a -> p i a s) -> p i a a -> p i s s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i a a -> p i a s
forall (p :: * -> * -> * -> *) a b i c.
(Profunctor p, Coercible a b) =>
p i c a -> p i c b
rcoerce')
{-# INLINE coercedTo #-}

-- | Special case of 'coerced' for trivial newtype wrappers.
--
-- >>> over (coerced1 @Identity) (++ "bar") (Identity "foo")
-- Identity "foobar"
--
coerced1
  :: forall f s a. (Coercible s (f s), Coercible a (f a))
  => Iso (f s) (f a) s a
coerced1 :: Iso (f s) (f a) s a
coerced1 = (forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ An_Iso p i (Curry NoIx i) (f s) (f a) s a)
-> Iso (f s) (f a) s a
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 (p i s (f a) -> p i (f s) (f a)
forall (p :: * -> * -> * -> *) a b i c.
(Profunctor p, Coercible a b) =>
p i a c -> p i b c
lcoerce' (p i s (f a) -> p i (f s) (f a))
-> (p i s a -> p i s (f a)) -> p i s a -> p i (f s) (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i s a -> p i s (f a)
forall (p :: * -> * -> * -> *) a b i c.
(Profunctor p, Coercible a b) =>
p i c a -> p i c b
rcoerce')
{-# INLINE coerced1 #-}

-- | If @v@ is an element of a type @a@, and @a'@ is @a@ sans the element @v@,
-- then @'non' v@ is an isomorphism from @'Maybe' a'@ to @a@.
--
-- @
-- 'non' ≡ 'non'' '.' 'only'
-- @
--
-- Keep in mind this is only a real isomorphism if you treat the domain as being
-- @'Maybe' (a sans v)@.
--
-- This is practically quite useful when you want to have a 'Data.Map.Map' where
-- all the entries should have non-zero values.
--
-- >>> Map.fromList [("hello",1)] & at "hello" % non 0 %~ (+2)
-- fromList [("hello",3)]
--
-- >>> Map.fromList [("hello",1)] & at "hello" % non 0 %~ (subtract 1)
-- fromList []
--
-- >>> Map.fromList [("hello",1)] ^. at "hello" % non 0
-- 1
--
-- >>> Map.fromList [] ^. at "hello" % non 0
-- 0
--
-- This combinator is also particularly useful when working with nested maps.
--
-- /e.g./ When you want to create the nested 'Data.Map.Map' when it is missing:
--
-- >>> Map.empty & at "hello" % non Map.empty % at "world" ?~ "!!!"
-- fromList [("hello",fromList [("world","!!!")])]
--
-- and when have deleting the last entry from the nested 'Data.Map.Map' mean
-- that we should delete its entry from the surrounding one:
--
-- >>> Map.fromList [("hello", Map.fromList [("world","!!!")])] & at "hello" % non Map.empty % at "world" .~ Nothing
-- fromList []
--
-- It can also be used in reverse to exclude a given value:
--
-- >>> non 0 # rem 10 4
-- Just 2
--
-- >>> non 0 # rem 10 5
-- Nothing
--
-- @since 0.2
non :: Eq a => a -> Iso' (Maybe a) a
non :: a -> Iso' (Maybe a) a
non = Prism' a () -> Iso' (Maybe a) a
forall a. Prism' a () -> Iso' (Maybe a) a
non' (Prism' a () -> Iso' (Maybe a) a)
-> (a -> Prism' a ()) -> a -> Iso' (Maybe a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Prism' a ()
forall a. Eq a => a -> Prism' a ()
only
{-# INLINE non #-}

-- | @'non'' p@ generalizes @'non' (p # ())@ to take any unit 'Prism'
--
-- This function generates an isomorphism between @'Maybe' (a | 'isn't' p a)@
-- and @a@.
--
-- >>> Map.singleton "hello" Map.empty & at "hello" % non' _Empty % at "world" ?~ "!!!"
-- fromList [("hello",fromList [("world","!!!")])]
--
-- >>> Map.fromList [("hello", Map.fromList [("world","!!!")])] & at "hello" % non' _Empty % at "world" .~ Nothing
-- fromList []
--
-- @since 0.2
non' :: Prism' a () -> Iso' (Maybe a) a
non' :: Prism' a () -> Iso' (Maybe a) a
non' Prism' a ()
p = (Maybe a -> a) -> (a -> Maybe a) -> Iso' (Maybe a) a
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def) a -> Maybe a
go where
  def :: a
def                = Prism' a () -> () -> a
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Prism' a ()
p ()
  go :: a -> Maybe a
go a
b | Prism' a ()
p Prism' a () -> a -> Bool
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Bool
`isn't` a
b = a -> Maybe a
forall a. a -> Maybe a
Just a
b
       | Bool
otherwise   = Maybe a
forall a. Maybe a
Nothing
{-# INLINE non' #-}

-- | @'anon' a p@ generalizes @'non' a@ to take any value and a predicate.
--
-- @
-- 'anon' a ≡ 'non'' '.' 'nearly' a
-- @
--
-- This function assumes that @p a@ holds @'True'@ and generates an isomorphism
-- between @'Maybe' (a | 'not' (p a))@ and @a@.
--
-- >>> Map.empty & at "hello" % anon Map.empty Map.null % at "world" ?~ "!!!"
-- fromList [("hello",fromList [("world","!!!")])]
--
-- >>> Map.fromList [("hello", Map.fromList [("world","!!!")])] & at "hello" % anon Map.empty Map.null % at "world" .~ Nothing
-- fromList []
--
-- @since 0.2
anon :: a -> (a -> Bool) -> Iso' (Maybe a) a
anon :: a -> (a -> Bool) -> Iso' (Maybe a) a
anon a
a = Prism' a () -> Iso' (Maybe a) a
forall a. Prism' a () -> Iso' (Maybe a) a
non' (Prism' a () -> Iso' (Maybe a) a)
-> ((a -> Bool) -> Prism' a ()) -> (a -> Bool) -> Iso' (Maybe a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (a -> Bool) -> Prism' a ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly a
a
{-# INLINE anon #-}

-- | The canonical isomorphism for currying and uncurrying a function.
--
-- @
-- 'curried' = 'iso' 'curry' 'uncurry'
-- @
--
-- >>> view curried fst 3 4
-- 3
--
curried :: Iso ((a, b) -> c) ((d, e) -> f) (a -> b -> c) (d -> e -> f)
curried :: Iso ((a, b) -> c) ((d, e) -> f) (a -> b -> c) (d -> e -> f)
curried = (((a, b) -> c) -> a -> b -> c)
-> ((d -> e -> f) -> (d, e) -> f)
-> Iso ((a, b) -> c) ((d, e) -> f) (a -> b -> c) (d -> e -> f)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((a, b) -> c) -> a -> b -> c
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (d -> e -> f) -> (d, e) -> f
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry
{-# INLINE curried #-}

-- | The canonical isomorphism for uncurrying and currying a function.
--
-- @
-- 'uncurried' = 'iso' 'uncurry' 'curry'
-- @
--
-- @
-- 'uncurried' = 'Optics.Re.re' 'curried'
-- @
--
-- >>> (view uncurried (+)) (1,2)
-- 3
--
uncurried :: Iso (a -> b -> c) (d -> e -> f) ((a, b) -> c) ((d, e) -> f)
uncurried :: Iso (a -> b -> c) (d -> e -> f) ((a, b) -> c) ((d, e) -> f)
uncurried = ((a -> b -> c) -> (a, b) -> c)
-> (((d, e) -> f) -> d -> e -> f)
-> Iso (a -> b -> c) (d -> e -> f) ((a, b) -> c) ((d, e) -> f)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (a -> b -> c) -> (a, b) -> c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((d, e) -> f) -> d -> e -> f
forall a b c. ((a, b) -> c) -> a -> b -> c
curry
{-# INLINE uncurried #-}

-- | The isomorphism for flipping a function.
--
-- >>> (view flipped (,)) 1 2
-- (2,1)
--
flipped :: Iso (a -> b -> c) (a' -> b' -> c') (b -> a -> c) (b' -> a' -> c')
flipped :: Iso (a -> b -> c) (a' -> b' -> c') (b -> a -> c) (b' -> a' -> c')
flipped = ((a -> b -> c) -> b -> a -> c)
-> ((b' -> a' -> c') -> a' -> b' -> c')
-> Iso
     (a -> b -> c) (a' -> b' -> c') (b -> a -> c) (b' -> a' -> c')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (a -> b -> c) -> b -> a -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip (b' -> a' -> c') -> a' -> b' -> c'
forall a b c. (a -> b -> c) -> b -> a -> c
flip
{-# INLINE flipped #-}

-- | Given a function that is its own inverse, this gives you an 'Iso' using it
-- in both directions.
--
-- @
-- 'involuted' ≡ 'Control.Monad.join' 'iso'
-- @
--
-- >>> "live" ^. involuted reverse
-- "evil"
--
-- >>> "live" & involuted reverse %~ ('d':)
-- "lived"
involuted :: (a -> a) -> Iso' a a
involuted :: (a -> a) -> Iso' a a
involuted a -> a
a = (a -> a) -> (a -> a) -> Iso' a a
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso a -> a
a a -> a
a
{-# INLINE involuted #-}

-- | This class provides for symmetric bifunctors.
class Bifunctor p => Swapped p where
  -- |
  -- @
  -- 'swapped' '.' 'swapped' ≡ 'id'
  -- 'first' f '.' 'swapped' = 'swapped' '.' 'second' f
  -- 'second' g '.' 'swapped' = 'swapped' '.' 'first' g
  -- 'bimap' f g '.' 'swapped' = 'swapped' '.' 'bimap' g f
  -- @
  --
  -- >>> view swapped (1,2)
  -- (2,1)
  --
  swapped :: Iso (p a b) (p c d) (p b a) (p d c)

instance Swapped (,) where
  swapped :: Iso (a, b) (c, d) (b, a) (d, c)
swapped = ((a, b) -> (b, a))
-> ((d, c) -> (c, d)) -> Iso (a, b) (c, d) (b, a) (d, c)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (a, b) -> (b, a)
forall a b. (a, b) -> (b, a)
swap (d, c) -> (c, d)
forall a b. (a, b) -> (b, a)
swap
  {-# INLINE swapped #-}

instance Swapped Either where
  swapped :: Iso (Either a b) (Either c d) (Either b a) (Either d c)
swapped = (Either a b -> Either b a)
-> (Either d c -> Either c d)
-> Iso (Either a b) (Either c d) (Either b a) (Either d c)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((a -> Either b a) -> (b -> Either b a) -> Either a b -> Either b a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Either b a
forall a b. b -> Either a b
Right b -> Either b a
forall a b. a -> Either a b
Left) ((d -> Either c d) -> (c -> Either c d) -> Either d c -> Either c d
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either d -> Either c d
forall a b. b -> Either a b
Right c -> Either c d
forall a b. a -> Either a b
Left)
  {-# INLINE swapped #-}

-- $setup
-- >>> import qualified Data.Map as Map
-- >>> import Data.Functor.Identity
-- >>> import Data.Monoid
-- >>> import Optics.Core