{-| 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 :: 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 #-}

-- | Identical to @"Control.Lens.Plated".`Control.Lens.Plated.cosmosOf`@
cosmosOf :: (Applicative f, Contravariant f) => LensLike' f a a -> LensLike' f a a
cosmosOf :: 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 f a -> f a -> f a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LensLike' f a a
d (LensLike' f a a -> LensLike' f a a
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 :: (s -> a) -> Optic' p f s a
to s -> a
k = (s -> a) -> (f a -> f s) -> Optic' p f s a
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> a
k ((s -> a) -> f a -> f s
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> 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 :: Getting a s a -> s -> a
foldOf Getting a s a
l = Const a s -> a
forall a k (b :: k). Const a b -> a
getConst (Const a s -> a) -> (s -> Const a s) -> s -> a
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 a -> Const a a
forall k a (b :: k). a -> Const a b
Const
{-# INLINE foldOf #-}