mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

adjust to build with monad-control-0.3

Browse source 
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.
This commit is contained in:
Joey Hess 2011-12-05 22:51:37 -04:00
parent 2a1e3bceb3
commit f3a2f60abc
2 changed files with 7 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
Annex.hs
View file

@ -22,7 +22,7 @@ module Annex (
fromRepo, fromRepo,
) where ) where
import Control.Monad.IO.Control import Control.Monad.Trans.Control
import Control.Monad.State import Control.Monad.State
import Common import Common
@ -38,15 +38,7 @@ import Types.UUID
import qualified Utility.Matcher import qualified Utility.Matcher
-- git-annex's monad -- git-annex's monad
newtype Annex a = Annex { runAnnex :: StateT AnnexState IO a } type Annex = StateT AnnexState IO
deriving (
Monad,
MonadIO,
MonadControlIO,
MonadState AnnexState,
Functor,
Applicative
)
data OutputType = NormalOutput | QuietOutput | JSONOutput data OutputType = NormalOutput | QuietOutput | JSONOutput
@ -102,9 +94,9 @@ new gitrepo = newState <$> Git.configRead gitrepo
{- performs an action in the Annex monad -} {- performs an action in the Annex monad -}
run :: AnnexState -> Annex a -> IO (a, AnnexState) 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 :: 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 {- Gets a value from the internal state, selected by the passed value
- constructor. -} - constructor. -}

6
Annex/Exception.hs
View file

@ -11,8 +11,8 @@ module Annex.Exception (
throw, throw,
) where ) where
import Control.Exception.Control (handle) import Control.Exception.Lifted (handle)
import Control.Monad.IO.Control (liftIOOp) import Control.Monad.Trans.Control (liftBaseOp)
import Control.Exception hiding (handle, throw) import Control.Exception hiding (handle, throw)
import Common.Annex import Common.Annex
@ -20,7 +20,7 @@ import Common.Annex
{- Runs an Annex action, with setup and cleanup both in the IO monad. -} {- Runs an Annex action, with setup and cleanup both in the IO monad. -}
bracketIO :: IO c -> (c -> IO b) -> Annex a -> Annex a bracketIO :: IO c -> (c -> IO b) -> Annex a -> Annex a
bracketIO setup cleanup go = 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. -} {- Throws an exception in the Annex monad. -}
throw :: Control.Exception.Exception e => e -> Annex a throw :: Control.Exception.Exception e => e -> Annex a