diff options
| -rw-r--r-- | Annex.hs | 17 | ||||
| -rw-r--r-- | Annex/Exception.hs | 6 | ||||
| -rw-r--r-- | git-annex.cabal | 4 |
3 files changed, 19 insertions, 8 deletions
@@ -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 |