From 581fe0644f942fef7a0078240b977d5f7c85f3bf Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 13 Mar 2013 17:59:33 -0400
Subject: [PATCH] proof of concept remote reordering UI (needs to be changed to
 use drag and drop)

---
 Assistant/Pairing/MakeRemote.hs               |  1 -
 Assistant/WebApp/RepoList.hs                  | 50 ++++++++++++++++++-
 Assistant/WebApp/routes                       |  3 ++
 debian/copyright                              |  5 ++
 .../configurators/repositories/list.hamlet    |  4 ++
 5 files changed, 61 insertions(+), 2 deletions(-)

diff --git a/Assistant/Pairing/MakeRemote.hs b/Assistant/Pairing/MakeRemote.hs
index ff5688bd32..edd27e35a2 100644
--- a/Assistant/Pairing/MakeRemote.hs
+++ b/Assistant/Pairing/MakeRemote.hs
@@ -12,7 +12,6 @@ import Assistant.Ssh
 import Assistant.Pairing
 import Assistant.Pairing.Network
 import Assistant.MakeRemote
-import Config
 import Config.Cost
 
 import Network.Socket
diff --git a/Assistant/WebApp/RepoList.hs b/Assistant/WebApp/RepoList.hs
index 464f0821d4..3d7fc3e472 100644
--- a/Assistant/WebApp/RepoList.hs
+++ b/Assistant/WebApp/RepoList.hs
@@ -16,9 +16,12 @@ import Assistant.WebApp.Utility
 import qualified Annex
 import qualified Remote
 import qualified Types.Remote as Remote
+import Remote.List (remoteListRefresh)
 import Annex.UUID (getUUID)
 import Logs.Remote
 import Logs.Trust
+import Config
+import Config.Cost
 import qualified Git
 #ifdef WITH_XMPP
 #endif
@@ -60,22 +63,30 @@ data Actions
 		{ setupRepoLink :: Route WebApp }
 	| SyncingRepoActions
 		{ setupRepoLink :: Route WebApp
+		, moveUpRepoList :: Route WebApp
+		, moveDownRepoList :: Route WebApp
 		, syncToggleLink :: Route WebApp
 		}
 	| NotSyncingRepoActions
 		{ setupRepoLink :: Route WebApp
+		, moveUpRepoList :: Route WebApp
+		, moveDownRepoList :: Route WebApp
 		, syncToggleLink :: Route WebApp
 		}
 
 mkSyncingRepoActions :: UUID -> Actions
 mkSyncingRepoActions u = SyncingRepoActions
 	{ setupRepoLink = EditRepositoryR u
+	, moveUpRepoList = MoveRepositoryUp u
+	, moveDownRepoList = MoveRepositoryDown u
 	, syncToggleLink = DisableSyncR u
 	}
 
 mkNotSyncingRepoActions :: UUID -> Actions
 mkNotSyncingRepoActions u = NotSyncingRepoActions
 	{ setupRepoLink = EditRepositoryR u
+	, moveUpRepoList = MoveRepositoryUp u
+	, moveDownRepoList = MoveRepositoryDown u
 	, syncToggleLink = EnableSyncR u
 	}
 
@@ -84,7 +95,7 @@ needsEnabled (DisabledRepoActions _) = True
 needsEnabled _ = False
 
 notSyncing :: Actions -> Bool
-notSyncing (SyncingRepoActions _ _) = False
+notSyncing (SyncingRepoActions _ _ _ _) = False
 notSyncing _ = True
 
 {- Called by client to get a list of repos, that refreshes
@@ -185,3 +196,40 @@ flipSync enable uuid = do
 	mremote <- liftAnnex $ Remote.remoteFromUUID uuid
 	changeSyncable mremote enable
 	redirect RepositoriesR
+
+getMoveRepositoryUp :: UUID -> Handler ()
+getMoveRepositoryUp u = do
+	reorderRepository u
+	redirect RepositoriesR
+
+getMoveRepositoryDown :: UUID -> Handler ()
+getMoveRepositoryDown u = do
+	reorderRepository u
+	redirect RepositoriesR
+
+reorderRepository :: UUID -> Handler ()
+reorderRepository uuid = do
+	liftAnnex $ do
+		remote <- fromMaybe (error "Unknown UUID") <$>
+			Remote.remoteFromUUID uuid
+		rs <- Remote.enabledRemoteList
+		let us = map Remote.uuid rs
+		case afteruuid us >>= (\u -> elemIndex u us) of
+			Nothing -> noop -- already at end
+			Just i -> do
+				let rs' = filter other rs
+				let costs = map Remote.cost rs'
+				let rs'' = (\(x, y) -> x ++ [remote] ++ y) $
+					splitAt (i + 1) rs'
+				let l = zip rs'' (insertCostAfter costs i)
+				forM_ l $ \(r, newcost) ->
+					when (Remote.cost r /= newcost) $
+						setRemoteCost r newcost
+		remoteListRefresh
+	liftAssistant updateSyncRemotes
+  where
+  	afteruuid [] = Nothing
+	afteruuid (u:us)
+		| u == uuid = headMaybe us
+		| otherwise = afteruuid us
+	other r = Remote.uuid r /= uuid
diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes
index 30223392dd..6a170bc950 100644
--- a/Assistant/WebApp/routes
+++ b/Assistant/WebApp/routes
@@ -1,5 +1,8 @@
 / DashboardR GET HEAD
+
 /repositories RepositoriesR GET
+/repositories/moveup/#UUID MoveRepositoryUp GET
+/repositories/movedown/#UUID MoveRepositoryDown GET
 
 /noscript NoScriptR GET
 /noscript/auto NoScriptAutoR GET
diff --git a/debian/copyright b/debian/copyright
index 1791a04923..90ae279c0b 100644
--- a/debian/copyright
+++ b/debian/copyright
@@ -91,6 +91,11 @@ License: MIT or GPL-2
  OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
  WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
+Files: static/jquery-ui*
+Copyright: © 2008 Paul Bakaus
+           © 2011 the jQuery UI Authors (http://jqueryui.com/about)
+License: GPL-2
+
 Files: static/*/bootstrap* static/img/glyphicons-halflings*
 Copyright: 2012 Twitter, Inc.
 License: Apache-2.0
diff --git a/templates/configurators/repositories/list.hamlet b/templates/configurators/repositories/list.hamlet
index 5829e23e0a..011091d1f2 100644
--- a/templates/configurators/repositories/list.hamlet
+++ b/templates/configurators/repositories/list.hamlet
@@ -34,3 +34,7 @@
             $else
               <a href="@{setupRepoLink actions}">
                 configure
+              <a href="@{moveUpRepoList actions}">
+                  &uarr;
+              <a href="@{moveDownRepoList actions}">
+                  &darr;