{-|
Module      : Lens.Micro.Pro.Internal
Copyright   : (C) 2013-2016 Edward Kmett, 2018 Monadfix
License     : BSD-style (see the file LICENSE)

Definitions used internally by microlens. If you're going to use these, only
define instances for your own types, and don't export an API using these!
-}
{-# LANGUAGE FunctionalDependencies #-}
module Lens.Micro.Pro.Internal
    ( Strict(strict, lazy)

    , IsText(packed, unpacked)

    , Exchange(..), Exchange'
    , Market(..), Market'

    , Iso, Iso'
    , Prism, Prism'
    )
    where
--------------------------------------------------------------------------------
import Lens.Micro.Pro.Type
import Data.Coerce
import Data.Profunctor
import Data.Profunctor.Unsafe
--------------------------------------------------------------------------------

class Strict lazy strict | lazy -> strict, strict -> lazy where
    strict :: Iso' lazy   strict
    lazy   :: Iso' strict lazy

{- | This type is used internally to provide efficient access
to the two inverse functions behind an 'Iso'.
-}

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

type Exchange' a s = Exchange a a s s

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
sa b -> a
bt) = (s -> a) -> (b -> b) -> Exchange a b s b
forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange s -> a
sa (a -> b
f (a -> b) -> (b -> a) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
bt)
    {-# 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) = (a -> a) -> (b -> d) -> Exchange a b a d
forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange (b -> a
sa (b -> a) -> (a -> b) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (c -> d
g (c -> d) -> (b -> c) -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
bt)
    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) = (a -> a) -> (b -> c) -> Exchange a b a c
forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange (b -> a
sa (b -> a) -> (a -> b) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) b -> c
bt
    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) = (a -> a) -> (b -> c) -> Exchange a b a c
forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange a -> a
sa (b -> c
f (b -> c) -> (b -> b) -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
bt)

    {-# INLINE dimap #-}
    {-# INLINE lmap #-}
    {-# INLINE rmap #-}

    #. :: forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> Exchange a b a b -> Exchange a b a c
(#.) q b c
_ = Exchange a b a b -> Exchange a b a c
forall a b. Coercible a b => a -> b
coerce
    .# :: forall a b c (q :: * -> * -> *).
Coercible b a =>
Exchange a b b c -> q a b -> Exchange a b a c
(.#) Exchange a b b c
p q a b
_ = Exchange a b b c -> Exchange a b a c
forall a b. Coercible a b => a -> b
coerce Exchange a b b c
p

    {-# INLINE (#.) #-}
    {-# INLINE (.#) #-}

{- | This type is used internally by the Prism code to provide efficient access
to the two parts of a Prism, i.e. a constructor and a selector — see:
'Lens.Micro.Pro.prism'.
-}
data Market a b s t = Market (b -> t) (s -> Either t a)

instance Functor (Market a b s) where
  fmap :: forall a b. (a -> b) -> Market a b s a -> Market a b s b
fmap a -> b
f (Market b -> a
bt s -> Either a a
seta) = (b -> b) -> (s -> Either b a) -> Market a b s b
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market (a -> b
f (a -> b) -> (b -> a) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
bt) ((a -> Either b a) -> (a -> Either b a) -> Either a a -> Either b a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (b -> Either b a
forall a b. a -> Either a b
Left (b -> Either b a) -> (a -> b) -> a -> Either b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) a -> Either b a
forall a b. b -> Either a b
Right (Either a a -> Either b a) -> (s -> Either a a) -> s -> Either b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Either a a
seta)
  {-# INLINE fmap #-}

instance Profunctor (Market a b) where
    dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Market a b b c -> Market a b a d
dimap a -> b
f c -> d
g (Market b -> c
bt b -> Either c a
seta) =
        (b -> d) -> (a -> Either d a) -> Market a b a d
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market (c -> d
g (c -> d) -> (b -> c) -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
bt) ((c -> Either d a) -> (a -> Either d a) -> Either c a -> Either d a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (d -> Either d a
forall a b. a -> Either a b
Left (d -> Either d a) -> (c -> d) -> c -> Either d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
g) a -> Either d a
forall a b. b -> Either a b
Right (Either c a -> Either d a) -> (a -> Either c a) -> a -> Either d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either c a
seta (b -> Either c a) -> (a -> b) -> a -> Either c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

    lmap :: forall a b c. (a -> b) -> Market a b b c -> Market a b a c
lmap a -> b
f (Market b -> c
bt b -> Either c a
seta) = (b -> c) -> (a -> Either c a) -> Market a b a c
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market b -> c
bt (b -> Either c a
seta (b -> Either c a) -> (a -> b) -> a -> Either c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
    rmap :: forall b c a. (b -> c) -> Market a b a b -> Market a b a c
rmap b -> c
f (Market b -> b
bt a -> Either b a
seta) = (b -> c) -> (a -> Either c a) -> Market a b a c
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market (b -> c
f (b -> c) -> (b -> b) -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
bt) ((b -> Either c a) -> (a -> Either c a) -> Either b a -> Either c a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (c -> Either c a
forall a b. a -> Either a b
Left (c -> Either c a) -> (b -> c) -> b -> Either c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
f) a -> Either c a
forall a b. b -> Either a b
Right (Either b a -> Either c a) -> (a -> Either b a) -> a -> Either c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b a
seta)

    {-# INLINE rmap #-}
    {-# INLINE lmap #-}
    {-# INLINE dimap #-}

    #. :: forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> Market a b a b -> Market a b a c
(#.) q b c
_ = Market a b a b -> Market a b a c
forall a b. Coercible a b => a -> b
coerce
    .# :: forall a b c (q :: * -> * -> *).
Coercible b a =>
Market a b b c -> q a b -> Market a b a c
(.#) Market a b b c
p q a b
_ = Market a b b c -> Market a b a c
forall a b. Coercible a b => a -> b
coerce Market a b b c
p

    {-# INLINE (#.) #-}
    {-# INLINE (.#) #-}

instance Choice (Market a b) where
    left' :: forall a b c.
Market a b a b -> Market a b (Either a c) (Either b c)
left' (Market b -> b
bt a -> Either b a
seta) = (b -> Either b c)
-> (Either a c -> Either (Either b c) a)
-> Market a b (Either a c) (Either b c)
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market (b -> Either b c
forall a b. a -> Either a b
Left (b -> Either b c) -> (b -> b) -> b -> Either b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
bt) ((Either a c -> Either (Either b c) a)
 -> Market a b (Either a c) (Either b c))
-> (Either a c -> Either (Either b c) a)
-> Market a b (Either a c) (Either b c)
forall a b. (a -> b) -> a -> b
$ \Either a c
sc -> case Either a c
sc of
        Left a
s -> case a -> Either b a
seta a
s of
            Left b
t -> Either b c -> Either (Either b c) a
forall a b. a -> Either a b
Left (b -> Either b c
forall a b. a -> Either a b
Left b
t)
            Right a
a -> a -> Either (Either b c) a
forall a b. b -> Either a b
Right a
a
        Right c
c -> Either b c -> Either (Either b c) a
forall a b. a -> Either a b
Left (c -> Either b c
forall a b. b -> Either a b
Right c
c)

    right' :: forall a b c.
Market a b a b -> Market a b (Either c a) (Either c b)
right' (Market b -> b
bt a -> Either b a
seta) = (b -> Either c b)
-> (Either c a -> Either (Either c b) a)
-> Market a b (Either c a) (Either c b)
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market (b -> Either c b
forall a b. b -> Either a b
Right (b -> Either c b) -> (b -> b) -> b -> Either c b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
bt) ((Either c a -> Either (Either c b) a)
 -> Market a b (Either c a) (Either c b))
-> (Either c a -> Either (Either c b) a)
-> Market a b (Either c a) (Either c b)
forall a b. (a -> b) -> a -> b
$ \Either c a
cs -> case Either c a
cs of
        Left c
c -> Either c b -> Either (Either c b) a
forall a b. a -> Either a b
Left (c -> Either c b
forall a b. a -> Either a b
Left c
c)
        Right a
s -> case a -> Either b a
seta a
s of
            Left b
t -> Either c b -> Either (Either c b) a
forall a b. a -> Either a b
Left (b -> Either c b
forall a b. b -> Either a b
Right b
t)
            Right a
a -> a -> Either (Either c b) a
forall a b. b -> Either a b
Right a
a

    {-# INLINE right' #-}
    {-# INLINE left' #-}

type Market' a s = Market a a s s

class IsText t where

    -- | 'packed' lets you convert between 'String' and @Text@ (strict or lazy).
    -- It can be used as a replacement for @pack@ or as a way to modify some
    -- 'String' if you have a function like @Text -> Text@.

    packed   :: Iso' String t

    -- | 'unpacked' is like 'packed' but works in the opposite direction.

    unpacked :: Iso' t String