{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE GADTs                     #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE Rank2Types                #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE TypeFamilyDependencies    #-}
{-# LANGUAGE TypeOperators             #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Generics.Internal.Profunctor.Iso
-- Copyright   :  (C) 2020 Csongor Kiss
-- License     :  BSD3
-- Maintainer  :  Csongor Kiss <kiss.csongor.kiss@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Internal lens helpers. Only exported for Haddock
--
-----------------------------------------------------------------------------
module Data.Generics.Internal.Profunctor.Iso where

import Data.Profunctor.Indexed
import GHC.Generics           ((:*:)(..), (:+:)(..), Generic(..), M1(..), K1(..), Rep)
import Data.Generics.Internal.GenericN (Rec (..))

-- import qualified Data.Generics.Internal.VL.Iso as VL

type Iso s t a b
  = forall p i. (Profunctor p) => p i a b -> p i s t

type Iso' s a = Iso s s a a

-- | A type and its generic representation are isomorphic
repIso :: (Generic a, Generic b) => Iso a b (Rep a x) (Rep b x)
repIso :: Iso a b (Rep a x) (Rep b x)
repIso = (a -> Rep a x) -> (Rep b x -> b) -> Iso a b (Rep a x) (Rep b x)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso a -> Rep a x
forall a x. Generic a => a -> Rep a x
from Rep b x -> b
forall a x. Generic a => Rep a x -> a
to

-- | 'M1' is just a wrapper around `f p`
--mIso :: Iso' (M1 i c f p) (f p)
mIso :: Iso (M1 i c f p) (M1 i c g p) (f p) (g p)
mIso :: p i (f p) (g p) -> p i (M1 i c f p) (M1 i c g p)
mIso = (M1 i c f p -> f p)
-> (g p -> M1 i c g p) -> Iso (M1 i c f p) (M1 i c g p) (f p) (g p)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso M1 i c f p -> f p
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 g p -> M1 i c g p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1
{-# INLINE mIso #-}

kIso :: Iso (K1 r a p) (K1 r b p) a b
kIso :: p i a b -> p i (K1 r a p) (K1 r b p)
kIso = (K1 r a p -> a) -> (b -> K1 r b p) -> Iso (K1 r a p) (K1 r b p) a b
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso K1 r a p -> a
forall i c k (p :: k). K1 i c p -> c
unK1 b -> K1 r b p
forall k i c (p :: k). c -> K1 i c p
K1
{-# INLINE kIso #-}

recIso :: Iso (Rec r a p) (Rec r b p) a b
recIso :: p i a b -> p i (Rec r a p) (Rec r b p)
recIso = (Rec r a p -> a)
-> (b -> Rec r b p) -> Iso (Rec r a p) (Rec r b p) a b
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (K1 R a p -> a
forall i c k (p :: k). K1 i c p -> c
unK1 (K1 R a p -> a) -> (Rec r a p -> K1 R a p) -> Rec r a p -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec r a p -> K1 R a p
forall p a k (x :: k). Rec p a x -> K1 R a x
unRec) (K1 R b p -> Rec r b p
forall k p a (x :: k). K1 R a x -> Rec p a x
Rec (K1 R b p -> Rec r b p) -> (b -> K1 R b p) -> b -> Rec r b p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> K1 R b p
forall k i c (p :: k). c -> K1 i c p
K1)
{-# INLINE recIso #-}

sumIso :: Iso ((a :+: b) x) ((a' :+: b') x) (Either (a x) (b x)) (Either (a' x) (b' x))
sumIso :: p i (Either (a x) (b x)) (Either (a' x) (b' x))
-> p i ((:+:) a b x) ((:+:) a' b' x)
sumIso = ((:+:) a b x -> Either (a x) (b x))
-> (Either (a' x) (b' x) -> (:+:) a' b' x)
-> Iso
     ((:+:) a b x)
     ((:+:) a' b' x)
     (Either (a x) (b x))
     (Either (a' x) (b' x))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (:+:) a b x -> Either (a x) (b x)
forall (f :: * -> *) (g :: * -> *) p.
(:+:) f g p -> Either (f p) (g p)
back Either (a' x) (b' x) -> (:+:) a' b' x
forall (f :: * -> *) p (g :: * -> *).
Either (f p) (g p) -> (:+:) f g p
forth
  where forth :: Either (f p) (g p) -> (:+:) f g p
forth (Left f p
l)  = f p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 f p
l
        forth (Right g p
r) = g p -> (:+:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 g p
r
        back :: (:+:) f g p -> Either (f p) (g p)
back (L1 f p
l) = f p -> Either (f p) (g p)
forall a b. a -> Either a b
Left f p
l
        back (R1 g p
r) = g p -> Either (f p) (g p)
forall a b. b -> Either a b
Right g p
r
{-# INLINE sumIso #-}

prodIso :: Iso ((a :*: b) x) ((a' :*: b') x) (a x, b x) (a' x, b' x)
prodIso :: p i (a x, b x) (a' x, b' x) -> p i ((:*:) a b x) ((:*:) a' b' x)
prodIso = ((:*:) a b x -> (a x, b x))
-> ((a' x, b' x) -> (:*:) a' b' x)
-> Iso ((:*:) a b x) ((:*:) a' b' x) (a x, b x) (a' x, b' x)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\(a x
a :*: b x
b) -> (a x
a, b x
b)) (\(a' x
a, b' x
b) -> (a' x
a a' x -> b' x -> (:*:) a' b' x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b' x
b))

assoc3 :: Iso ((a, b), c) ((a', b'), c') (a, (b, c)) (a', (b', c'))
assoc3 :: p i (a, (b, c)) (a', (b', c')) -> p i ((a, b), c) ((a', b'), c')
assoc3 = (((a, b), c) -> (a, (b, c)))
-> ((a', (b', c')) -> ((a', b'), c'))
-> Iso ((a, b), c) ((a', b'), c') (a, (b, c)) (a', (b', c'))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\((a
a, b
b), c
c) -> (a
a, (b
b, c
c))) (\(a'
a, (b'
b, c'
c)) -> ((a'
a, b'
b), c'
c))

--------------------------------------------------------------------------------
-- Iso stuff

fromIso :: Iso s t a b -> Iso b a t s
fromIso :: Iso s t a b -> Iso b a t s
fromIso Iso s t a b
l = Iso s t a b
-> ((s -> a) -> (b -> t) -> p i t s -> p i b a)
-> p i t s
-> p i 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
l (((s -> a) -> (b -> t) -> p i t s -> p i b a)
 -> p i t s -> p i b a)
-> ((s -> a) -> (b -> t) -> p i t s -> p i b a)
-> p i t s
-> p i b a
forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt -> (b -> t) -> (s -> a) -> Iso b a t s
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso b -> t
bt s -> a
sa
{-# INLINE fromIso #-}

iso :: (s -> a) -> (b -> t) -> Iso s t a b
iso :: (s -> a) -> (b -> t) -> Iso s t a b
iso s -> a
sa b -> t
bt = (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
sa b -> t
bt
{-# INLINE iso #-}

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
ai (s -> a) -> (b -> t) -> r
k = case Exchange a b Any a b -> Exchange a b Any s t
Iso s t a b
ai ((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 s -> a
sa b -> t
bt -> (s -> a) -> (b -> t) -> r
k s -> a
sa b -> t
bt

pairing :: Iso s t a b -> Iso s' t' a' b' -> Iso (s, s') (t, t') (a, a') (b, b')
pairing :: Iso s t a b
-> Iso s' t' a' b' -> Iso (s, s') (t, t') (a, a') (b, b')
pairing Iso s t a b
f Iso s' t' a' b'
g = Iso s t a b
-> ((s -> a)
    -> (b -> t) -> p i (a, a') (b, b') -> p i (s, s') (t, t'))
-> p i (a, a') (b, b')
-> p i (s, s') (t, t')
forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s t a b
f (((s -> a)
  -> (b -> t) -> p i (a, a') (b, b') -> p i (s, s') (t, t'))
 -> p i (a, a') (b, b') -> p i (s, s') (t, t'))
-> ((s -> a)
    -> (b -> t) -> p i (a, a') (b, b') -> p i (s, s') (t, t'))
-> p i (a, a') (b, b')
-> p i (s, s') (t, t')
forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt -> Iso s' t' a' b'
-> ((s' -> a')
    -> (b' -> t') -> p i (a, a') (b, b') -> p i (s, s') (t, t'))
-> p i (a, a') (b, b')
-> p i (s, s') (t, t')
forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s' t' a' b'
g (((s' -> a')
  -> (b' -> t') -> p i (a, a') (b, b') -> p i (s, s') (t, t'))
 -> p i (a, a') (b, b') -> p i (s, s') (t, t'))
-> ((s' -> a')
    -> (b' -> t') -> p i (a, a') (b, b') -> p i (s, s') (t, t'))
-> p i (a, a') (b, b')
-> p i (s, s') (t, t')
forall a b. (a -> b) -> a -> b
$ \s' -> a'
s'a' b' -> t'
b't' ->
  ((s, s') -> (a, a'))
-> ((b, b') -> (t, t')) -> Iso (s, s') (t, t') (a, a') (b, b')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ((s -> a) -> (s' -> a') -> (s, s') -> (a, a')
forall t a t b. (t -> a) -> (t -> b) -> (t, t) -> (a, b)
bmap s -> a
sa s' -> a'
s'a') ((b -> t) -> (b' -> t') -> (b, b') -> (t, t')
forall t a t b. (t -> a) -> (t -> b) -> (t, t) -> (a, b)
bmap b -> t
bt b' -> t'
b't')
  where bmap :: (t -> a) -> (t -> b) -> (t, t) -> (a, b)
bmap t -> a
f' t -> b
g' (t
a, t
b) = (t -> a
f' t
a, t -> b
g' t
b)