{-# LANGUAGE LinearTypes #-}
{-# OPTIONS_HADDOCK hide #-}

-- | `UrT` creates non-linear monads from linear monads.
-- The effect of @UrT m@ is the same as the effect of @m@ with the same linearity.
-- It's just that the @a@ in @m a@ must be used linearly, but the @a@ in @UrT m a@ can be used unrestricted.
-- Since @UrT@ is a regular monad it can be used with the regular do-notation.
--
-- A good use case is when you have a linear resource, then you can use @UrT (`Linear.State` s) a@
-- to manipulate the resource linearly with regular do-notation.
module Data.Unrestricted.Linear.Internal.UrT
  ( UrT (..),
    runUrT,
    liftUrT,
    evalUrT,
  )
where

import qualified Control.Functor.Linear as Linear
import Data.Unrestricted.Linear.Internal.Movable
import Data.Unrestricted.Linear.Internal.Ur

-- | @UrT@ transforms linear control monads to non-linear monads.
--
-- * @UrT (`Linear.State` s) a@ is a non-linear monad with linear state.
newtype UrT m a = UrT (m (Ur a))

-- | Linearly unwrap the @UrT@ newtype wrapper.
runUrT :: UrT m a %1 -> m (Ur a)
runUrT :: forall (m :: * -> *) a. UrT m a %1 -> m (Ur a)
runUrT (UrT m (Ur a)
ma) = m (Ur a)
ma

instance Linear.Functor m => Functor (UrT m) where
  fmap :: forall a b. (a -> b) -> UrT m a -> UrT m b
fmap a -> b
f (UrT m (Ur a)
ma) = m (Ur b) -> UrT m b
forall (m :: * -> *) a. m (Ur a) -> UrT m a
UrT ((Ur a %1 -> Ur b) %1 -> m (Ur a) %1 -> m (Ur b)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Linear.fmap (\(Ur a
a) -> b -> Ur b
forall a. a -> Ur a
Ur (a -> b
f a
a)) m (Ur a)
ma)

instance Linear.Applicative m => Applicative (UrT m) where
  pure :: forall a. a -> UrT m a
pure a
a = m (Ur a) -> UrT m a
forall (m :: * -> *) a. m (Ur a) -> UrT m a
UrT (Ur a %1 -> m (Ur a)
forall (f :: * -> *) a. Applicative f => a %1 -> f a
Linear.pure (a -> Ur a
forall a. a -> Ur a
Ur a
a))
  UrT m (Ur (a -> b))
mf <*> :: forall a b. UrT m (a -> b) -> UrT m a -> UrT m b
<*> UrT m (Ur a)
ma = m (Ur b) -> UrT m b
forall (m :: * -> *) a. m (Ur a) -> UrT m a
UrT ((Ur (a -> b) %1 -> Ur a %1 -> Ur b)
%1 -> m (Ur (a -> b)) %1 -> m (Ur a) %1 -> m (Ur b)
forall (f :: * -> *) a b c.
Applicative f =>
(a %1 -> b %1 -> c) %1 -> f a %1 -> f b %1 -> f c
Linear.liftA2 (\(Ur a -> b
f) (Ur a
a) -> b -> Ur b
forall a. a -> Ur a
Ur (a -> b
f a
a)) m (Ur (a -> b))
mf m (Ur a)
ma)

instance Linear.Monad m => Monad (UrT m) where
  UrT m (Ur a)
ma >>= :: forall a b. UrT m a -> (a -> UrT m b) -> UrT m b
>>= a -> UrT m b
f = m (Ur b) -> UrT m b
forall (m :: * -> *) a. m (Ur a) -> UrT m a
UrT (m (Ur a)
ma m (Ur a) %1 -> (Ur a %1 -> m (Ur b)) %1 -> m (Ur b)
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
Linear.>>= (\(Ur a
a) -> case a -> UrT m b
f a
a of (UrT m (Ur b)
mb) -> m (Ur b)
mb))

-- | Lift a computation to the @UrT@ monad, provided that the type @a@ can be used unrestricted.
liftUrT :: (Movable a, Linear.Functor m) => m a %1 -> UrT m a
liftUrT :: forall a (m :: * -> *). (Movable a, Functor m) => m a %1 -> UrT m a
liftUrT m a
ma = m (Ur a) %1 -> UrT m a
forall (m :: * -> *) a. m (Ur a) -> UrT m a
UrT ((a %1 -> Ur a) %1 -> m a %1 -> m (Ur a)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Linear.fmap a %1 -> Ur a
forall a. Movable a => a %1 -> Ur a
move m a
ma)

-- | Extract the inner computation linearly, the inverse of `liftUrT`.
--
-- > evalUrT (liftUrT m) = m
evalUrT :: Linear.Functor m => UrT m a %1 -> m a
evalUrT :: forall (m :: * -> *) a. Functor m => UrT m a %1 -> m a
evalUrT UrT m a
u = (Ur a %1 -> a) %1 -> m (Ur a) %1 -> m a
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Linear.fmap Ur a %1 -> a
forall a. Ur a %1 -> a
unur (UrT m a %1 -> m (Ur a)
forall (m :: * -> *) a. UrT m a %1 -> m (Ur a)
runUrT UrT m a
u)