{-| This module contains some useful utilities copy-and-pasted from the @lens@
    library to avoid a dependency which are used internally and also re-exported
    for convenience
-}

module Dhall.Optics
    ( Optic
    , Optic'
       -- * Utilities
    , rewriteOf
    , transformOf
    , rewriteMOf
    , transformMOf
    , mapMOf
    , cosmosOf
    , to
    , foldOf
    ) where

import Control.Applicative        (Const (..), WrappedMonad (..))
import Data.Functor.Contravariant (Contravariant (contramap))
import Data.Profunctor            (Profunctor (dimap))
import Data.Profunctor.Unsafe     ((#.))
import Lens.Family                (ASetter, LensLike, LensLike', over)

-- | Identical to @"Control.Lens".`Control.Lens.rewriteOf`@
rewriteOf :: ASetter a b a b -> (b -> Maybe a) -> a -> b
rewriteOf :: forall a b. ASetter a b a b -> (b -> Maybe a) -> a -> b
rewriteOf ASetter a b a b
l b -> Maybe a
f = a -> b
go
  where
    go :: a -> b
go = forall a b. ASetter a b a b -> (b -> b) -> a -> b
transformOf ASetter a b a b
l (\b
x -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
x a -> b
go (b -> Maybe a
f b
x))
{-# INLINE rewriteOf #-}

-- | Identical to @"Control.Lens".`Control.Lens.transformOf`@
transformOf :: ASetter a b a b -> (b -> b) -> a -> b
transformOf :: forall a b. ASetter a b a b -> (b -> b) -> a -> b
transformOf ASetter a b a b
l b -> b
f = a -> b
go
  where
    go :: a -> b
go = b -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter a b a b
l a -> b
go
{-# INLINE transformOf #-}

-- | Identical to @"Control.Lens".`Control.Lens.rewriteMOf`@
rewriteMOf
    :: Monad m
    => LensLike (WrappedMonad m) a b a b -> (b -> m (Maybe a)) -> a -> m b
rewriteMOf :: forall (m :: * -> *) a b.
Monad m =>
LensLike (WrappedMonad m) a b a b -> (b -> m (Maybe a)) -> a -> m b
rewriteMOf LensLike (WrappedMonad m) a b a b
l b -> m (Maybe a)
f = a -> m b
go
  where
    go :: a -> m b
go = forall (m :: * -> *) a b.
Monad m =>
LensLike (WrappedMonad m) a b a b -> (b -> m b) -> a -> m b
transformMOf LensLike (WrappedMonad m) a b a b
l (\b
x -> b -> m (Maybe a)
f b
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return b
x) a -> m b
go)
{-# INLINE rewriteMOf #-}

-- | Identical to @"Control.Lens".`Control.Lens.transformMOf`@
transformMOf
    :: Monad m => LensLike (WrappedMonad m) a b a b -> (b -> m b) -> a -> m b
transformMOf :: forall (m :: * -> *) a b.
Monad m =>
LensLike (WrappedMonad m) a b a b -> (b -> m b) -> a -> m b
transformMOf LensLike (WrappedMonad m) a b a b
l b -> m b
f = a -> m b
go
  where
    go :: a -> m b
go a
t = forall (m :: * -> *) s t a b.
LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t
mapMOf LensLike (WrappedMonad m) a b a b
l a -> m b
go a
t forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m b
f
{-# INLINE transformMOf #-}

-- | Identical to @"Control.Lens".`Control.Lens.mapMOf`@
mapMOf :: LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t
mapMOf :: forall (m :: * -> *) s t a b.
LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t
mapMOf LensLike (WrappedMonad m) s t a b
l a -> m b
cmd = forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. LensLike (WrappedMonad m) s t a b
l (forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. a -> m b
cmd)
{-# INLINE mapMOf #-}

-- | Identical to @"Control.Lens.Plated".`Control.Lens.Plated.cosmosOf`@
cosmosOf :: (Applicative f, Contravariant f) => LensLike' f a a -> LensLike' f a a
cosmosOf :: forall (f :: * -> *) a.
(Applicative f, Contravariant f) =>
LensLike' f a a -> LensLike' f a a
cosmosOf LensLike' f a a
d a -> f a
f a
s = a -> f a
f a
s forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LensLike' f a a
d (forall (f :: * -> *) a.
(Applicative f, Contravariant f) =>
LensLike' f a a -> LensLike' f a a
cosmosOf LensLike' f a a
d a -> f a
f) a
s
{-# INLINE cosmosOf #-}

-- | Identical to @"Control.Lens.Type".`Control.Lens.Type.Optic`@
type Optic p f s t a b = p a (f b) -> p s (f t)

-- | Identical to @"Control.Lens.Type".`Control.Lens.Type.Optic'`@
type Optic' p f s a = Optic p f s s a a

-- | Identical to @"Control.Lens.Getter".`Control.Lens.Getter.to`@
to :: (Profunctor p, Contravariant f) => (s -> a) -> Optic' p f s a
to :: forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to s -> a
k = forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> a
k (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap s -> a
k)
{-# INLINE to #-}

-- | Identical to @"Control.Lens.Getter".`Control.Lens.Getter.Getting`@
type Getting r s a = (a -> Const r a) -> s -> Const r s

-- | Identical to @"Control.Lens.Fold".`Control.Lens.Fold.foldOf`@
foldOf :: Getting a s a -> s -> a
foldOf :: forall a s. Getting a s a -> s -> a
foldOf Getting a s a
l = forall {k} a (b :: k). Const a b -> a
getConst forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Getting a s a
l forall {k} a (b :: k). a -> Const a b
Const
{-# INLINE foldOf #-}