module Embedding
  ( Embedding (..)
  , embed
  , extract
  , extractIgnoringError
  , dimapEmbedding
  ) where

import Internal.Prelude

-- | Targets a value that is optionally present in some stateful monadic context
data Embedding (con :: (Type -> Type) -> Constraint) e a = Embedding
  { forall (con :: (* -> *) -> Constraint) e a.
Embedding con e a -> forall (m :: * -> *). con m => Maybe a -> m ()
embed :: forall m. con m => Maybe a -> m ()
  -- ^ Sets or clears the value
  , forall (con :: (* -> *) -> Constraint) e a.
Embedding con e a
-> forall (m :: * -> *).
   (Functor m, con m) =>
   m (Either e (Maybe a))
extract :: forall m. (Functor m, con m) => m (Either e (Maybe a))
  -- ^ Removes the value if present, returning what was removed
  }

embed :: con m => Embedding con e a -> Maybe a -> m ()
embed :: forall (con :: (* -> *) -> Constraint) (m :: * -> *) e a.
con m =>
Embedding con e a -> Maybe a -> m ()
embed Embedding {$sel:embed:Embedding :: forall (con :: (* -> *) -> Constraint) e a.
Embedding con e a -> forall (m :: * -> *). con m => Maybe a -> m ()
embed = forall (m :: * -> *). con m => Maybe a -> m ()
x} = Maybe a -> m ()
forall (m :: * -> *). con m => Maybe a -> m ()
x

extract :: (Functor m, con m) => Embedding con e a -> m (Either e (Maybe a))
extract :: forall (m :: * -> *) (con :: (* -> *) -> Constraint) e a.
(Functor m, con m) =>
Embedding con e a -> m (Either e (Maybe a))
extract Embedding {$sel:extract:Embedding :: forall (con :: (* -> *) -> Constraint) e a.
Embedding con e a
-> forall (m :: * -> *).
   (Functor m, con m) =>
   m (Either e (Maybe a))
extract = forall (m :: * -> *). (Functor m, con m) => m (Either e (Maybe a))
x} = m (Either e (Maybe a))
forall (m :: * -> *). (Functor m, con m) => m (Either e (Maybe a))
x

extractIgnoringError :: (Functor m, con m) => Embedding con e a -> m (Maybe a)
extractIgnoringError :: forall (m :: * -> *) (con :: (* -> *) -> Constraint) e a.
(Functor m, con m) =>
Embedding con e a -> m (Maybe a)
extractIgnoringError Embedding con e a
e = Embedding con e a -> m (Either e (Maybe a))
forall (m :: * -> *) (con :: (* -> *) -> Constraint) e a.
(Functor m, con m) =>
Embedding con e a -> m (Either e (Maybe a))
extract Embedding con e a
e m (Either e (Maybe a))
-> (Either e (Maybe a) -> Maybe a) -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Maybe a -> Either e (Maybe a) -> Maybe a
forall b a. b -> Either a b -> b
fromRight Maybe a
forall a. Maybe a
Nothing

dimapEmbedding
  :: (a -> Either e b)
  -> (b -> a)
  -> Embedding con e a
  -> Embedding con e b
dimapEmbedding :: forall a e b (con :: (* -> *) -> Constraint).
(a -> Either e b)
-> (b -> a) -> Embedding con e a -> Embedding con e b
dimapEmbedding a -> Either e b
g b -> a
f Embedding {$sel:embed:Embedding :: forall (con :: (* -> *) -> Constraint) e a.
Embedding con e a -> forall (m :: * -> *). con m => Maybe a -> m ()
embed = forall (m :: * -> *). con m => Maybe a -> m ()
embed', $sel:extract:Embedding :: forall (con :: (* -> *) -> Constraint) e a.
Embedding con e a
-> forall (m :: * -> *).
   (Functor m, con m) =>
   m (Either e (Maybe a))
extract = forall (m :: * -> *). (Functor m, con m) => m (Either e (Maybe a))
extract'} =
  Embedding
    { $sel:embed:Embedding :: forall (m :: * -> *). con m => Maybe b -> m ()
embed = Maybe a -> m ()
forall (m :: * -> *). con m => Maybe a -> m ()
embed' (Maybe a -> m ()) -> (Maybe b -> Maybe a) -> Maybe b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a) -> Maybe b -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
f
    , $sel:extract:Embedding :: forall (m :: * -> *). (Functor m, con m) => m (Either e (Maybe b))
extract =
        m (Either e (Maybe a))
forall (m :: * -> *). (Functor m, con m) => m (Either e (Maybe a))
extract' m (Either e (Maybe a))
-> (Either e (Maybe a) -> Either e (Maybe b))
-> m (Either e (Maybe b))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          Left e
e -> e -> Either e (Maybe b)
forall a b. a -> Either a b
Left e
e
          Right Maybe a
Nothing -> Maybe b -> Either e (Maybe b)
forall a b. b -> Either a b
Right Maybe b
forall a. Maybe a
Nothing
          Right (Just a
x) -> b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> Either e b -> Either e (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Either e b
g a
x
    }