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

fix test suite build

Browse source
This commit is contained in:
Joey Hess 2012-04-30 13:59:05 -04:00
parent 0c9c14b52f
commit bf70bbdbfc
3 changed files with 14 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

6
Annex.hs
View file

@ -18,6 +18,7 @@ module Annex (
changeState, changeState,
setFlag, setFlag,
setField, setField,
setOutput,
getFlag, getFlag,
getField, getField,
addCleanup, addCleanup,
@ -148,6 +149,11 @@ addCleanup :: String -> Annex () -> Annex ()
addCleanup uid a = changeState $ \s -> addCleanup uid a = changeState $ \s ->
s { cleanup = M.insertWith' const uid a $ cleanup s } s { cleanup = M.insertWith' const uid a $ cleanup s }
{- Sets the type of output to emit. -}
setOutput :: OutputType -> Annex ()
setOutput o = changeState $ \s ->
s { output = (output s) { outputType = o } }
{- Checks if a flag was set. -} {- Checks if a flag was set. -}
getFlag :: String -> Annex Bool getFlag :: String -> Annex Bool
getFlag flag = fromMaybe False . M.lookup flag <$> getState flags getFlag flag = fromMaybe False . M.lookup flag <$> getState flags

8
Option.hs
View file

@ -32,11 +32,11 @@ common =
"avoid slow operations" "avoid slow operations"
, Option ['a'] ["auto"] (NoArg (setauto True)) , Option ['a'] ["auto"] (NoArg (setauto True))
"automatic mode" "automatic mode"
, Option ['q'] ["quiet"] (NoArg (setoutput QuietOutput)) , Option ['q'] ["quiet"] (NoArg (Annex.setOutput QuietOutput))
"avoid verbose output" "avoid verbose output"
, Option ['v'] ["verbose"] (NoArg (setoutput NormalOutput)) , Option ['v'] ["verbose"] (NoArg (Annex.setOutput NormalOutput))
"allow verbose output (default)" "allow verbose output (default)"
, Option ['j'] ["json"] (NoArg (setoutput JSONOutput)) , Option ['j'] ["json"] (NoArg (Annex.setOutput JSONOutput))
"enable JSON output" "enable JSON output"
, Option ['d'] ["debug"] (NoArg setdebug) , Option ['d'] ["debug"] (NoArg setdebug)
"show debug messages" "show debug messages"
@ -47,8 +47,6 @@ common =
setforce v = Annex.changeState $ \s -> s { Annex.force = v } setforce v = Annex.changeState $ \s -> s { Annex.force = v }
setfast v = Annex.changeState $ \s -> s { Annex.fast = v } setfast v = Annex.changeState $ \s -> s { Annex.fast = v }
setauto v = Annex.changeState $ \s -> s { Annex.auto = v } setauto v = Annex.changeState $ \s -> s { Annex.auto = v }
setoutput v = Annex.changeState $ \s ->
s { Annex.output = (Annex.output s) { outputType = v } }
setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v } setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }
setdebug = liftIO $ updateGlobalLogger rootLoggerName $ setdebug = liftIO $ updateGlobalLogger rootLoggerName $
setLevel DEBUG setLevel DEBUG

9
test.hs
View file

@ -38,6 +38,7 @@ import qualified Logs.Remote
import qualified Remote import qualified Remote
import qualified Command.DropUnused import qualified Command.DropUnused
import qualified Types.Key import qualified Types.Key
import qualified Types.Messages
import qualified Config import qualified Config
import qualified Crypto import qualified Crypto
import qualified Utility.Path import qualified Utility.Path
@ -720,10 +721,10 @@ git_annex_expectoutput command params expected = do
-- are not run; this should only be used for actions that query state. -- are not run; this should only be used for actions that query state.
annexeval :: Types.Annex a -> IO a annexeval :: Types.Annex a -> IO a
annexeval a = do annexeval a = do
g <- Git.Construct.fromCurrent s <- Annex.new =<< Git.Config.read =<< Git.Construct.fromCurrent
g' <- Git.Config.read g Annex.eval s $ do
s <- Annex.new g' Annex.setOutput Types.Messages.QuietOutput
Annex.eval s { Annex.output = Annex.QuietOutput } a a
innewrepo :: Assertion -> Assertion innewrepo :: Assertion -> Assertion
innewrepo a = withgitrepo $ \r -> indir r a innewrepo a = withgitrepo $ \r -> indir r a