module Graphics.FreeGame.Internal.Resource (ResourceT(..), finalizer, runResourceT) where
import Control.Monad.IO.Class
import Control.Applicative
newtype ResourceT m a = ResourceT
{ unResourceT :: forall r. (a -> m r) -> (IO () -> r -> m r) -> m r }
finalizer :: Monad m => IO () -> ResourceT m ()
finalizer m = ResourceT $ \p f -> p () >>= f m
instance Functor (ResourceT m) where
fmap f (ResourceT g) = ResourceT $ \p -> g (p . f)
instance Applicative (ResourceT m) where
pure a = ResourceT $ \p _ -> p a
ResourceT ff <*> ResourceT fa = ResourceT $ \p f -> ff (\a -> fa (\b -> p (a b)) f) f
instance Monad (ResourceT m) where
return a = ResourceT $ \p _ -> p a
ResourceT rf >>= k = ResourceT $ \p f -> rf (\x -> unResourceT (k x) p f) f
instance MonadIO m => MonadIO (ResourceT m) where
liftIO m = ResourceT $ \r _ -> liftIO m >>= r
runResourceT :: MonadIO m => ResourceT m a -> m a
runResourceT (ResourceT z) = do
(fin, a) <- z (\a -> return (return (), a)) (\m (fs, r) -> return (m >> fs,r))
liftIO fin
return a