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

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Generics.Internal.VL.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.VL.Iso where

import Data.Coerce (coerce)
import Data.Functor.Identity (Identity(..))
import Data.Profunctor
import GHC.Generics
import Data.Generics.Internal.GenericN (Rec (..), GenericN (..), Param (..))

import qualified Data.Generics.Internal.Profunctor.Iso as P

data Exchange a b s t = Exchange (s -> a) (b -> t)

instance Functor (Exchange a b s) where
  fmap :: forall a b. (a -> b) -> Exchange a b s a -> Exchange a b s b
fmap a -> b
f (Exchange s -> a
p b -> a
q) = forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange s -> a
p (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
q)
  {-# INLINE fmap #-}

instance Profunctor (Exchange a b) where
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Exchange a b b c -> Exchange a b a d
dimap a -> b
f c -> d
g (Exchange b -> a
sa b -> c
bt) = forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange (b -> a
sa forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (c -> d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
bt)
  {-# INLINE dimap #-}
  lmap :: forall a b c. (a -> b) -> Exchange a b b c -> Exchange a b a c
lmap a -> b
f (Exchange b -> a
sa b -> c
bt) = forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange (b -> a
sa forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) b -> c
bt
  {-# INLINE lmap #-}
  rmap :: forall b c a. (b -> c) -> Exchange a b a b -> Exchange a b a c
rmap b -> c
f (Exchange a -> a
sa b -> b
bt) = forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange a -> a
sa (b -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
bt)
  {-# INLINE rmap #-}

type Iso' s a
  = forall p f. (Profunctor p, Functor f) => p a (f a) -> p s (f s)

type Iso s t a b
  = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t)

fromIso :: Iso s t a b -> Iso b a t s
fromIso :: forall s t a b. Iso s t a b -> Iso b a t s
fromIso Iso s t a b
l = forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso Iso s t a b
l forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt -> forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso b -> t
bt s -> a
sa
{-# inline fromIso #-}

iso2isovl :: P.Iso s t a b -> Iso s t a b
iso2isovl :: forall s t a b. Iso s t a b -> Iso s t a b
iso2isovl Iso s t a b
_iso = forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
P.withIso Iso s t a b
_iso forall a b. (a -> b) -> a -> b
$ \ s -> a
sa b -> t
bt -> forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso s -> a
sa b -> t
bt
{-# INLINE iso2isovl #-}

-- | Extract the two functions, one from @s -> a@ and
-- one from @b -> t@ that characterize an 'Iso'.
withIso :: Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso :: forall s t a b r. 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 Iso s t a b
ai (forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange forall a. a -> a
id forall a. a -> Identity a
Identity) of
  Exchange s -> a
sa b -> Identity t
bt -> (s -> a) -> (b -> t) -> r
k s -> a
sa (coerce :: forall a b. Coercible a b => a -> b
coerce b -> Identity t
bt)
{-# inline withIso #-}

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

repIsoN :: (GenericN a, GenericN b) => Iso a b (RepN a x) (RepN b x)
repIsoN :: forall a b x.
(GenericN a, GenericN b) =>
Iso a b (RepN a x) (RepN b x)
repIsoN = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall a x. GenericN a => a -> RepN a x
fromN forall a x. GenericN a => RepN a x -> a
toN

paramIso :: Iso (Param n a) (Param n b) a b
paramIso :: forall (n :: Nat) a b. Iso (Param n a) (Param n b) a b
paramIso = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso forall (n :: Nat) a. Param n a -> a
getStarParam forall (n :: Nat) a. a -> Param n a
StarParam

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

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

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

prodIso :: Iso ((a :*: b) x) ((a' :*: b') x) (a x, b x) (a' x, b' x)
prodIso :: forall {k} (a :: k -> *) (b :: k -> *) (x :: k) (a' :: k -> *)
       (b' :: k -> *).
Iso ((:*:) a b x) ((:*:) a' b' x) (a x, b x) (a' x, b' x)
prodIso = 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 forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b' x
b))

iso :: (s -> a) -> (b -> t) -> Iso s t a b
iso :: forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso s -> a
sa b -> t
bt = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> a
sa (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> t
bt)
{-# INLINE iso #-}