{-# LANGUAGE RankNTypes #-}

-- | Minimal re-implementation of just enough of lens, in order to avoid the
-- dependency. This is for INTERNAL USE ONLY. In downstream code, use lens or
-- any optics library.
module Control.Lens
  ( -- * Lenses
    Lens
  , view
    -- * Isomorphisms
  , Iso
  , iso
  , from
    -- * Prisms
  , Prism
  , preview
  , review
  ) where

import Data.Bifunctor (first)
import Data.Coerce (coerce)
import Data.Functor.Const (Const(..))
import Data.Functor.Identity (Identity(..))
import Data.Profunctor (Profunctor(..))
import Data.Profunctor.Unsafe ((#.))
import Data.Profunctor.Choice (Choice(..))

type Lens s t a b = forall f. (Functor f) => (a -> f b) -> s -> f t

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

type Prism s t a b = forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t)

view :: Lens s t a b -> s -> a
view :: forall s t a b. Lens s t a b -> s -> a
view Lens s t a b
l s
s = Const a t -> a
forall {k} a (b :: k). Const a b -> a
getConst ((a -> Const a b) -> s -> Const a t
Lens s t a b
l a -> Const a b
forall {k} a (b :: k). a -> Const a b
Const s
s)

data Market a b s t = Market (b -> t) (s -> Either t a)

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 -> d) -> Either c a -> Either d a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first c -> d
g (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)

instance Choice (Market a b) where
  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 -> Either a b
bt' Either c a -> Either (Either c b) a
forall {a}. Either a a -> Either (Either a b) a
seta'
    where
      bt' :: b -> Either a b
bt' b
b           = b -> Either a b
forall a b. b -> Either a b
Right (b -> b
bt b
b)
      seta' :: Either a a -> Either (Either a b) a
seta' (Left a
c)  = Either a b -> Either (Either a b) a
forall a b. a -> Either a b
Left (a -> Either a b
forall a b. a -> Either a b
Left a
c)
      seta' (Right a
s) = (b -> Either (Either a b) a)
-> (a -> Either (Either a b) a)
-> Either b a
-> Either (Either a b) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either a b -> Either (Either a b) a
forall a b. a -> Either a b
Left (Either a b -> Either (Either a b) a)
-> (b -> Either a b) -> b -> Either (Either a b) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
forall a b. b -> Either a b
Right) a -> Either (Either a b) a
forall a b. b -> Either a b
Right (a -> Either b a
seta a
s)

withPrism
  :: Prism s t a b
  -> ((b -> t) -> (s -> Either t a) -> r)
  -> r
withPrism :: forall s t a b r.
Prism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism Prism s t a b
k (b -> t) -> (s -> Either t a) -> r
f = case Market a b s (Identity t) -> Market a b s t
forall a b. Coercible a b => a -> b
coerce (Market a b a (Identity b) -> Market a b s (Identity t)
Prism s t a b
k ((b -> Identity b)
-> (a -> Either (Identity b) a) -> Market a b a (Identity b)
forall a b s t. (b -> t) -> (s -> Either t a) -> Market a b s t
Market b -> Identity b
forall a. a -> Identity a
Identity a -> Either (Identity b) a
forall a b. b -> Either a b
Right)) of
  Market b -> t
bt s -> Either t a
seta -> (b -> t) -> (s -> Either t a) -> r
f b -> t
bt s -> Either t a
seta

review :: Prism s t a b -> b -> t
review :: forall s t a b. Prism s t a b -> b -> t
review Prism s t a b
p = Prism s t a b
-> ((b -> t) -> (s -> Either t a) -> b -> t) -> b -> t
forall s t a b r.
Prism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism p a (f b) -> p s (f t)
Prism s t a b
p (((b -> t) -> (s -> Either t a) -> b -> t) -> b -> t)
-> ((b -> t) -> (s -> Either t a) -> b -> t) -> b -> t
forall a b. (a -> b) -> a -> b
$ \b -> t
build s -> Either t a
_ -> b -> t
build

preview :: Prism s t a b -> s -> Maybe a
preview :: forall s t a b. Prism s t a b -> s -> Maybe a
preview Prism s t a b
p = Prism s t a b
-> ((b -> t) -> (s -> Either t a) -> s -> Maybe a) -> s -> Maybe a
forall s t a b r.
Prism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
withPrism p a (f b) -> p s (f t)
Prism s t a b
p (((b -> t) -> (s -> Either t a) -> s -> Maybe a) -> s -> Maybe a)
-> ((b -> t) -> (s -> Either t a) -> s -> Maybe a) -> s -> Maybe a
forall a b. (a -> b) -> a -> b
$ \b -> t
_ s -> Either t a
match -> (t -> Maybe a) -> (a -> Maybe a) -> Either t a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> t -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just (Either t a -> Maybe a) -> (s -> Either t a) -> s -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Either t a
match

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

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)

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 = (s -> a) -> (f b -> f t) -> p a (f b) -> p s (f t)
forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> a
sa ((b -> t) -> f b -> f t
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> t
bt)

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
l (s -> a) -> (b -> t) -> r
k = case Exchange a b a (Identity b) -> Exchange a b s (Identity t)
Iso s t a b
l ((a -> a) -> (b -> Identity b) -> Exchange a b a (Identity b)
forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange a -> a
forall a. a -> a
id b -> Identity b
forall a. a -> Identity a
Identity) of
  Exchange s -> a
sa b -> Identity t
bt -> (s -> a) -> (b -> t) -> r
k s -> a
sa (Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (b -> Identity t) -> b -> t
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> (a -> b) -> a -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. b -> Identity t
bt)

from :: Iso s t a b -> Iso b a t s
from :: forall s t a b. Iso s t a b -> Iso b a t s
from Iso s t a b
l = Iso s t a b
-> ((s -> a) -> (b -> t) -> p t (f s) -> p b (f a))
-> p t (f s)
-> p b (f a)
forall s t a b r. Iso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
withIso p a (f b) -> p s (f t)
Iso s t a b
l (((s -> a) -> (b -> t) -> p t (f s) -> p b (f a))
 -> p t (f s) -> p b (f a))
-> ((s -> a) -> (b -> t) -> p t (f s) -> p b (f a))
-> p t (f s)
-> p b (f 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