implemented the addrepository form

shiny!

4 files changed, 53 insertions, 12 deletions

diff --git a/Assistant/WebApp.hs b/Assistant/WebApp.hs
index 3351aa48f..c2a021246 100644
--- a/Assistant/WebApp.hs
+++ b/Assistant/WebApp.hs
@@ -95,6 +95,11 @@ instance Yesod WebApp where
 	makeSessionBackend = webAppSessionBackend
 	jsLoader _ = BottomOfHeadBlocking
 
+instance RenderMessage WebApp FormMessage where
+	renderMessage _ _ = defaultFormMessage
+
+type Form x = Html -> MForm WebApp WebApp (FormResult x, Widget)
+
 data WebAppState = WebAppState
 	{ showIntro :: Bool
 	}
@@ -145,3 +150,10 @@ instance PathPiece NotificationId where
 instance PathPiece AlertId where
     toPathPiece = pack . show
     fromPathPiece = readish . unpack
+
+{- Adds the auth parameter as a hidden field on a form. Must be put into
+ - every form. -}
+webAppFormAuthToken :: Widget
+webAppFormAuthToken = do
+	webapp <- lift getYesod
+	[whamlet|<input type="hidden" name="auth" value="#{secretToken webapp}">|]
diff --git a/Assistant/WebApp/Configurators.hs b/Assistant/WebApp/Configurators.hs
index 9fe10aff9..69bf92fdb 100644
--- a/Assistant/WebApp/Configurators.hs
+++ b/Assistant/WebApp/Configurators.hs
@@ -19,7 +19,7 @@ import Logs.Trust
 import Annex.UUID (getUUID)
 
 import Yesod
-import Data.Text (Text)
+import Data.Text (Text, pack)
 
 {- An intro message, list of repositories, and nudge to make more. -}
 introDisplay :: Text -> Widget
@@ -41,10 +41,44 @@ introDisplay ident = do
 	where
 		counter = map show ([1..] :: [Int])
 
+data RepositoryPath = RepositoryPath Text
+	deriving Show
+
+addRepositoryForm :: Form RepositoryPath
+addRepositoryForm msg = do
+	cwd <- liftIO $ getCurrentDirectory
+	(pathRes, pathView) <- mreq textField "" (Just $ pack cwd)
+	let widget = do
+		webAppFormAuthToken
+		toWidget [julius|
+$(function() {
+	$('##{fvId pathView}').focus();
+})
+|]
+		[whamlet|
+#{msg}
+<p>
+  <div .input-prepend .input-append>
+    <span .add-on>
+      <i .icon-folder-open></i>
+    ^{fvInput pathView}
+    <button type=submit .btn>
+      Make Repository
+|]
+	return (RepositoryPath <$> pathRes, widget)
+
 addRepository :: Bool -> Widget
 addRepository firstrun = do
 	setTitle $ if firstrun then "Getting started" else "Add repository"
-	$(widgetFile "configurators/addrepository")
+	((res, form), enctype) <- lift $ runFormGet addRepositoryForm
+	case res of
+		FormSuccess (RepositoryPath p) -> error $ "TODO" ++ show p
+		_ -> $(widgetFile "configurators/addrepository")
+
+getAddRepositoryR :: Handler RepHtml
+getAddRepositoryR = bootstrap (Just Config) $ do
+	sideBarDisplay
+	addRepository False
 
 getConfigR :: Handler RepHtml
 getConfigR = bootstrap (Just Config) $ do
@@ -55,8 +89,3 @@ getConfigR = bootstrap (Just Config) $ do
 			setTitle "Configuration"
 			$(widgetFile "configurators/main")
 		)
-
-getAddRepositoryR :: Handler RepHtml
-getAddRepositoryR = bootstrap (Just Config) $ do
-	sideBarDisplay
-	addRepository False
diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes
index 69e6078b0..95813edb6 100644
--- a/Assistant/WebApp/routes
+++ b/Assistant/WebApp/routes
@@ -1,9 +1,10 @@
 / HomeR GET
 /noscript NoScriptR GET
 /noscriptauto NoScriptAutoR GET
+/about AboutR GET
+
 /config ConfigR GET
 /config/addrepository AddRepositoryR GET
-/about AboutR GET
 
 /transfers/#NotificationId TransfersR GET
 /sidebar/#NotificationId SideBarR GET
diff --git a/templates/configurators/addrepository.hamlet b/templates/configurators/addrepository.hamlet
index 20ece2806..7af450b87 100644
--- a/templates/configurators/addrepository.hamlet
+++ b/templates/configurators/addrepository.hamlet
@@ -10,7 +10,6 @@
     <p>
       Files in this repository will managed by git-annex, #
       and kept in sync with your repositories on other devices.
-    <form .form-inline>
-      <i class="icon-folder-open"></i> #
-      <input type="text" .input-xlarge placeholder="directory"> #
-      <button type="submit" .btn .btn-primary .btn-large>Make Repository</button>
+    <p>
+    <form .form-inline enctype=#{enctype}>
+      ^{form}