{-# 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 (dimap)
import Data.Profunctor.Choice (Choice (..))
import Data.Tagged (Tagged (..))

type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f 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 = Setter s a -> (a -> a) -> s -> s
forall s a. Setter s a -> (a -> a) -> s -> s
over Setter s a
l ((a -> a) -> s -> s) -> (a -> a -> a) -> a -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a b. a -> b -> a
const
{-# INLINE set #-}

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 = Identity s -> s
forall a. Identity a -> a
runIdentity (Identity s -> s) -> (s -> Identity s) -> s -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Setter s a
l (a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> (a -> a) -> a -> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f)
{-# INLINE over #-}

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
to s -> Maybe a
from p a (f a)
p = (s -> Either s a)
-> (Either s (f a) -> f s)
-> p (Either s a) (Either s (f a))
-> p s (f s)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> Either s a
from' Either s (f a) -> f s
forall (f :: * -> *). Applicative f => Either s (f a) -> f s
to' (p (Either s a) (Either s (f a)) -> p s (f s))
-> p (Either s a) (Either s (f a)) -> p s (f s)
forall a b. (a -> b) -> a -> b
$ p a (f a) -> p (Either s a) (Either s (f a))
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right' p a (f a)
p
  where
    to' :: Applicative f => Either s (f a) -> f s
    to' :: forall (f :: * -> *). Applicative f => Either s (f a) -> f s
to' = (s -> f s) -> (f a -> f s) -> Either s (f a) -> f s
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either s -> f s
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a -> s) -> f a -> f s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> s
to)

    from' :: s -> Either s a
    from' :: s -> Either s a
from' s
s = Either s a -> (a -> Either s a) -> Maybe a -> Either s a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (s -> Either s a
forall a b. a -> Either a b
Left s
s) a -> Either s a
forall a b. b -> Either a b
Right (Maybe a -> Either s a) -> Maybe a -> Either s a
forall a b. (a -> b) -> a -> b
$ s -> Maybe a
from 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 = (First a -> Maybe a
forall a. First a -> Maybe a
getFirst (First a -> Maybe a)
-> ((s -> Const (First a) s) -> First a)
-> (s -> Const (First a) s)
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const (First a) s -> First a
forall {k} a (b :: k). Const a b -> a
getConst (Const (First a) s -> First a)
-> ((s -> Const (First a) s) -> Const (First a) s)
-> (s -> Const (First a) s)
-> First a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((s -> Const (First a) s) -> s -> Const (First a) s
forall a b. (a -> b) -> a -> b
$ s
s)) ((s -> Const (First a) s) -> Maybe a)
-> (s -> Const (First a) s) -> Maybe a
forall a b. (a -> b) -> a -> b
$ (a -> Const (First a) a) -> s -> Const (First a) s
Prism' s a
p (First a -> Const (First a) a
forall {k} a (b :: k). a -> Const a b
Const (First a -> Const (First a) a)
-> (a -> First a) -> a -> Const (First a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> First a
forall a. Maybe a -> First a
First (Maybe a -> First a) -> (a -> Maybe a) -> a -> First a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
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 = Identity s -> s
forall a. Identity a -> a
runIdentity (Identity s -> s) -> (a -> Identity s) -> a -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged s (Identity s) -> Identity s
forall {k} (s :: k) b. Tagged s b -> b
unTagged (Tagged s (Identity s) -> Identity s)
-> (a -> Tagged s (Identity s)) -> a -> Identity s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged a (Identity a) -> Tagged s (Identity s)
Prism' s a
p (Tagged a (Identity a) -> Tagged s (Identity s))
-> (a -> Tagged a (Identity a)) -> a -> Tagged s (Identity s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> Tagged a (Identity a)
forall {k} (s :: k) b. b -> Tagged s b
Tagged (Identity a -> Tagged a (Identity a))
-> (a -> Identity a) -> a -> Tagged a (Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity a
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 = Prism' s a -> s -> Maybe a
forall s a. Prism' s a -> s -> Maybe a
preview Prism' s a
p s
s
{-# INLINE (^?) #-}

infixl 8 ^?