git-annex/GitAnnex.hs

130 lines
3.8 KiB
Haskell
Raw Normal View History

{- 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 Control.Monad.State (liftIO)
import qualified Git
2011-01-07 06:15:10 +00:00
import CmdLine
import Command
import Options
2011-06-01 20:49:17 +00:00
import Utility
import Types
import Types.TrustLevel
import qualified Annex
import qualified Remote
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
2011-03-03 21:21:00 +00:00
import qualified Command.Describe
2011-03-29 03:22:31 +00:00
import qualified Command.InitRemote
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.Whereis
2011-06-22 22:46:45 +00:00
import qualified Command.Merge
import qualified Command.Status
import qualified Command.Migrate
import qualified Command.Uninit
import qualified Command.Trust
import qualified Command.Untrust
import qualified Command.Semitrust
2011-07-01 21:15:46 +00:00
import qualified Command.AddUrl
import qualified Command.Map
2011-03-16 19:48:26 +00:00
import qualified Command.Upgrade
import qualified Command.Version
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
2011-03-03 21:21:00 +00:00
, Command.Describe.command
2011-03-29 03:22:31 +00:00
, Command.InitRemote.command
, Command.Unannex.command
, Command.Uninit.command
, Command.PreCommit.command
, Command.Trust.command
, Command.Untrust.command
, Command.Semitrust.command
2011-07-01 21:15:46 +00:00
, Command.AddUrl.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
, Command.Whereis.command
2011-06-22 22:46:45 +00:00
, Command.Merge.command
, Command.Status.command
, Command.Migrate.command
, Command.Map.command
2011-03-16 19:48:26 +00:00
, Command.Upgrade.command
, Command.Version.command
]
options :: [Option]
options = commonOptions ++
[ Option ['k'] ["key"] (ReqArg setkey paramKey)
"specify a key to use"
, Option ['t'] ["to"] (ReqArg setto paramRemote)
"specify to where to transfer content"
, Option ['f'] ["from"] (ReqArg setfrom paramRemote)
"specify from where to transfer content"
, Option ['x'] ["exclude"] (ReqArg addexclude paramGlob)
"skip files matching the glob pattern"
2011-06-01 20:49:17 +00:00
, Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber)
"override default number of copies"
2011-06-02 06:33:31 +00:00
, Option [] ["trust"] (ReqArg (Remote.forceTrust Trusted) paramRemote)
"override trust setting"
2011-06-02 06:33:31 +00:00
, Option [] ["semitrust"] (ReqArg (Remote.forceTrust SemiTrusted) paramRemote)
"override trust setting back to default"
2011-06-02 06:33:31 +00:00
, Option [] ["untrust"] (ReqArg (Remote.forceTrust UnTrusted) paramRemote)
"override trust setting to untrusted"
, Option ['c'] ["config"] (ReqArg setgitconfig "NAME=VALUE")
"override git configuration setting"
]
where
setto v = Annex.changeState $ \s -> s { Annex.toremote = Just v }
setfrom v = Annex.changeState $ \s -> s { Annex.fromremote = Just v }
addexclude v = Annex.changeState $ \s -> s { Annex.exclude = v:Annex.exclude s }
2011-06-01 20:49:17 +00:00
setnumcopies v = Annex.changeState $ \s -> s {Annex.forcenumcopies = readMaybe v }
setkey v = Annex.changeState $ \s -> s { Annex.defaultkey = Just v }
setgitconfig :: String -> Annex ()
setgitconfig v = do
g <- Annex.gitRepo
g' <- liftIO $ Git.configStore g v
Annex.changeState $ \s -> s { Annex.repo = g' }
header :: String
header = "Usage: git-annex command [option ..]"
2011-01-07 06:15:10 +00:00
run :: [String] -> IO ()
2011-06-02 06:40:43 +00:00
run args = dispatch args cmds options header =<< Git.repoFromCwd