summaryrefslogtreecommitdiff
path: root/Command/View.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Command/View.hs')
-rw-r--r--Command/View.hs88
1 files changed, 88 insertions, 0 deletions
diff --git a/Command/View.hs b/Command/View.hs
new file mode 100644
index 000000000..309a1ccbe
--- /dev/null
+++ b/Command/View.hs
@@ -0,0 +1,88 @@
+{- git-annex command
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.View where
+
+import Common.Annex
+import Command
+import qualified Git
+import qualified Git.Command
+import qualified Git.Ref
+import qualified Git.Branch
+import Types.MetaData
+import Types.View
+import Annex.View
+import Logs.View
+
+def :: [Command]
+def = [notBareRepo $ notDirect $
+ command "view" paramView seek SectionUtility "enter a view branch"]
+
+seek :: CommandSeek
+seek = withWords start
+
+start :: [String] -> CommandStart
+start [] = error "Specify metadata to include in view"
+start params = do
+ showStart "view" ""
+ view <- mkView params
+ go view =<< currentView
+ where
+ go view Nothing = next $ perform view
+ go view (Just v)
+ | v == view = stop
+ | otherwise = error "Already in a view. Use 'git annex vadd' to further refine this view."
+
+perform :: View -> CommandPerform
+perform view = do
+ showSideAction "calculating"
+ branch <- applyView view
+ next $ checkoutViewBranch view branch
+
+paramView :: String
+paramView = paramPair (paramRepeating "FIELD=VALUE") (paramRepeating "TAG")
+
+parseViewParam :: String -> (MetaField, String)
+parseViewParam s = case separate (== '=') s of
+ (tag, []) -> (tagMetaField, tag)
+ (field, wanted) -> either error (\f -> (f, wanted)) (mkMetaField field)
+
+mkView :: [String] -> Annex View
+mkView params = do
+ v <- View <$> viewbranch <*> pure []
+ return $ calc v $ reverse params
+ where
+ calc v [] = v
+ calc v (p:ps) =
+ let (v', _) = uncurry (refineView v) (parseViewParam p)
+ in calc v' ps
+ viewbranch = fromMaybe (error "not on any branch!")
+ <$> inRepo Git.Branch.current
+
+checkoutViewBranch :: View -> Git.Branch -> CommandCleanup
+checkoutViewBranch view branch = do
+ ok <- inRepo $ Git.Command.runBool
+ [ Param "checkout"
+ , Param (show $ Git.Ref.base branch)
+ ]
+ when ok $ do
+ setView view
+ top <- fromRepo Git.repoPath
+ cwd <- liftIO getCurrentDirectory
+ {- A git repo can easily have empty directories in it,
+ - and this pollutes the view, so remove them. -}
+ liftIO $ removeemptydirs top
+ unlessM (liftIO $ doesDirectoryExist cwd) $
+ showLongNote (cwdmissing top)
+ return ok
+ where
+ removeemptydirs top = mapM_ (tryIO . removeDirectory)
+ =<< dirTreeRecursiveSkipping (".git" `isSuffixOf`) top
+ cwdmissing top = unlines
+ [ "This view does not include the subdirectory you are currently in."
+ , "Perhaps you should: cd " ++ top
+ ]