summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-02-18 20:01:56 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-02-18 20:02:09 -0400
commit5ec224d48f28bb8823d898ecc10a9c376a41245b (patch)
tree2d3167b0ad6408295222b8e492eca635dd462c1c /Command
parent0d916443be47784173c86c25c8fb4ede764af1ba (diff)
add vadd command
Diffstat (limited to 'Command')
-rw-r--r--Command/VAdd.hs47
-rw-r--r--Command/View.hs2
2 files changed, 48 insertions, 1 deletions
diff --git a/Command/VAdd.hs b/Command/VAdd.hs
new file mode 100644
index 000000000..a79e91215
--- /dev/null
+++ b/Command/VAdd.hs
@@ -0,0 +1,47 @@
+{- git-annex command
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.VAdd where
+
+import Common.Annex
+import Command
+import Types.View
+import Annex.View
+import Logs.View
+import Command.View (paramView, parseViewParam, checkoutViewBranch)
+
+def :: [Command]
+def = [notBareRepo $ notDirect $
+ command "vadd" paramView seek SectionUtility "refine current view"]
+
+seek :: CommandSeek
+seek = withWords start
+
+start :: [String] -> CommandStart
+start params = do
+ showStart "vadd" ""
+ go =<< currentView
+ where
+ go Nothing = error "Not in a view."
+ go (Just view) = do
+ let (view', change) = calc view Unchanged (reverse params)
+ case change of
+ Unchanged -> do
+ showNote "unchanged"
+ next $ next $ return True
+ Widening -> error "Widening view to match more files is not currently supported."
+ Narrowing -> next $ perform view'
+
+ calc v c [] = (v, c)
+ calc v c (p:ps) =
+ let (v', c') = uncurry (refineView v) (parseViewParam p)
+ in calc v' (max c c') ps
+
+perform :: View -> CommandPerform
+perform view = do
+ branch <- narrowView view
+ next $ checkoutViewBranch view branch
diff --git a/Command/View.hs b/Command/View.hs
index 309a1ccbe..4e642e50f 100644
--- a/Command/View.hs
+++ b/Command/View.hs
@@ -39,7 +39,7 @@ start params = do
perform :: View -> CommandPerform
perform view = do
- showSideAction "calculating"
+ showSideAction "searching"
branch <- applyView view
next $ checkoutViewBranch view branch