[Haskell-cafe] Bracket around every IO computation monad

Felipe Almeida Lessa felipe.lessa at gmail.com
Mon Nov 15 14:04:21 EST 2010


Well, I guess you could try something like:

> {-# LANGUAGE GADTs #-}
>
> import Control.Exception (bracketOnError)
> import Control.Monad ((>=>))
>
> -- from package 'operational'
> import Control.Monad.Operational
>
> data BracketedOperation a where
>   Bracketed :: IO a -> (a -> IO b) -> BracketedOperation a
>
> type BracketedProgram a = ProgramT BracketedOperation IO a
>
> interpret :: BracketedProgram a -> IO a
> interpret = viewT >=> eval
>   where
>     eval :: ProgramViewT BracketedOperation IO a -> IO a
>     eval (Return a) = return a
>     eval (Bracketed acquire release :>>= is) =
>       bracketOnError acquire release $ interpret . is

Now you could have:

] attachN :: Nerve n -> BracketedProgram (LiveNeuron n)
] attachN n = singleton (Bracketed (attach n) dettach)

And your code would become:

] neurons <- interpret $ do
]   attachN nerve1
]   attachN nerve2
]   attachN nerve3

Note that I haven't tested this code, but it compiles :).

Cheers!

-- 
Felipe.


More information about the Haskell-Cafe mailing list