{-| 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
    ( -- * Utilities
      rewriteOf
    , transformOf
    , rewriteMOf
    , transformMOf
    , mapMOf
    ) where

import Control.Applicative    (WrappedMonad (..))
import Data.Profunctor.Unsafe (( #. ))
import Lens.Family            (ASetter, LensLike, over)

-- | Identical to @"Control.Lens".`Control.Lens.rewriteOf`@
rewriteOf :: ASetter a b a b -> (b -> Maybe a) -> a -> b
rewriteOf :: 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 = ASetter a b a b -> (b -> b) -> a -> b
forall a b. ASetter a b a b -> (b -> b) -> a -> b
transformOf ASetter a b a b
l (\b
x -> b -> (a -> b) -> Maybe a -> b
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 :: 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 (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter a b a b -> (a -> b) -> a -> b
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 :: 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 = LensLike (WrappedMonad m) a b a b -> (b -> m b) -> a -> m b
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 m (Maybe a) -> (Maybe a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m b -> (a -> m b) -> Maybe a -> m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (b -> m b
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 :: 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 = LensLike (WrappedMonad m) a b a b -> (a -> m b) -> a -> m b
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 m b -> (b -> m b) -> m b
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 :: 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 = WrappedMonad m t -> m t
forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad (WrappedMonad m t -> m t) -> (s -> WrappedMonad m t) -> s -> m t
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 (m b -> WrappedMonad m b
forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad (m b -> WrappedMonad m b) -> (a -> m b) -> a -> WrappedMonad m b
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 #-}