initremote: Support --json and --json-error-messages
Including special --whatelse handling. Otherwise, it seems unlikely to be too useful, but who knows. Refactored code to call starting before displaying error messages. This makes the error messages be captured by --json-error-messages Sponsored-By: the NIH-funded NICEMAN (ReproNim TR&D3) project
This commit is contained in:
parent
9812d9aaec
commit
b3cc8dbacb
6 changed files with 96 additions and 41 deletions
|
@ -1,6 +1,6 @@
|
|||
{- git-annex command
|
||||
-
|
||||
- Copyright 2011-2021 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2011-2023 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
@ -9,8 +9,6 @@
|
|||
|
||||
module Command.InitRemote where
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
import Command
|
||||
import Annex.SpecialRemote
|
||||
import qualified Remote
|
||||
|
@ -23,12 +21,17 @@ import Types.GitConfig
|
|||
import Types.ProposedAccepted
|
||||
import Config
|
||||
import Git.Config
|
||||
import Utility.Aeson
|
||||
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Text as T
|
||||
|
||||
cmd :: Command
|
||||
cmd = command "initremote" SectionSetup
|
||||
"creates a special (non-git) remote"
|
||||
(paramPair paramName $ paramOptional $ paramRepeating paramParamValue)
|
||||
(seek <$$> optParser)
|
||||
cmd = withAnnexOptions [jsonOptions] $
|
||||
command "initremote" SectionSetup
|
||||
"creates a special (non-git) remote"
|
||||
(paramPair paramName $ paramOptional $ paramRepeating paramParamValue)
|
||||
(seek <$$> optParser)
|
||||
|
||||
data InitRemoteOptions = InitRemoteOptions
|
||||
{ cmdparams :: CmdParams
|
||||
|
@ -64,29 +67,35 @@ seek o = withWords (commandAction . (start o)) (cmdparams o)
|
|||
|
||||
start :: InitRemoteOptions -> [String] -> CommandStart
|
||||
start _ [] = giveup "Specify a name for the remote."
|
||||
start o (name:ws) = ifM (not . null <$> findExisting name)
|
||||
( giveup $ "There is already a special remote named \"" ++ name ++
|
||||
"\". (Use enableremote to enable an existing special remote.)"
|
||||
, ifM (isJust <$> Remote.byNameOnly name)
|
||||
( giveup $ "There is already a remote named \"" ++ name ++ "\""
|
||||
, do
|
||||
sameasuuid <- maybe
|
||||
(pure Nothing)
|
||||
(Just . Sameas <$$> getParsed)
|
||||
(sameas o)
|
||||
c <- newConfig name sameasuuid
|
||||
(Logs.Remote.keyValToConfig Proposed ws)
|
||||
<$> remoteConfigMap
|
||||
t <- either giveup return (findType c)
|
||||
if whatElse o
|
||||
then startingCustomOutput (ActionItemOther Nothing) $
|
||||
describeOtherParamsFor c t
|
||||
else starting "initremote" (ActionItemOther (Just (UnquotedString name))) si $
|
||||
perform t name c o
|
||||
)
|
||||
)
|
||||
start o (name:ws) = do
|
||||
if whatElse o
|
||||
then ifM jsonOutputEnabled
|
||||
( starting "initremote" ai si $ prep $ \c t ->
|
||||
describeOtherParamsFor c t
|
||||
, startingCustomOutput (ActionItemOther Nothing) $ prep $ \c t ->
|
||||
describeOtherParamsFor c t
|
||||
)
|
||||
else starting "initremote" ai si $ prep $ \c t ->
|
||||
perform t name c o
|
||||
where
|
||||
si = SeekInput [name]
|
||||
prep a = do
|
||||
whenM (not . null <$> findExisting name) $
|
||||
giveup $ "There is already a special remote named \"" ++ name ++
|
||||
"\". (Use enableremote to enable an existing special remote.)"
|
||||
whenM (isJust <$> Remote.byNameOnly name) $
|
||||
giveup $ "There is already a remote named \"" ++ name ++ "\""
|
||||
sameasuuid <- maybe
|
||||
(pure Nothing)
|
||||
(Just . Sameas <$$> getParsed)
|
||||
(sameas o)
|
||||
c <- newConfig name sameasuuid
|
||||
(Logs.Remote.keyValToConfig Proposed ws)
|
||||
<$> remoteConfigMap
|
||||
t <- either giveup return (findType c)
|
||||
a c t
|
||||
|
||||
si = SeekInput (name:ws)
|
||||
ai = ActionItemOther (Just (UnquotedString name))
|
||||
|
||||
perform :: RemoteType -> String -> R.RemoteConfig -> InitRemoteOptions -> CommandPerform
|
||||
perform t name c o = do
|
||||
|
@ -126,18 +135,36 @@ describeOtherParamsFor c t = do
|
|||
cp <- R.configParser t c
|
||||
let l = map mk (filter notinconfig $ remoteConfigFieldParsers cp)
|
||||
++ map mk' (maybe [] snd (remoteConfigRestPassthrough cp))
|
||||
liftIO $ forM_ l $ \(p, fd, vd) -> case fd of
|
||||
HiddenField -> return ()
|
||||
FieldDesc d -> do
|
||||
putStrLn p
|
||||
putStrLn ("\t" ++ d)
|
||||
case vd of
|
||||
Nothing -> return ()
|
||||
Just (ValueDesc d') ->
|
||||
putStrLn $ "\t(" ++ d' ++ ")"
|
||||
ifM jsonOutputEnabled
|
||||
( maybeAddJSONField "whatelse" $ M.fromList $ mkjson l
|
||||
, liftIO $ forM_ l $ \(p, fd, vd) -> case fd of
|
||||
HiddenField -> return ()
|
||||
FieldDesc d -> do
|
||||
putStrLn p
|
||||
putStrLn ("\t" ++ d)
|
||||
case vd of
|
||||
Nothing -> return ()
|
||||
Just (ValueDesc d') ->
|
||||
putStrLn $ "\t(" ++ d' ++ ")"
|
||||
|
||||
)
|
||||
next $ return True
|
||||
where
|
||||
mkjson = mapMaybe $ \(p, fd, vd) ->
|
||||
case fd of
|
||||
HiddenField -> Nothing
|
||||
FieldDesc d -> Just
|
||||
( T.pack p
|
||||
, M.fromList
|
||||
[ ("description" :: T.Text, d)
|
||||
, ("valuedescription", case vd of
|
||||
Nothing -> ""
|
||||
Just (ValueDesc d') -> d')
|
||||
]
|
||||
)
|
||||
|
||||
notinconfig fp = not (M.member (parserForField fp) c)
|
||||
|
||||
mk fp = ( fromProposedAccepted (parserForField fp)
|
||||
, fieldDesc fp
|
||||
, valueDesc fp
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue