[Haskell-cafe] Bracket around every IO computation monad

[Bas van Dijk]

On Mon, Nov 8, 2010 at 1:40 AM, Mitar <mmitar at gmail.com> wrote:
> Hi!
>
> I have a class Neuron which has (among others) two functions: attach
> and deattach. I would like to make a way to call a list/stack/bunch of
> attach functions in a way that if any of those fail (by exception),
> deattach for previously already attached values (called attach on
> them) are deattached (called deattach on them).
>
> I have come up with such way:
>
> data Growable where
>  Growable :: Neuron n => LiveNeuron n -> Growable
>
> growNeurons :: [IO Growable] -> IO [Growable]
> growNeurons attaches = growNeurons' attaches []
>  where growNeurons' [] ls      = return ls
>        growNeurons' (a:ats) ls = bracketOnError a (\(Growable l) ->
> deattach l) (\l -> growNeurons' ats (l:ls))
>
> So I give growNeurons a list of attach actions and it returns a list
> of attached values ((live)neurons). This works nice, but syntax to use
> it is ugly:
>
> neurons <- growNeurons [
>    do { a <- attach nerve1; return $ Growable a },
>    do { a <- attach nerve2; return $ Growable a },
>    do { a <- attach nerve3; return $ Growable a }
>  ]
>
> Types of attach and deattach are (if I simplify):
>
> attach :: Nerve n -> IO (LiveNeuron n)
> deattach :: LiveNeuron n -> IO ()
>
> Growable is only used so that I can put actions of different type in the list.
>
> It seems to me that all this could be wrapped into a monad. So that I
> would be able to call something like:
>
> neurons <- growNeurons' $ do
>    attach nerve1
>    attach nerve2
>    attach nerve3
>
> Where I would be allowed to call actions of a special type class which
> defined also clean-up function (in my case called deattach). And which
> would be called if there was any exception thrown (and then at the end
> rethrown). Otherwise, the result would be a list of all computed
> values. In my case all this in IO monad.
>
> So it is possible that evaluation of monad actions would be stacked
> inside of bracketOnError and in a case of error clean-up functions
> would be called, otherwise returns a list of results?
>
>
> Mitar

This can be solved by using "Lightweight Monadic Regions" as
implemented in my regions package[1]. What follows is an example
module that demonstrates the idea:

module SaveNeurons (Nerve, SaveNeuron, saveAttach, someSaveOperation) where

----------------------------------------------------------------------
-- Imports:

-- from base:
import Control.Monad ( liftM )

-- from monad-peel:
import Control.Exception.Peel ( block )
import Control.Monad.IO.Peel  ( MonadPeelIO )

-- from transformers:
import Control.Monad.IO.Class ( MonadIO(liftIO) )

-- from regions:
import Control.Monad.Trans.Region ( RegionT, runRegionT
                                  , Dup(dup)
                                  , AncestorRegion
                                  )
import Control.Monad.Trans.Region.OnExit ( FinalizerHandle, onExit )


----------------------------------------------------------------------
-- Your existing types and functions:

data Nerve n = Nerve

data LiveNeuron n = LiveNeuron

attach :: Nerve n -> IO (LiveNeuron n)
attach = undefined

deattach :: LiveNeuron n -> IO ()
deattach = undefined

-- You probably also defined some operations on LiveNeurons:
someOperation :: LiveNeuron n -> IO ()
someOperation = undefined


----------------------------------------------------------------------
-- Save regional layer:

data SaveNeuron n r = SaveNeuron (LiveNeuron n) (FinalizerHandle r)

saveAttach :: MonadPeelIO pr
           => Nerve n
           -> RegionT s pr (SaveNeuron n (RegionT s pr))
saveAttach nerve = block $ do
                     n <- liftIO $ attach nerve
                     fh <- onExit $ deattach n
                     return $ SaveNeuron n fh

someSaveOperation :: (AncestorRegion pr cr, MonadIO cr)
                  => SaveNeuron n pr -> cr ()
someSaveOperation (SaveNeuron ln _) = liftIO $ someOperation ln

instance Dup (SaveNeuron n) where
    dup (SaveNeuron ln fh) = liftM (SaveNeuron ln) $ dup fh


----------------------------------------------------------------------
-- Example:

example :: IO ()
example = runRegionT $ do
            sn1 <- saveAttach Nerve
            someSaveOperation sn1

            -- When one of these operations fail,
            -- all attached nerves will be detached automatically.
            sn2 <- saveAttach Nerve
            sn3 <- saveAttach Nerve

            someSaveOperation sn2
            someSaveOperation sn3

            -- We can also nest regions.
            runRegionT $ do
              someSaveOperation sn1
              sn4 <- saveAttach Nerve
              sn5 <- saveAttach Nerve
              someSaveOperation sn4
              someSaveOperation sn5

              -- When a regions terminates all attached nerves will
              -- be detached automatically. Note that is a type error
              -- to return a save neuron from a regions:
              -- 'return sn5' gives a type error for example.

              -- If you really wish to return a save neuron you can
              -- 'duplicate' it to the parent region as in:
              -- sn5' <- dup sn5
              -- return sn5'

----------------------------------------------------------------------

Feel free to ask any questions about the above code.

Regards,

Bas

[1] http://hackage.haskell.org/package/regions