Add UrT, the unrestricted monad transformer (#304)

Co-authored-by: Facundo Domínguez <[email protected]>
Co-authored-by: Utku Demir <[email protected]>

linear-base.cabal

@@ -73,6 +73,7 @@ library
     Data.Unrestricted.Internal.Movable
     Data.Unrestricted.Internal.Instances
     Data.Unrestricted.Internal.Ur
+    Data.Unrestricted.Internal.UrT
     Data.Unrestricted.Linear
     Data.V.Linear
     Data.V.Linear.Internal.V

src/Data/Unrestricted/Internal/UrT.hs

@@ -0,0 +1,48 @@
+{-# LANGUAGE LinearTypes #-}
+-- | `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.Internal.UrT
+  (
+    UrT(..)
+  , runUrT
+  , liftUrT
+  , evalUrT
+  ) where
+
+import qualified Control.Functor.Linear as Linear
+import Data.Unrestricted.Internal.Ur
+import Data.Unrestricted.Internal.Movable
+
+-- | @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 (UrT ma) = ma
+
+instance Linear.Functor m => Functor (UrT m) where
+  fmap f (UrT ma) = UrT (Linear.fmap (\(Ur a) -> Ur (f a)) ma)
+
+instance Linear.Applicative m => Applicative (UrT m) where
+  pure a = UrT (Linear.pure (Ur a))
+  UrT mf <*> UrT ma = UrT (Linear.liftA2 (\(Ur f) (Ur a) -> Ur (f a)) mf ma)
+
+instance Linear.Monad m => Monad (UrT m) where
+  UrT ma >>= f = UrT (ma Linear.>>= (\(Ur a) -> case f a of (UrT mb) -> 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 ma = UrT (Linear.fmap move 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 u = Linear.fmap unur (runUrT u)

src/Data/Unrestricted/Linear.hs

@@ -62,6 +62,10 @@ module Data.Unrestricted.Linear
   , unur
   , lift
   , lift2
+  , UrT(..)
+  , runUrT
+  , liftUrT
+  , evalUrT
     -- * Performing non-linear actions on linearly bound values
   , Consumable(..)
   , Dupable(..)
@@ -76,5 +80,6 @@ import Data.Unrestricted.Internal.Consumable
 import Data.Unrestricted.Internal.Dupable
 import Data.Unrestricted.Internal.Movable
 import Data.Unrestricted.Internal.Ur
+import Data.Unrestricted.Internal.UrT
 import Data.Unrestricted.Internal.Instances