From 0a4c610b4fd78f7d1589117cb723d7d8c15c120c Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 29 Mar 2011 14:55:59 -0400
Subject: initremote works

---
 Command/InitRemote.hs | 66 +++++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 53 insertions(+), 13 deletions(-)

(limited to 'Command')

diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs
index 0d9a40cd3..39ec36653 100644
--- a/Command/InitRemote.hs
+++ b/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'
+
+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
 
-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
+{- 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"
-- 
cgit v1.2.3