diff --git a/linear-base.cabal b/linear-base.cabal index 8f147beb..cc7ca25a 100644 --- a/linear-base.cabal +++ b/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 diff --git a/src/Data/Unrestricted/Internal/UrT.hs b/src/Data/Unrestricted/Internal/UrT.hs new file mode 100644 index 00000000..3c61261e --- /dev/null +++ b/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) diff --git a/src/Data/Unrestricted/Linear.hs b/src/Data/Unrestricted/Linear.hs index a739773f..becf13b7 100644 --- a/src/Data/Unrestricted/Linear.hs +++ b/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