diff options
author | Joey Hess <joey@kitenet.net> | 2012-07-31 17:57:08 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-07-31 17:57:08 -0400 |
commit | 4b5ffe8f9b84c20912871b0dfe627d041ce2d99f (patch) | |
tree | 95a1950195cc558073bb9e576110019dc156ca10 /Assistant/WebApp/Configurators.hs | |
parent | bcf5c81593f26a253b514224e3326defd6fa0a8d (diff) |
implemented the addrepository form
shiny!
Diffstat (limited to 'Assistant/WebApp/Configurators.hs')
-rw-r--r-- | Assistant/WebApp/Configurators.hs | 43 |
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 |