aboutsummaryrefslogtreecommitdiff
path: root/Assistant/WebApp/Configurators.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-07-31 17:57:08 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-07-31 17:57:08 -0400
commit4b5ffe8f9b84c20912871b0dfe627d041ce2d99f (patch)
tree95a1950195cc558073bb9e576110019dc156ca10 /Assistant/WebApp/Configurators.hs
parentbcf5c81593f26a253b514224e3326defd6fa0a8d (diff)
implemented the addrepository form
shiny!
Diffstat (limited to 'Assistant/WebApp/Configurators.hs')
-rw-r--r--Assistant/WebApp/Configurators.hs43
1 files changed, 36 insertions, 7 deletions
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