diff options
| -rw-r--r-- | GitAnnex.hs | 75 | ||||
| -rw-r--r-- | debian/changelog | 2 | ||||
| -rw-r--r-- | git-annex.hs | 66 | ||||
| -rw-r--r-- | test.hs | 42 |
4 files changed, 99 insertions, 86 deletions
diff --git a/GitAnnex.hs b/GitAnnex.hs new file mode 100644 index 000000000..05e98d3c3 --- /dev/null +++ b/GitAnnex.hs @@ -0,0 +1,75 @@ +{- git-annex main program + - + - Copyright 2010 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module GitAnnex where + +import System.Console.GetOpt + +import Command +import Options + +import qualified Command.Add +import qualified Command.Unannex +import qualified Command.Drop +import qualified Command.Move +import qualified Command.Copy +import qualified Command.Get +import qualified Command.FromKey +import qualified Command.DropKey +import qualified Command.SetKey +import qualified Command.Fix +import qualified Command.Init +import qualified Command.Fsck +import qualified Command.Unused +import qualified Command.DropUnused +import qualified Command.Unlock +import qualified Command.Lock +import qualified Command.PreCommit +import qualified Command.Find +import qualified Command.Uninit +import qualified Command.Trust +import qualified Command.Untrust + +cmds :: [Command] +cmds = concat + [ Command.Add.command + , Command.Get.command + , Command.Drop.command + , Command.Move.command + , Command.Copy.command + , Command.Unlock.command + , Command.Lock.command + , Command.Init.command + , Command.Unannex.command + , Command.Uninit.command + , Command.PreCommit.command + , Command.Trust.command + , Command.Untrust.command + , Command.FromKey.command + , Command.DropKey.command + , Command.SetKey.command + , Command.Fix.command + , Command.Fsck.command + , Command.Unused.command + , Command.DropUnused.command + , Command.Find.command + ] + +options :: [Option] +options = commonOptions ++ + [ Option ['k'] ["key"] (ReqArg (storeOptString "key") paramKey) + "specify a key to use" + , Option ['t'] ["to"] (ReqArg (storeOptString "torepository") paramRemote) + "specify to where to transfer content" + , Option ['f'] ["from"] (ReqArg (storeOptString "fromrepository") paramRemote) + "specify from where to transfer content" + , Option ['x'] ["exclude"] (ReqArg (storeOptString "exclude") paramGlob) + "skip files matching the glob pattern" + ] + +header :: String +header = "Usage: git-annex command [option ..]" diff --git a/debian/changelog b/debian/changelog index d9aa1e4de..0aaaa75e6 100644 --- a/debian/changelog +++ b/debian/changelog @@ -8,7 +8,7 @@ git-annex (0.16) UNRELEASED; urgency=low significant problem, since the remote *did* record that it had the file. * Also, add a general guard to detect attempts to record information about repositories with missing UUIDs. - * Test suite improvements. + * Test suite improvements. Current top-level test coverage: 43% -- Joey Hess <joeyh@debian.org> Tue, 04 Jan 2011 17:33:42 -0400 diff --git a/git-annex.hs b/git-annex.hs index dff67f9d8..f95181784 100644 --- a/git-annex.hs +++ b/git-annex.hs @@ -6,74 +6,10 @@ -} import System.Environment -import System.Console.GetOpt import qualified GitRepo as Git import CmdLine -import Command -import Options - -import qualified Command.Add -import qualified Command.Unannex -import qualified Command.Drop -import qualified Command.Move -import qualified Command.Copy -import qualified Command.Get -import qualified Command.FromKey -import qualified Command.DropKey -import qualified Command.SetKey -import qualified Command.Fix -import qualified Command.Init -import qualified Command.Fsck -import qualified Command.Unused -import qualified Command.DropUnused -import qualified Command.Unlock -import qualified Command.Lock -import qualified Command.PreCommit -import qualified Command.Find -import qualified Command.Uninit -import qualified Command.Trust -import qualified Command.Untrust - -cmds :: [Command] -cmds = concat - [ Command.Add.command - , Command.Get.command - , Command.Drop.command - , Command.Move.command - , Command.Copy.command - , Command.Unlock.command - , Command.Lock.command - , Command.Init.command - , Command.Unannex.command - , Command.Uninit.command - , Command.PreCommit.command - , Command.Trust.command - , Command.Untrust.command - , Command.FromKey.command - , Command.DropKey.command - , Command.SetKey.command - , Command.Fix.command - , Command.Fsck.command - , Command.Unused.command - , Command.DropUnused.command - , Command.Find.command - ] - -options :: [Option] -options = commonOptions ++ - [ Option ['k'] ["key"] (ReqArg (storeOptString "key") paramKey) - "specify a key to use" - , Option ['t'] ["to"] (ReqArg (storeOptString "torepository") paramRemote) - "specify to where to transfer content" - , Option ['f'] ["from"] (ReqArg (storeOptString "fromrepository") paramRemote) - "specify from where to transfer content" - , Option ['x'] ["exclude"] (ReqArg (storeOptString "exclude") paramGlob) - "skip files matching the glob pattern" - ] - -header :: String -header = "Usage: git-annex command [option ..]" +import GitAnnex main :: IO () main = do @@ -10,35 +10,30 @@ import Test.HUnit.Tools import System.Directory import System.Posix.Directory (changeWorkingDirectory) import System.Posix.Files -import System.Posix.Env import IO (bracket_, bracket) import Control.Monad (unless, when) import Data.List import System.IO.Error import qualified GitRepo as Git -import Locations -import Utility -import TypeInternals +import qualified Locations +import qualified Utility +import qualified TypeInternals +import qualified GitAnnex +import qualified CmdLine main :: IO (Counts, Int) -main = do - -- Add current directory to the from of PATH, so git-annex etc will - -- be used, no matter where it is run from. - cwd <- getCurrentDirectory - p <- getEnvDefault "PATH" "" - setEnv "PATH" (cwd++":"++p) True - runVerboseTests $ TestList [quickchecks, toplevels] +main = runVerboseTests $ TestList [quickchecks, toplevels] quickchecks :: Test quickchecks = TestLabel "quickchecks" $ TestList [ qctest "prop_idempotent_deencode" Git.prop_idempotent_deencode - , qctest "prop_idempotent_fileKey" prop_idempotent_fileKey - , qctest "prop_idempotent_key_read_show" prop_idempotent_key_read_show - , qctest "prop_idempotent_shellEscape" prop_idempotent_shellEscape - , qctest "prop_idempotent_shellEscape_multiword" prop_idempotent_shellEscape_multiword - , qctest "prop_parentDir_basics" prop_parentDir_basics - , qctest "prop_relPathDirToDir_basics" prop_relPathDirToDir_basics + , qctest "prop_idempotent_fileKey" Locations.prop_idempotent_fileKey + , qctest "prop_idempotent_key_read_show" TypeInternals.prop_idempotent_key_read_show + , qctest "prop_idempotent_shellEscape" Utility.prop_idempotent_shellEscape + , qctest "prop_idempotent_shellEscape_multiword" Utility.prop_idempotent_shellEscape_multiword + , qctest "prop_parentDir_basics" Utility.prop_parentDir_basics + , qctest "prop_relPathDirToDir_basics" Utility.prop_relPathDirToDir_basics ] toplevels :: Test @@ -79,7 +74,14 @@ test_add = TestLabel "git-annex add" $ TestCase $ inannex $ do content = "foo file content" git_annex :: String -> [String] -> IO Bool -git_annex command params = boolSystem "git-annex" (command:params) +git_annex command params = do + gitrepo <- Git.repoFromCwd + r <- try $ + CmdLine.dispatch gitrepo (command:params) + GitAnnex.cmds GitAnnex.options GitAnnex.header + case r of + Right _ -> return True + Left _ -> return False inannex :: Assertion -> Assertion inannex a = ingitrepo $ do @@ -103,7 +105,7 @@ withgitrepo = bracket setup cleanup setup = do cleanup True createDirectory tmpdir - ok <- boolSystem "git" ["init", "-q", repodir] + ok <- Utility.boolSystem "git" ["init", "-q", repodir] unless ok $ assertFailure "git init failed" return $ Git.repoFromPath repodir @@ -113,5 +115,5 @@ withgitrepo = bracket setup cleanup -- git-annex prevents annexed file content -- from being removed with permissions -- bits; undo - _ <- boolSystem "chmod" ["+rw", "-R", tmpdir] + _ <- Utility.boolSystem "chmod" ["+rw", "-R", tmpdir] removeDirectoryRecursive tmpdir |