git-annex/Command/InitRemote.hs
Joey Hess 53526136e8
move commandAction out of CmdLine.Seek
This is groundwork for nested seek loops, eg seeking over all files and
then performing commandActions on a list of remotes, which can be done
concurrently.

This commit was sponsored by Boyd Stephen Smith Jr. on Patreon.
2018-10-01 14:12:06 -04:00

64 lines
1.7 KiB
Haskell

{- git-annex command
-
- Copyright 2011,2013 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.InitRemote where
import qualified Data.Map as M
import Command
import Annex.SpecialRemote
import qualified Remote
import qualified Logs.Remote
import qualified Types.Remote as R
import Logs.UUID
import Types.GitConfig
cmd :: Command
cmd = command "initremote" SectionSetup
"creates a special (non-git) remote"
(paramPair paramName $ paramOptional $ paramRepeating paramKeyValue)
(withParams seek)
seek :: CmdParams -> CommandSeek
seek = withWords (commandAction . start)
start :: [String] -> CommandStart
start [] = giveup "Specify a name for the remote."
start (name:ws) = ifM (isJust <$> findExisting name)
( giveup $ "There is already a special remote named \"" ++ name ++
"\". (Use enableremote to enable an existing special remote.)"
, do
ifM (isJust <$> Remote.byNameOnly name)
( giveup $ "There is already a remote named \"" ++ name ++ "\""
, do
let c = newConfig name
t <- either giveup return (findType config)
showStart' "initremote" (Just name)
next $ perform t name $ M.union config c
)
)
where
config = Logs.Remote.keyValToConfig ws
perform :: RemoteType -> String -> R.RemoteConfig -> CommandPerform
perform t name c = do
dummycfg <- liftIO dummyRemoteGitConfig
(c', u) <- R.setup t R.Init cu Nothing c dummycfg
next $ cleanup u name c'
where
cu = case M.lookup "uuid" c of
Just s
| isUUID s -> Just (toUUID s)
| otherwise -> giveup "invalid uuid"
Nothing -> Nothing
cleanup :: UUID -> String -> R.RemoteConfig -> CommandCleanup
cleanup u name c = do
describeUUID u name
Logs.Remote.configSet u c
return True