diff options
author | Joey Hess <joey@kitenet.net> | 2012-08-03 14:36:16 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-08-03 14:36:16 -0400 |
commit | b1a5a4f985783ab7a6e9f443975f9347cb4a4f30 (patch) | |
tree | 42cbc1fe5dc8fb7b8dcaec543de9e53eccbe78db | |
parent | 2d4f1441c8af0b30eefdbea29816a7c1ade88aaa (diff) |
moving toward configuring new repos in the webapp
-rw-r--r-- | Assistant/WebApp/Configurators.hs | 89 | ||||
-rw-r--r-- | Assistant/WebApp/DashBoard.hs | 2 | ||||
-rw-r--r-- | Assistant/WebApp/Documentation.hs | 2 | ||||
-rw-r--r-- | Assistant/WebApp/SideBar.hs | 10 | ||||
-rw-r--r-- | Assistant/WebApp/routes | 1 | ||||
-rw-r--r-- | templates/configurators/addrepository.hamlet | 23 | ||||
-rw-r--r-- | templates/configurators/firstrepository.hamlet | 14 | ||||
-rw-r--r-- | templates/configurators/intro.hamlet | 2 | ||||
-rw-r--r-- | templates/configurators/localrepositoryform.hamlet (renamed from templates/configurators/addrepository/form.hamlet) | 0 | ||||
-rw-r--r-- | templates/configurators/main.hamlet | 45 | ||||
-rw-r--r-- | templates/configurators/main/sidebar.hamlet | 18 | ||||
-rw-r--r-- | templates/documentation/about.hamlet | 6 | ||||
-rw-r--r-- | templates/sidebar/alert.hamlet | 2 |
13 files changed, 147 insertions, 67 deletions
diff --git a/Assistant/WebApp/Configurators.hs b/Assistant/WebApp/Configurators.hs index 27cffcecd..018f97363 100644 --- a/Assistant/WebApp/Configurators.hs +++ b/Assistant/WebApp/Configurators.hs @@ -30,25 +30,51 @@ import qualified Data.Text as T import Data.Char import System.Posix.Directory -{- An intro message, list of repositories, and nudge to make more. -} -introDisplay :: Text -> Widget -introDisplay ident = do - webapp <- lift getYesod - l <- lift $ runAnnex [] $ do +{- The main configuration screen. -} +getConfigR :: Handler RepHtml +getConfigR = ifM (inFirstRun) + ( getFirstRepositoryR + , bootstrap (Just Config) $ do + sideBarDisplay $ Just sidebar + setTitle "Configuration" + $(widgetFile "configurators/main") + ) + where + sidebar = do + (_repolist, numrepos, notenough, barelyenough, morethanenough) + <- lift repoList + $(widgetFile "configurators/main/sidebar") + +{- Lists different types of repositories that can be added. -} +getAddRepositoryR :: Handler RepHtml +getAddRepositoryR = bootstrap (Just Config) $ do + sideBarDisplay Nothing + setTitle "Add repository" + $(widgetFile "configurators/addrepository") + +{- A numbered list of known repositories, including the current one, + - as well as the total number, and whether that is not enough, + - barely enough, or more than enough. -} +repoList :: Handler ([(String, String)], String, Bool, Bool, Bool) +repoList = do + l <- runAnnex [] $ do u <- getUUID rs <- map Remote.uuid <$> Remote.remoteList rs' <- snd <$> trustPartition DeadTrusted rs Remote.prettyListUUIDs $ filter (/= webUUID) $ nub $ u:rs' - let remotelist = zip counter l let n = length l - let numrepos = show n - let notenough = n < 2 - let barelyenough = n == 2 - let morethanenough = n > 2 - $(widgetFile "configurators/intro") - lift $ modifyWebAppState $ \s -> s { showIntro = False } + return (zip counter l, show (length l), n < enough, n == enough, n > enough) where counter = map show ([1..] :: [Int]) + enough = 2 + +{- An intro message, list of repositories, and nudge to make more. -} +introDisplay :: Text -> Widget +introDisplay ident = do + webapp <- lift getYesod + (repolist, numrepos, notenough, barelyenough, morethanenough) <- lift repoList + $(widgetFile "configurators/intro") + lift $ modifyWebAppState $ \s -> s { showIntro = False } data RepositoryPath = RepositoryPath Text deriving Show @@ -118,8 +144,8 @@ defaultRepositoryPath firstrun = do (relHome (desktop </> "annex"), return "~/annex") else return cwd -addRepositoryForm :: Form RepositoryPath -addRepositoryForm msg = do +addLocalRepositoryForm :: Form RepositoryPath +addLocalRepositoryForm msg = do path <- T.pack . addTrailingPathSeparator <$> (liftIO . defaultRepositoryPath =<< lift inFirstRun) (pathRes, pathView) <- mreq (repositoryPathField True) "" (Just path) @@ -129,20 +155,18 @@ addRepositoryForm msg = do FormSuccess _ -> (False, "") let form = do webAppFormAuthToken - $(widgetFile "configurators/addrepository/form") + $(widgetFile "configurators/localrepositoryform") return (RepositoryPath <$> pathRes, form) -addRepository :: Bool -> Widget -addRepository firstrun = do - setTitle $ if firstrun then "Getting started" else "Add repository" - ((res, form), enctype) <- lift $ runFormGet addRepositoryForm +getFirstRepositoryR :: Handler RepHtml +getFirstRepositoryR = bootstrap (Just Config) $ do + sideBarDisplay Nothing + setTitle "Getting started" + ((res, form), enctype) <- lift $ runFormGet addLocalRepositoryForm case res of - FormSuccess (RepositoryPath p) -> go $ T.unpack p - _ -> $(widgetFile "configurators/addrepository") - where - go path - | firstrun = lift $ startFullAssistant path - | otherwise = error "TODO" + FormSuccess (RepositoryPath p) -> lift $ + startFullAssistant $ T.unpack p + _ -> $(widgetFile "configurators/firstrepository") {- Bootstraps from first run mode to a fully running assistant in a - repository, by running the postFirstRun callback, which returns the @@ -167,18 +191,3 @@ makeRepo path = do autostart <- autoStartFile createDirectoryIfMissing True (parentDir autostart) appendFile autostart $ path ++ "\n" - -getAddRepositoryR :: Handler RepHtml -getAddRepositoryR = bootstrap (Just Config) $ do - sideBarDisplay - addRepository False - -getConfigR :: Handler RepHtml -getConfigR = bootstrap (Just Config) $ do - sideBarDisplay - ifM (lift inFirstRun) - ( addRepository True - , do - setTitle "Configuration" - $(widgetFile "configurators/main") - ) diff --git a/Assistant/WebApp/DashBoard.hs b/Assistant/WebApp/DashBoard.hs index 8e526fb1d..32159c22d 100644 --- a/Assistant/WebApp/DashBoard.hs +++ b/Assistant/WebApp/DashBoard.hs @@ -68,7 +68,7 @@ getTransfersR nid = do {- The main dashboard. -} dashboard :: Bool -> Widget dashboard warnNoScript = do - sideBarDisplay + sideBarDisplay Nothing let content = transfersDisplay warnNoScript $(widgetFile "dashboard/main") diff --git a/Assistant/WebApp/Documentation.hs b/Assistant/WebApp/Documentation.hs index b0a9e4d98..530c4ceb3 100644 --- a/Assistant/WebApp/Documentation.hs +++ b/Assistant/WebApp/Documentation.hs @@ -17,6 +17,6 @@ import Yesod getAboutR :: Handler RepHtml getAboutR = bootstrap (Just About) $ do - sideBarDisplay + sideBarDisplay Nothing setTitle "About git-annex" $(widgetFile "documentation/about") diff --git a/Assistant/WebApp/SideBar.hs b/Assistant/WebApp/SideBar.hs index 4373b5a5b..e0c31c949 100644 --- a/Assistant/WebApp/SideBar.hs +++ b/Assistant/WebApp/SideBar.hs @@ -22,9 +22,13 @@ import Data.Text (Text) import qualified Data.Map as M import Control.Concurrent -sideBarDisplay :: Widget -sideBarDisplay = do +sideBarDisplay :: Maybe Widget -> Widget +sideBarDisplay onsidebar = do let content = do + {- If a widget was passed to include on the sidebar, display + - it above alerts. -} + maybe noop id onsidebar + {- Any yesod message appears as the first alert. -} maybe noop rendermessage =<< lift getMessage @@ -83,7 +87,7 @@ getSideBarR nid = do - to avoid slowing down user actions like closing alerts. -} liftIO $ threadDelay 100000 - page <- widgetToPageContent sideBarDisplay + page <- widgetToPageContent $ sideBarDisplay Nothing hamletToRepHtml $ [hamlet|^{pageBody page}|] {- Called by the client to close an alert. -} diff --git a/Assistant/WebApp/routes b/Assistant/WebApp/routes index 192e1cd6b..893ba79fe 100644 --- a/Assistant/WebApp/routes +++ b/Assistant/WebApp/routes @@ -5,6 +5,7 @@ /config ConfigR GET /config/addrepository AddRepositoryR GET +/config/firstrepository FirstRepositoryR GET /transfers/#NotificationId TransfersR GET /sidebar/#NotificationId SideBarR GET diff --git a/templates/configurators/addrepository.hamlet b/templates/configurators/addrepository.hamlet index 7af450b87..1f793c2a5 100644 --- a/templates/configurators/addrepository.hamlet +++ b/templates/configurators/addrepository.hamlet @@ -1,15 +1,10 @@ -<div .span9 .hero-unit> - $if firstrun - <h2> - Welcome to git-annex! - <p> - There's just one thing to do before you can start using the power # - and convenience of git-annex. - <h2> - Create a git-annex repository +<div .row-fluid> + <div .span4> + <h3> + Clone to removable drive <p> - Files in this repository will managed by git-annex, # - and kept in sync with your repositories on other devices. - <p> - <form .form-inline enctype=#{enctype}> - ^{form} + Clone this repository to a USB drive, or other removable media, # + for offline archiving, backups, or to # + <a href="http://en.wikipedia.org/wiki/Sneakernet">SneakerNet</a> # + between computers. + diff --git a/templates/configurators/firstrepository.hamlet b/templates/configurators/firstrepository.hamlet new file mode 100644 index 000000000..f4ffcf372 --- /dev/null +++ b/templates/configurators/firstrepository.hamlet @@ -0,0 +1,14 @@ +<div .span9 .hero-unit> + <h2> + Welcome to git-annex! + <p> + There's just one thing to do before you can start using the power # + and convenience of git-annex. + <h2> + Create a git-annex repository + <p> + Files in this repository will managed by git-annex, # + and kept in sync with your repositories on other devices. + <p> + <form .form-inline enctype=#{enctype}> + ^{form} diff --git a/templates/configurators/intro.hamlet b/templates/configurators/intro.hamlet index 5062346a8..0784b2743 100644 --- a/templates/configurators/intro.hamlet +++ b/templates/configurators/intro.hamlet @@ -17,7 +17,7 @@ \ repositories and devices: <table .table .table-striped .table-condensed> <tbody> - $forall (num, name) <- remotelist + $forall (num, name) <- repolist <tr> <td> #{num} diff --git a/templates/configurators/addrepository/form.hamlet b/templates/configurators/localrepositoryform.hamlet index e72dbcf43..e72dbcf43 100644 --- a/templates/configurators/addrepository/form.hamlet +++ b/templates/configurators/localrepositoryform.hamlet diff --git a/templates/configurators/main.hamlet b/templates/configurators/main.hamlet index 150e08981..09fa096b1 100644 --- a/templates/configurators/main.hamlet +++ b/templates/configurators/main.hamlet @@ -1,3 +1,42 @@ -<div .span9 .hero-unit> - <h2> - Sorry, no configuration is implemented yet... +<div .span9> + <div .row-fluid> + <div .span4> + <h3> + <a href=""> + Clone to removable drive + <p> + Clone this repository to a USB drive, memory stick, or other # + removable media. + <p> + For offline archiving, backups, or to # + <a href="http://en.wikipedia.org/wiki/Sneakernet">SneakerNet</a> # + between computers. + <div .span4> + <h3> + <a href=""> + Clone to a local computer + <p> + Automatically keep files in sync between computers on your # + local network. + <p> + For easy sharing with family and friends, or between your devices. + <div .span4> + <div .row-fluid> + <div .span4> + <h3> + <a href=""> + Store data in the cloud + <p> + Store your data on a third-party cloud platform, # + including Amazon S3, Box.com, and Rsync.net. + <p> + Pay someone to keep your data safe. With strong encryption to # + protect your privacy. + <div .span4> + <h3> + <a href=""> + Clone to a remote server + <p> + Set up a repository on a remote Unix server running SSH. + <p> + For when you want to run your own cloud. diff --git a/templates/configurators/main/sidebar.hamlet b/templates/configurators/main/sidebar.hamlet new file mode 100644 index 000000000..3d427f8c5 --- /dev/null +++ b/templates/configurators/main/sidebar.hamlet @@ -0,0 +1,18 @@ +<div .alert .alert-info> + <h4 .alert-heading> + git-annex is managing # + $if notenough + only # + <span .badge .badge-error>#{numrepos}</span> repository. # + $else + $if barelyenough + <span .badge .badge-warning>#{numrepos}</span> repositories. # + $else + <span .badge .badge-success>#{numrepos}</span> repositories. # + $if notenough + Recommend you add more clones to avoid data loss. + $else + $if barelyenough + Consider adding more. + $else + Adding more can't hurt! diff --git a/templates/documentation/about.hamlet b/templates/documentation/about.hamlet index af48a0b10..e9a233471 100644 --- a/templates/documentation/about.hamlet +++ b/templates/documentation/about.hamlet @@ -10,8 +10,8 @@ <hr> git-annex is © 2010-2012 Joey Hess. It is free software, licensed # under the terms of the GNU General Public License, version 3 or above. # - <br> - <i class="icon-heart"></i> Its development was made possible by # + <p> + Its development was made possible by # <a href="http://git-annex.branchable.com/design/assistant/thanks/"> many excellent people - . + . <i class="icon-heart"></i> diff --git a/templates/sidebar/alert.hamlet b/templates/sidebar/alert.hamlet index 9c204402b..937751819 100644 --- a/templates/sidebar/alert.hamlet +++ b/templates/sidebar/alert.hamlet @@ -7,7 +7,7 @@ <i class="icon-#{name}"></i> # $maybe h <- heading $if block - <h4 class="alert-heading">#{h}</h4> # + <h4 .alert-heading>#{h}</h4> # $else <strong>#{h}</strong> # ^{widget} |