converted ContentLocation, ExampleKey, LookupKey

5 files changed, 58 insertions, 48 deletions

diff --git a/CmdLine/Batch.hs b/CmdLine/Batch.hs
index 24f942978..57823b67b 100644
--- a/CmdLine/Batch.hs
+++ b/CmdLine/Batch.hs
@@ -10,29 +10,42 @@ module CmdLine.Batch where
 import Common.Annex
 import Command
 
-batchOption :: Option
-batchOption = flagOption [] "batch" "enable batch mode"
-
 data BatchMode = Batch | NoBatch
+
+batchOption :: Parser BatchMode
+batchOption = flag NoBatch Batch
+	( long "batch"
+	<> help "enable batch mode"
+	)
+
 type Batchable t = BatchMode -> t -> CommandStart
 
 -- A Batchable command can run in batch mode, or not.
 -- In batch mode, one line at a time is read, parsed, and a reply output to
 -- stdout. In non batch mode, the command's parameters are parsed and
 -- a reply output for each.
-batchable :: ((t -> CommandStart) -> CmdParams -> CommandSeek) -> Batchable t -> CmdParams -> CommandSeek
-batchable seeker starter params = ifM (getOptionFlag batchOption)
-	( batchloop
-	, seeker (starter NoBatch) params
-	)
+batchable :: (opts -> String -> Annex Bool) -> Parser opts -> CmdParamsDesc -> CommandParser
+batchable handler parser paramdesc = batchseeker <$> batchparser
   where
-	batchloop = do
+	batchparser = (,,)
+		<$> parser
+		<*> batchOption
+		<*> cmdParams paramdesc
+	
+	batchseeker (opts, NoBatch, params) = mapM_ (go NoBatch opts) params
+	batchseeker (opts, Batch, _) = batchloop opts
+
+	batchloop opts = do
 		mp <- liftIO $ catchMaybeIO getLine
 		case mp of
 			Nothing -> return ()
 			Just p -> do
-				seeker (starter Batch) [p]
-				batchloop
+				go Batch opts p
+				batchloop opts
+
+	go batchmode opts p =
+		unlessM (handler opts p) $
+			batchBadInput batchmode
 
 -- bad input is indicated by an empty line in batch mode. In non batch
 -- mode, exit on bad input.
diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs
index 74a831f8b..c569519e5 100644
--- a/CmdLine/GitAnnex.hs
+++ b/CmdLine/GitAnnex.hs
@@ -23,9 +23,9 @@ import qualified Command.Move
 import qualified Command.Copy
 import qualified Command.Get
 import qualified Command.Fsck
---import qualified Command.LookupKey
---import qualified Command.ContentLocation
---import qualified Command.ExamineKey
+import qualified Command.LookupKey
+import qualified Command.ContentLocation
+import qualified Command.ExamineKey
 import qualified Command.FromKey
 import qualified Command.RegisterUrl
 import qualified Command.SetKey
@@ -158,9 +158,9 @@ cmds =
 	, Command.Schedule.cmd
 	, Command.Ungroup.cmd
 	, Command.Vicfg.cmd
---	, Command.LookupKey.cmd
---	, Command.ContentLocation.cmd
---	, Command.ExamineKey.cmd
+	, Command.LookupKey.cmd
+	, Command.ContentLocation.cmd
+	, Command.ExamineKey.cmd
 	, Command.FromKey.cmd
 	, Command.RegisterUrl.cmd
 	, Command.SetKey.cmd
diff --git a/Command/ContentLocation.hs b/Command/ContentLocation.hs
index bca73f926..8a5eaa7a9 100644
--- a/Command/ContentLocation.hs
+++ b/Command/ContentLocation.hs
@@ -11,21 +11,20 @@ import Common.Annex
 import Command
 import CmdLine.Batch
 import Annex.Content
+import Types.Key
 
 cmd :: Command
-cmd = withOptions [batchOption] $ noCommit $ noMessages $
+cmd = noCommit $ noMessages $
 	command "contentlocation" SectionPlumbing 
 		"looks up content for a key"
-		(paramRepeating paramKey) (withParams seek)
+		(paramRepeating paramKey)
+		(batchable run (pure ()))
 
-seek :: CmdParams -> CommandSeek
-seek = batchable withKeys start
-
-start :: Batchable Key
-start batchmode k = do
-	maybe (batchBadInput batchmode) (liftIO . putStrLn)
+run :: () -> String -> Annex Bool
+run _ p = do
+	let k = fromMaybe (error "bad key") $ file2key p
+	maybe (return False) (\f -> liftIO (putStrLn f) >> return True)
 		=<< inAnnex' (pure True) Nothing check k
-	stop
   where
 	check f = ifM (liftIO (doesFileExist f))
 		( return (Just f)
diff --git a/Command/ExamineKey.hs b/Command/ExamineKey.hs
index e0a1d9747..55f72f71b 100644
--- a/Command/ExamineKey.hs
+++ b/Command/ExamineKey.hs
@@ -11,21 +11,18 @@ import Common.Annex
 import Command
 import CmdLine.Batch
 import qualified Utility.Format
-import Command.Find (FindOptions(..), showFormatted, keyVars)
+import Command.Find (parseFormatOption, showFormatted, keyVars)
 import Types.Key
 
 cmd :: Command
-cmd = noCommit $ noMessages $ withOptions [formatOption, jsonOption, batchOption] $
+cmd = noCommit $ noMessages $ withGlobalOptions [jsonOption] $
 	command "examinekey" SectionPlumbing 
 		"prints information from a key"
-		(paramRepeating paramKey) (withParams seek)
+		(paramRepeating paramKey)
+		(batchable run (optional parseFormatOption))
 
-seek :: CmdParams -> CommandSeek
-seek ps = do
-	format <- getFormat
-	batchable withKeys (start format) ps
-
-start :: Maybe Utility.Format.Format -> Batchable Key
-start format _ key = do
-	showFormatted format (key2file key) (keyVars key)
-	stop
+run :: Maybe Utility.Format.Format -> String -> Annex Bool
+run format p = do
+	let k = fromMaybe (error "bad key") $ file2key p
+	showFormatted format (key2file k) (keyVars k)
+	return True
diff --git a/Command/LookupKey.hs b/Command/LookupKey.hs
index 021dc963b..54023eab7 100644
--- a/Command/LookupKey.hs
+++ b/Command/LookupKey.hs
@@ -14,16 +14,17 @@ import Annex.CatFile
 import Types.Key
 
 cmd :: Command
-cmd = withOptions [batchOption] $ notBareRepo $ noCommit $ noMessages $
+cmd = notBareRepo $ noCommit $ noMessages $
 	command "lookupkey" SectionPlumbing 
 		"looks up key used for file"
-		(paramRepeating paramFile) (withParams seek)
+		(paramRepeating paramFile)
+		(batchable run (pure ()))
 
-seek :: CmdParams -> CommandSeek
-seek = batchable withStrings start
-
-start :: Batchable String
-start batchmode file = do
-	maybe (batchBadInput batchmode) (liftIO . putStrLn . key2file)
-		=<< catKeyFile file
-	stop
+run :: () -> String -> Annex Bool
+run _ file = do
+	mk <- catKeyFile file
+	case mk of
+		Just k  -> do
+			liftIO $ putStrLn $ key2file k
+			return True
+		Nothing -> return False