Merge branch 'new-monad-control'

3 files changed, 19 insertions, 8 deletions

diff --git a/Annex.hs b/Annex.hs
index e82ffc5d1..8f8936937 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -5,7 +5,7 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, MultiParamTypeClasses #-}
 
 module Annex (
 	Annex,
@@ -22,8 +22,9 @@ module Annex (
 	fromRepo,
 ) where
 
-import Control.Monad.IO.Control
 import Control.Monad.State
+import Control.Monad.Trans.Control (StM, MonadBaseControl, liftBaseWith, restoreM)
+import Control.Monad.Base (liftBase, MonadBase)
 
 import Common
 import qualified Git
@@ -45,12 +46,22 @@ newtype Annex a = Annex { runAnnex :: StateT AnnexState IO a }
 	deriving (
 		Monad,
 		MonadIO,
-		MonadControlIO,
 		MonadState AnnexState,
 		Functor,
 		Applicative
 	)
 
+instance MonadBase IO Annex where
+	liftBase = Annex . liftBase
+
+instance MonadBaseControl IO Annex where
+	newtype StM Annex a = StAnnex (StM (StateT AnnexState IO) a)
+	liftBaseWith f = Annex $ liftBaseWith $ \runInIO ->
+		f $ liftM StAnnex . runInIO . runAnnex
+	restoreM = Annex . restoreM . unStAnnex
+		where
+			unStAnnex (StAnnex st) = st
+
 data OutputType = NormalOutput | QuietOutput | JSONOutput
 
 -- internal state storage
diff --git a/Annex/Exception.hs b/Annex/Exception.hs
index c147439a1..cb36d1bdb 100644
--- a/Annex/Exception.hs
+++ b/Annex/Exception.hs
@@ -11,8 +11,8 @@ module Annex.Exception (
 	throw,
 ) where
 
-import Control.Exception.Control (handle)
-import Control.Monad.IO.Control (liftIOOp)
+import Control.Exception.Lifted (handle)
+import Control.Monad.Trans.Control (liftBaseOp)
 import Control.Exception hiding (handle, throw)
 
 import Common.Annex
@@ -20,7 +20,7 @@ import Common.Annex
 {- Runs an Annex action, with setup and cleanup both in the IO monad. -}
 bracketIO :: IO c -> (c -> IO b) -> Annex a -> Annex a
 bracketIO setup cleanup go =
-	liftIOOp (Control.Exception.bracket setup cleanup) (const go)
+	liftBaseOp (Control.Exception.bracket setup cleanup) (const go)
 
 {- Throws an exception in the Annex monad. -}
 throw :: Control.Exception.Exception e => e -> Annex a
diff --git a/git-annex.cabal b/git-annex.cabal
index ae6a129b3..a0980b1f0 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -30,8 +30,8 @@ Executable git-annex
   Main-Is: git-annex.hs
   Build-Depends: MissingH, hslogger, directory, filepath,
    unix, containers, utf8-string, network, mtl, bytestring, old-locale, time,
-   pcre-light, extensible-exceptions, dataenc, SHA, process, hS3, HTTP,
-   base < 5, monad-control < 0.3, json
+   pcre-light, extensible-exceptions, dataenc, SHA, process, hS3, json, HTTP,
+   base < 5, monad-control, transformers-base, lifted-base
 
 Executable git-annex-shell
   Main-Is: git-annex-shell.hs