summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-10-14 21:10:59 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-10-14 21:10:59 -0400
commit29039fdf97f541a1077c9af65ccbe09dd2ae2b28 (patch)
treed46d1c1489422352df166789cf9baeb56132501b
parent4c3ad80f320d3c4cccc3e41e4f2364155bae22a1 (diff)
add flags, and change to subcommand style
-rw-r--r--Annex.hs18
-rw-r--r--BackendTypes.hs7
-rw-r--r--Commands.hs50
-rw-r--r--Core.hs5
-rw-r--r--TODO2
-rw-r--r--Types.hs3
-rw-r--r--git-annex.hs4
7 files changed, 59 insertions, 30 deletions
diff --git a/Annex.hs b/Annex.hs
index 9be86c948..9e76b9b04 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -7,6 +7,9 @@ module Annex (
gitRepoChange,
backends,
backendsChange,
+ flagIsSet,
+ flagsChange,
+ Flag(..)
) where
import Control.Monad.State
@@ -18,7 +21,11 @@ import qualified BackendTypes as Backend
-}
new :: Git.Repo -> IO AnnexState
new g = do
- let s = Backend.AnnexState { Backend.repo = g, Backend.backends = [] }
+ let s = Backend.AnnexState {
+ Backend.repo = g,
+ Backend.backends = [],
+ Backend.flags = []
+ }
(_,s') <- Annex.run s (prep g)
return s'
where
@@ -49,3 +56,12 @@ backendsChange b = do
state <- get
put state { Backend.backends = b }
return ()
+flagIsSet :: Flag -> Annex Bool
+flagIsSet flag = do
+ state <- get
+ return $ elem flag $ Backend.flags state
+flagsChange :: [Flag] -> Annex ()
+flagsChange b = do
+ state <- get
+ put state { Backend.flags = b }
+ return ()
diff --git a/BackendTypes.hs b/BackendTypes.hs
index 41ff7e506..1b67ef584 100644
--- a/BackendTypes.hs
+++ b/BackendTypes.hs
@@ -9,11 +9,16 @@ import Control.Monad.State (StateT)
import Data.String.Utils
import qualified GitRepo as Git
+-- command-line flags
+data Flag = Force
+ deriving (Eq, Read, Show)
+
-- git-annex's runtime state type doesn't really belong here,
-- but it uses Backend, so has to be here to avoid a depends loop.
data AnnexState = AnnexState {
repo :: Git.Repo,
- backends :: [Backend]
+ backends :: [Backend],
+ flags :: [Flag]
} deriving (Show)
-- git-annex's monad
diff --git a/Commands.hs b/Commands.hs
index 7ff33ab02..a16470fe3 100644
--- a/Commands.hs
+++ b/Commands.hs
@@ -1,6 +1,6 @@
{- git-annex command line -}
-module Commands (argvToActions) where
+module Commands (parseCmd) where
import System.Console.GetOpt
import Control.Monad.State (liftIO)
@@ -21,30 +21,34 @@ import Types
import Core
import qualified Remotes
-options :: [OptDescr (String -> Annex ())]
-options =
- [ Option ['a'] ["add"] (NoArg addCmd) "add files to annex"
- , Option ['p'] ["push"] (NoArg pushCmd) "push annex to repos"
- , Option ['P'] ["pull"] (NoArg pullCmd) "pull annex from repos"
- , Option ['w'] ["want"] (NoArg wantCmd) "request file contents"
- , Option ['g'] ["get"] (NoArg getCmd) "transfer file contents"
- , Option ['d'] ["drop"] (NoArg dropCmd) "indicate file contents not needed"
- , Option ['u'] ["unannex"] (NoArg unannexCmd) "undo --add"
- ]
-
{- Parses command line and returns a list of actons to be run in the Annex
- monad. -}
-argvToActions :: [String] -> IO [Annex ()]
-argvToActions argv = do
- case getOpt Permute options argv of
- ([],files,[]) -> return $ map defaultCmd files
- -- one mode is normal case
- (m:[],files,[]) -> return $ map m files
- -- multiple modes is an error
- (ms,files,[]) -> ioError (userError ("only one mode should be specified\n" ++ usageInfo header options))
- -- error case
- (_,files,errs) -> ioError (userError (concat errs ++ usageInfo header options))
- where header = "Usage: git-annex [mode] file"
+parseCmd :: [String] -> IO ([Flag], [Annex ()])
+parseCmd argv = do
+ (flags, nonopts) <- getopt
+ case (length nonopts) of
+ 0 -> error header
+ _ -> do
+ let c = lookupCmd (nonopts !! 0)
+ if (0 == length c)
+ then return $ (flags, map defaultCmd nonopts)
+ else do
+ return $ (flags, map (snd $ c !! 0) $ drop 1 nonopts)
+ where
+ getopt = case getOpt Permute options argv of
+ (flags, nonopts, []) -> return (flags, nonopts)
+ (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))
+ lookupCmd cmd = filter (\(c, a) -> c == cmd) cmds
+ cmds = [ ("add", addCmd)
+ , ("push", pushCmd)
+ , ("pull", pullCmd)
+ , ("want", wantCmd)
+ , ("drop", dropCmd)
+ , ("unannex", unannexCmd)
+ ]
+ header = "Usage: git-annex [" ++
+ (join "|" $ map fst cmds) ++ "] file ..."
+ options = [ Option ['f'] ["force"] (NoArg Force) "" ]
{- Default mode is to annex a file if it is not already, and otherwise
- get its content. -}
diff --git a/Core.hs b/Core.hs
index 6f05394bb..765b1e6a7 100644
--- a/Core.hs
+++ b/Core.hs
@@ -12,8 +12,9 @@ import qualified GitRepo as Git
import qualified Annex
{- Sets up a git repo for git-annex. -}
-setup :: Annex ()
-setup = do
+startup :: [Flag] -> Annex ()
+startup flags = do
+ Annex.flagsChange flags
g <- Annex.gitRepo
liftIO $ gitAttributes g
prepUUID
diff --git a/TODO b/TODO
index c4ce74e19..b800097a0 100644
--- a/TODO
+++ b/TODO
@@ -3,6 +3,8 @@
* --push/--pull/--want
+* recurse on directories
+
* how to handle git mv file?
* finish BackendChecksum
diff --git a/Types.hs b/Types.hs
index a0f120db0..6bf26d36e 100644
--- a/Types.hs
+++ b/Types.hs
@@ -6,7 +6,8 @@ module Types (
Backend,
Key,
backendName,
- keyFrag
+ keyFrag,
+ Flag(..),
) where
import BackendTypes
diff --git a/git-annex.hs b/git-annex.hs
index e14739195..cd67242af 100644
--- a/git-annex.hs
+++ b/git-annex.hs
@@ -12,10 +12,10 @@ import qualified GitRepo as Git
main = do
args <- getArgs
- actions <- argvToActions args
+ (flags, actions) <- parseCmd args
gitrepo <- Git.repoFromCwd
state <- new gitrepo
- tryRun state $ [setup] ++ actions ++ [shutdown]
+ tryRun state $ [startup flags] ++ actions ++ [shutdown]
{- Runs a list of Annex actions. Catches exceptions, not stopping
- if some error out, and propigates an overall error status at the end.