{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
--
-- Module      : Network.AWS.ARN.Internal.Lens
-- Copyright   : (C) 2020-2022 Bellroy Pty Ltd
-- License     : BSD-3-Clause
-- Maintainer  : Bellroy Tech Team <haskell@bellroy.com>
-- Stability   : experimental
--
-- Reimplement a few lens types and combinators to keep the dependency
-- footprint down.
module Network.AWS.ARN.Internal.Lens where

import Data.Functor.Const (Const (..))
import Data.Functor.Identity (Identity (..))
import Data.Monoid (First (..))
import Data.Profunctor (Profunctor (..))
import Data.Profunctor.Choice (Choice (..))
import Data.Tagged (Tagged (..))

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

type Getting r s a = (a -> Const r a) -> s -> Const r s

type Setter s a = (a -> Identity a) -> s -> Identity s

set :: Setter s a -> a -> s -> s
set :: forall s a. Setter s a -> a -> s -> s
set Setter s a
l = forall s a. Setter s a -> (a -> a) -> s -> s
over Setter s a
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
{-# INLINE set #-}

(.~) :: Setter s a -> a -> s -> s
.~ :: forall s a. Setter s a -> a -> s -> s
(.~) = forall s a. Setter s a -> a -> s -> s
set

infixr 4 .~

over :: Setter s a -> (a -> a) -> s -> s
over :: forall s a. Setter s a -> (a -> a) -> s -> s
over Setter s a
l a -> a
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Setter s a
l (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f)
{-# INLINE over #-}

(^.) :: s -> Getting a s a -> a
s
s ^. :: forall s a. s -> Getting a s a -> a
^. Getting a s a
l = forall {k} a (b :: k). Const a b -> a
getConst forall a b. (a -> b) -> a -> b
$ Getting a s a
l forall {k} a (b :: k). a -> Const a b
Const s
s

infixl 8 ^.

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

prism' :: forall s a. (a -> s) -> (s -> Maybe a) -> Prism' s a
prism' :: forall s a. (a -> s) -> (s -> Maybe a) -> Prism' s a
prism' a -> s
inj s -> Maybe a
prj p a (f a)
p = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> Either s a
prj' forall (f :: * -> *). Applicative f => Either s (f a) -> f s
inj' forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right' p a (f a)
p
  where
    inj' :: Applicative f => Either s (f a) -> f s
    inj' :: forall (f :: * -> *). Applicative f => Either s (f a) -> f s
inj' = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> s
inj)

    prj' :: s -> Either s a
    prj' :: s -> Either s a
prj' s
s = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left s
s) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ s -> Maybe a
prj s
s
{-# INLINE prism' #-}

preview :: Prism' s a -> s -> Maybe a
preview :: forall s a. Prism' s a -> s -> Maybe a
preview Prism' s a
p s
s = (forall a. First a -> Maybe a
getFirst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ s
s)) forall a b. (a -> b) -> a -> b
$ Prism' s a
p (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> First a
First forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
{-# INLINE preview #-}

review :: Prism' s a -> a -> s
review :: forall s a. Prism' s a -> a -> s
review Prism' s a
p = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (s :: k) b. Tagged s b -> b
unTagged forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' s a
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (s :: k) b. b -> Tagged s b
Tagged forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Identity a
Identity
{-# INLINE review #-}

(^?) :: s -> Prism' s a -> Maybe a
s
s ^? :: forall s a. s -> Prism' s a -> Maybe a
^? Prism' s a
p = forall s a. Prism' s a -> s -> Maybe a
preview Prism' s a
p s
s
{-# INLINE (^?) #-}

infixl 8 ^?

type Traversal' s a = forall f. Applicative f => (a -> f a) -> s -> f s

ix :: Int -> Traversal' [a] a
ix :: forall a. Int -> Traversal' [a] a
ix Int
0 a -> f a
f (a
x : [a]
xs) = (forall a. a -> [a] -> [a]
: [a]
xs) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
x
ix Int
n a -> f a
f (a
x : [a]
xs) = (a
x forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Traversal' [a] a
ix (Int
n forall a. Num a => a -> a -> a
- Int
1) a -> f a
f [a]
xs
ix Int
_ a -> f a
_ [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure []

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

type AnIso' s a = Exchange a a a (Identity a) -> Exchange a a s (Identity s)

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) = 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)

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

from :: AnIso' s a -> Iso' a s
from :: forall s a. AnIso' s a -> Iso' a s
from AnIso' s a
l = forall s a. (s -> a) -> (a -> s) -> Iso' s a
iso (forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity s
t) s -> a
f
  where
    Exchange s -> a
f a -> Identity s
t = AnIso' s a
l forall a b. (a -> b) -> a -> b
$ 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