diff options
author | Joey Hess <joey@kitenet.net> | 2011-12-05 22:51:37 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-12-05 22:51:37 -0400 |
commit | f3a2f60abc7c7c5a8e29ce96675da46c1861c50e (patch) | |
tree | fb848c25d88cb04bbd8820c6c9e0731d71ea9f9b | |
parent | 2a1e3bceb30a51f38bebc93e9321ed12d9567ec0 (diff) |
adjust to build with monad-control-0.3
I had to, I hope temporarily, lose my nice Annex newtype, and use a type
synonym. This because I cannot find a way to derive a MonadBaseControl
instance of the Annex newtype. I've emailed Bas van Dijk in hope he can
help get the newtype back.
Otherwise appears to build & work.
-rw-r--r-- | Annex.hs | 16 | ||||
-rw-r--r-- | Annex/Exception.hs | 6 |
2 files changed, 7 insertions, 15 deletions
@@ -22,7 +22,7 @@ module Annex ( fromRepo, ) where -import Control.Monad.IO.Control +import Control.Monad.Trans.Control import Control.Monad.State import Common @@ -38,15 +38,7 @@ import Types.UUID import qualified Utility.Matcher -- git-annex's monad -newtype Annex a = Annex { runAnnex :: StateT AnnexState IO a } - deriving ( - Monad, - MonadIO, - MonadControlIO, - MonadState AnnexState, - Functor, - Applicative - ) +type Annex = StateT AnnexState IO data OutputType = NormalOutput | QuietOutput | JSONOutput @@ -102,9 +94,9 @@ new gitrepo = newState <$> Git.configRead gitrepo {- performs an action in the Annex monad -} run :: AnnexState -> Annex a -> IO (a, AnnexState) -run s a = runStateT (runAnnex a) s +run s a = runStateT a s eval :: AnnexState -> Annex a -> IO a -eval s a = evalStateT (runAnnex a) s +eval s a = evalStateT a s {- Gets a value from the internal state, selected by the passed value - constructor. -} 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 |