Merge branch 'new-monad-control'

1 files changed, 14 insertions, 3 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