Added benchmark section

bench/bench.hs

@@ -0,0 +1,113 @@
+{-# LANGUAGE DeriveDataTypeable, RankNTypes #-}
+
+module Main where
+
+
+--------------------------------------------------------------------------------
+-- Imports
+--------------------------------------------------------------------------------
+
+-- from base:
+import Prelude hiding (catch)
+import Control.Exception ( Exception, SomeException, throwIO )
+import qualified Control.Exception as E ( mask, bracket, bracket_ )
+import Data.Typeable
+import Control.Monad (join)
+
+-- from criterion:
+import Criterion.Main
+
+-- from transformers:
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.State
+import Control.Monad.Trans.Writer
+
+-- from monad-peel:
+import qualified Control.Exception.Peel as MP
+import qualified Control.Monad.IO.Peel  as MP
+
+-- from monad-control:
+import qualified Control.Monad.Trans.Control as MC
+
+-- from lifted-base:
+import qualified Control.Exception.Lifted as MC
+
+
+--------------------------------------------------------------------------------
+-- Main
+--------------------------------------------------------------------------------
+
+main :: IO ()
+main = defaultMain
+  [ b "bracket"   benchBracket  MP.bracket   MC.bracket
+  , b "bracket_"  benchBracket_ MP.bracket_  MC.bracket_
+  , b "catch"     benchCatch    MP.catch     MC.catch
+  , b "try"       benchTry      MP.try       MC.try
+  , b "mask"      benchMask     mpMask       MC.mask
+
+  , bgroup "liftIOOp"
+    [ bench "monad-peel"    $ exe $ MP.liftIOOp   (E.bracket nop (\_ -> nop))
+                                                  (\_ -> nop)
+    , bench "monad-control" $ exe $ MC.liftBaseOp (E.bracket nop (\_ -> nop))
+                                                  (\_ -> nop)
+    ]
+
+  , bgroup "liftIOOp_"
+    [ bench "monad-peel"    $ exe $ MP.liftIOOp_   (E.bracket_ nop nop) nop
+    , bench "monad-control" $ exe $ MC.liftBaseOp_ (E.bracket_ nop nop) nop
+    ]
+  ]
+
+b name bnch peel mndCtrl = bgroup name
+  [ bench "monad-peel"    $ bnch peel
+  , bench "monad-control" $ bnch mndCtrl
+  ]
+
+--------------------------------------------------------------------------------
+-- Monad stack
+--------------------------------------------------------------------------------
+
+type M a = ReaderT Int (StateT Bool (WriterT String (MaybeT IO))) a
+
+type R a = IO (Maybe ((a, Bool), String))
+
+runM :: Int -> Bool -> M a -> R a
+runM r s m = runMaybeT (runWriterT (runStateT (runReaderT m r) s))
+
+exe :: M a -> R a
+exe = runM 0 False
+
+
+--------------------------------------------------------------------------------
+-- Benchmarks
+--------------------------------------------------------------------------------
+
+benchBracket   bracket   = exe $              bracket  nop (\_ -> nop)  (\_ -> nop)
+benchBracket_  bracket_  = exe $              bracket_ nop nop          nop
+benchCatch     catch     = exe $ catch throwE (\E -> nop)
+benchTry       try       = exe $ try throwE :: R (Either E ())
+
+benchMask :: (((forall a. M a -> M a) -> M ()) -> M ()) -> R ()
+benchMask mask = exe $ mask $ \restore -> nop >> restore nop >> nop
+
+
+--------------------------------------------------------------------------------
+-- Utils
+--------------------------------------------------------------------------------
+
+nop :: Monad m => m ()
+nop = return ()
+
+data E = E deriving (Show, Typeable)
+
+instance Exception E
+
+throwE :: MonadIO m => m ()
+throwE = liftIO $ throwIO E
+
+mpMask :: MP.MonadPeelIO m => ((forall a. m a -> m a) -> m b) -> m b
+mpMask f = do
+  k <- MP.peelIO
+  join $ liftIO $ E.mask $ \restore -> k $ f $ MP.liftIOOp_ restore

lifted-base.cabal

@@ -55,11 +55,12 @@ Library
 --------------------------------------------------------------------------------
 
 test-suite test-lifted-base
-  type:    exitcode-stdio-1.0
-  main-is: test.hs
+  type:           exitcode-stdio-1.0
+  main-is:        test.hs
+  hs-source-dirs: test
 
-  build-depends: base                 >= 3     && < 4.6
-               , base-unicode-symbols >= 0.1.1 && < 0.3
+  build-depends: lifted-base
+               , base                 >= 3     && < 4.6
                , transformers         >= 0.2   && < 0.4
                , transformers-base    >= 0.4   && < 0.5
                , monad-control        >= 0.3   && < 0.4
@@ -73,3 +74,17 @@ test-suite test-lifted-base
   ghc-options: -Wall
 
 --------------------------------------------------------------------------------
+
+benchmark bench-lifted-base
+  type:           exitcode-stdio-1.0
+  main-is:        bench.hs
+  hs-source-dirs: bench
+
+  ghc-options:    -O2
+
+  build-depends: lifted-base
+               , base                 	   >= 3       && < 4.6
+               , transformers         	   >= 0.2     && < 0.4
+               , criterion            	   >= 0.5     && < 0.7
+               , monad-control        	   >= 0.3     && < 0.4
+               , monad-peel           	   >= 0.1     && < 0.2

test.hs → test/test.hs

@@ -9,6 +9,7 @@ import Data.Typeable (Typeable)
 -- from transformers-base:
 import Control.Monad.Base (liftBase)
 
+-- from transformers:
 import Control.Monad.Trans.Identity
 import Control.Monad.Trans.List
 import Control.Monad.Trans.Maybe