summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-08-03 14:36:16 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-08-03 14:36:16 -0400
commitb1a5a4f985783ab7a6e9f443975f9347cb4a4f30 (patch)
tree42cbc1fe5dc8fb7b8dcaec543de9e53eccbe78db
parent2d4f1441c8af0b30eefdbea29816a7c1ade88aaa (diff)
moving toward configuring new repos in the webapp
-rw-r--r--Assistant/WebApp/Configurators.hs89
-rw-r--r--Assistant/WebApp/DashBoard.hs2
-rw-r--r--Assistant/WebApp/Documentation.hs2
-rw-r--r--Assistant/WebApp/SideBar.hs10
-rw-r--r--Assistant/WebApp/routes1
-rw-r--r--templates/configurators/addrepository.hamlet23
-rw-r--r--templates/configurators/firstrepository.hamlet14
-rw-r--r--templates/configurators/intro.hamlet2
-rw-r--r--templates/configurators/localrepositoryform.hamlet (renamed from templates/configurators/addrepository/form.hamlet)0
-rw-r--r--templates/configurators/main.hamlet45
-rw-r--r--templates/configurators/main/sidebar.hamlet18
-rw-r--r--templates/documentation/about.hamlet6
-rw-r--r--templates/sidebar/alert.hamlet2
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}