{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RankNTypes #-}

module Calligraphy.Util.Lens
  ( Traversal,
    Traversal',
    over,
    forT_,
  )
where

import Data.Functor.Identity

type Traversal s t a b = forall m. Applicative m => (a -> m b) -> (s -> m t)

type Traversal' s a = Traversal s s a a

newtype ConstT m a = ConstT {forall (m :: * -> *) a. ConstT m a -> m ()
unConstT :: m ()}
  deriving (forall a b. (a -> b) -> ConstT m a -> ConstT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) a b. a -> ConstT m b -> ConstT m a
forall (m :: * -> *) a b. (a -> b) -> ConstT m a -> ConstT m b
<$ :: forall a b. a -> ConstT m b -> ConstT m a
$c<$ :: forall (m :: * -> *) a b. a -> ConstT m b -> ConstT m a
fmap :: forall a b. (a -> b) -> ConstT m a -> ConstT m b
$cfmap :: forall (m :: * -> *) a b. (a -> b) -> ConstT m a -> ConstT m b
Functor)

instance Applicative m => Applicative (ConstT m) where
  {-# INLINE pure #-}
  pure :: forall a. a -> ConstT m a
pure a
_ = forall (m :: * -> *) a. m () -> ConstT m a
ConstT (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  {-# INLINE (<*>) #-}
  ConstT m ()
mf <*> :: forall a b. ConstT m (a -> b) -> ConstT m a -> ConstT m b
<*> ConstT m ()
ma = forall (m :: * -> *) a. m () -> ConstT m a
ConstT (m ()
mf forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
ma)

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

{-# INLINE mapT_ #-}
mapT_ :: Applicative m => Traversal s t a b -> (a -> m ()) -> s -> m ()
mapT_ :: forall (m :: * -> *) s t a b.
Applicative m =>
Traversal s t a b -> (a -> m ()) -> s -> m ()
mapT_ Traversal s t a b
t a -> m ()
f = forall (m :: * -> *) a. ConstT m a -> m ()
unConstT forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal s t a b
t (forall (m :: * -> *) a. m () -> ConstT m a
ConstT forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m ()
f)

{-# INLINE forT_ #-}
forT_ :: Applicative m => Traversal s t a b -> s -> (a -> m ()) -> m ()
forT_ :: forall (m :: * -> *) s t a b.
Applicative m =>
Traversal s t a b -> s -> (a -> m ()) -> m ()
forT_ Traversal s t a b
t = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (m :: * -> *) s t a b.
Applicative m =>
Traversal s t a b -> (a -> m ()) -> s -> m ()
mapT_ Traversal s t a b
t)