initremote works

Command/InitRemote.hs

@@ -12,7 +12,12 @@ import Control.Monad (when)
 import Control.Monad.State (liftIO)
 
 import Command
+import qualified Annex
 import qualified Remote
+import qualified RemoteClass
+import qualified GitRepo as Git
+import Utility
+import Types
 import UUID
 import Messages
 
@@ -28,27 +33,49 @@ seek = [withString start]
 start :: CommandStartString
 start params = notBareRepo $ do
 	when (null ws) $ error "Specify a name for the remote"
+
+	(u, c) <- findByName name
+	let fullconfig = M.union config c	
+	t <- findType fullconfig
+	
 	showStart "initremote" name
-	m <- Remote.readRemoteLog
-	(u, c) <- case findByName name m of
-		Just t -> return t
-		Nothing -> do
-			uuid <- liftIO $ genUUID
-			return $ (uuid, M.insert nameKey name M.empty)
-	return $ Just $ perform name u $ M.union config c
+	return $ Just $ perform t u $ M.union config c
 
 	where
 		ws = words params
 		name = head ws
 		config = Remote.keyValToMap $ tail ws
 
-perform :: String -> UUID -> M.Map String String -> CommandPerform
-perform name uuid config = do
-	liftIO $ putStrLn $ show $ (uuid, config)
-	return Nothing
+perform :: RemoteClass.RemoteType Annex -> UUID -> M.Map String String -> CommandPerform
+perform t u c = do
+	c' <- RemoteClass.setup t u c
+	return $ Just $ cleanup u c'
 
-findByName :: String ->  M.Map UUID (M.Map String String) -> Maybe (UUID, M.Map String String)
-findByName n m = if null matches then Nothing else Just $ head matches
+cleanup :: UUID -> M.Map String String -> CommandCleanup
+cleanup u c = do
+	Remote.configSet u c
+	g <- Annex.gitRepo
+	logfile <- Remote.remoteLog
+	liftIO $ Git.run g "add" [File logfile]
+        liftIO $ Git.run g "commit"
+                [ Params "-q --allow-empty -m"
+                , Param "git annex initremote"
+                , File logfile
+                ]
+        return True
+
+{- Look up existing remote's UUID and config by name, or generate a new one -}
+findByName :: String -> Annex (UUID, M.Map String String)
+findByName name = do
+	m <- Remote.readRemoteLog
+	case findByName' name m of
+		Just i -> return i
+		Nothing -> do
+			uuid <- liftIO $ genUUID
+			return $ (uuid, M.insert nameKey name M.empty)
+
+findByName' :: String ->  M.Map UUID (M.Map String String) -> Maybe (UUID, M.Map String String)
+findByName' n m = if null matches then Nothing else Just $ head matches
 	where
 		matches = filter (matching . snd) $ M.toList m
 		matching c = case M.lookup nameKey c of
@@ -57,6 +84,19 @@ findByName n m = if null matches then Nothing else Just $ head matches
 				| n' == n -> True
 				| otherwise -> False
 
+{- find the specified remote type -}
+findType :: M.Map String String -> Annex (RemoteClass.RemoteType Annex)
+findType config = 
+	case M.lookup typeKey config of
+		Nothing -> error "Specify the type of remote with type="
+		Just s -> case filter (\i -> RemoteClass.typename i == s) Remote.remoteTypes of
+			[] -> error $ "Unknown remote type " ++ s
+			(t:_) -> return t
+
 {- The name of a configured remote is stored in its config using this key. -}
 nameKey :: String
 nameKey = "name"
+
+{- The type of a remote is stored in its config using this key. -}
+typeKey :: String
+typeKey = "type"

Remote.hs

@@ -15,12 +15,14 @@ module Remote (
 	hasKey,
 	hasKeyCheap,
 
+	remoteTypes,
 	byName,
 	nameToUUID,
 	keyPossibilities,
 	remotesWithUUID,
 	remotesWithoutUUID,
 
+	remoteLog,
 	readRemoteLog,
 	configSet,
 	keyValToMap
@@ -34,8 +36,6 @@ import qualified Data.Map as M
 import Data.Maybe
 
 import RemoteClass
-import qualified Remote.Git
-import qualified Remote.S3
 import Types
 import UUID
 import qualified Annex
@@ -43,6 +43,10 @@ import Trust
 import LocationLog
 import Locations
 import Messages
+import Utility
+
+import qualified Remote.Git
+import qualified Remote.S3
 
 remoteTypes :: [RemoteType Annex]
 remoteTypes =
@@ -150,7 +154,8 @@ configSet :: UUID -> M.Map String String -> Annex ()
 configSet u c = do
 	m <- readRemoteLog
 	l <- remoteLog
-	liftIO $ writeFile l $ unlines $ map toline $ M.toList $ M.insert u c m
+	liftIO $ safeWriteFile l $ unlines $ sort $
+		map toline $ M.toList $ M.insert u c m
 	where
 		toline (u', c') = u' ++ " " ++ (unwords $ mapToKeyVal c')
 
@@ -185,6 +190,6 @@ keyValToMap ws = M.fromList $ map (/=/) ws
 				v = drop (1 + length k) s
 
 mapToKeyVal :: M.Map String String -> [String]
-mapToKeyVal m = map toword $ M.toList m
+mapToKeyVal m = map toword $ sort $ M.toList m
 	where
 		toword (k, v) = k ++ "=" ++ v

Remote/Git.hs

@@ -31,7 +31,11 @@ import Ssh
 import Config
 
 remote :: RemoteType Annex
-remote = RemoteType { typename = "git", generator = gen }
+remote = RemoteType {
+	typename = "git",
+	generator = gen,
+	setup = error "not supported"
+}
 
 gen :: Annex (RemoteGenerator Annex)
 gen = do
@@ -68,8 +72,7 @@ genRemote r = do
 		removeKey = dropKey r,
 		hasKey = inAnnex r,
 		hasKeyCheap = not (Git.repoIsUrl r),
-		config = Nothing,
-		setup = \_ -> return ()
+		config = Nothing
 	}
 
 {- Tries to read the config for a specified remote, updates state, and

Remote/S3.hs

@@ -28,7 +28,11 @@ import UUID
 import Config
 
 remote :: RemoteType Annex
-remote = RemoteType { typename = "S3", generator = gen }
+remote = RemoteType {
+	typename = "S3",
+	generator = gen,
+	setup = s3Setup
+}
 
 gen :: Annex (RemoteGenerator Annex)
 gen = do
@@ -68,8 +72,7 @@ genRemote r u = do
 		removeKey = error "TODO",
 		hasKey = error "TODO",
 		hasKeyCheap = False,
-		config = Nothing,
-		setup = \_ -> return ()
+		config = Nothing
 	}
 
 s3Connection :: Git.Repo -> Annex (Maybe AWSConnection)
@@ -102,6 +105,10 @@ getS3Config r s def = do
 	where
 		envvar = "ANNEX_" ++ map (\c -> if c == '-' then '_' else toUpper c) s
 
+s3Setup :: UUID -> M.Map String String -> Annex (M.Map String String)
+s3Setup u c = do
+	return c
+
 {- The UUID of a S3 bucket is stored in a file "git-annex-uuid" in the
  - bucket. Gets the UUID, or if there is none, sets a new UUID, possibly
  - also creating the bucket. -}

RemoteClass.hs

@@ -24,7 +24,9 @@ data RemoteType a = RemoteType {
 	-- human visible type name
 	typename :: String,
 	-- generates remotes of this type
-	generator :: a (RemoteGenerator a)
+	generator :: a (RemoteGenerator a),
+	-- initializes or changes a remote
+	setup :: String -> M.Map String String -> a (M.Map String String)
 }
 
 {- An individual remote. -}
@@ -48,9 +50,7 @@ data Remote a = Remote {
 	-- operation.
 	hasKeyCheap :: Bool,
 	-- a Remote can have a persistent configuration store
-	config :: Maybe (M.Map String String),
-	-- initializes or changes the config of a remote
-	setup :: M.Map String String -> a ()
+	config :: Maybe (M.Map String String)
 }
 
 instance Show (Remote a) where

doc/git-annex.mdwn

@@ -134,11 +134,11 @@ Many git-annex commands will stage changes for later `git commit` by you.
 
 * initremote name [param=value ...]
 
-  Sets up a [[special_remote|special_remotes]] of some type. The remote's
-  type and configuration is specified by the parameters. If a remote
+  Sets up a [[special_remote|special_remotes]]. The remote's
+  configuration is specified by the parameters. If a remote
   with the specified name has already been configured, its configuration
   is modified by any values specified. In either case, the remote will be
-  added added to `.git/config`.
+  added to `.git/config`.
 
   Example Amazon S3 remote: