mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

tweak intro

Browse source
This commit is contained in:
Joey Hess 2012-07-29 22:11:01 -04:00
parent 675ad9fe22
commit 895b068e35
3 changed files with 16 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
Assistant/Threads/WebApp.hs
View file

@ -27,6 +27,7 @@ import Utility.DataUnits
import Types.Key import Types.Key
import qualified Remote import qualified Remote
import Logs.Web (webUUID) import Logs.Web (webUUID)
import Annex.UUID (getUUID)
import Yesod import Yesod
import Yesod.Static import Yesod.Static
@ -169,11 +170,11 @@ introDisplay :: Text -> Widget
introDisplay ident = do introDisplay ident = do
webapp <- lift getYesod webapp <- lift getYesod
let reldir = relDir webapp let reldir = relDir webapp
remotelist <- liftIO $ runThreadState (threadState webapp) $ remotelist <- liftIO $ runThreadState (threadState webapp) $ do
Remote.prettyListUUIDs u <- getUUID
=<< filter (/= webUUID) . nub . map Remote.uuid rs <- map Remote.uuid <$> Remote.remoteList
<$> Remote.remoteList Remote.prettyListUUIDs $ filter (/= webUUID) $ nub $ u:rs
let n = (length remotelist) + 1 -- plus this one let n = length remotelist
let numrepos = show n let numrepos = show n
let notenough = n < 2 let notenough = n < 2
let barelyenough = n == 2 let barelyenough = n == 2

13
Remote.hs
View file

@ -129,14 +129,19 @@ prettyPrintUUIDs desc uuids = do
, ("here", toJSON $ hereu == u) , ("here", toJSON $ hereu == u)
] ]
{- List of remote names and/or descriptions, for human display. {- List of remote names and/or descriptions, for human display. -}
- Omits the current repisitory. -}
prettyListUUIDs :: [UUID] -> Annex [String] prettyListUUIDs :: [UUID] -> Annex [String]
prettyListUUIDs uuids = do prettyListUUIDs uuids = do
hereu <- getUUID hereu <- getUUID
m <- uuidDescriptions m <- uuidDescriptions
return $ map (\u -> M.findWithDefault "" u m) $ return $ map (\u -> prettify m hereu u) uuids
filter (/= hereu) uuids where
finddescription m u = M.findWithDefault "" u m
prettify m hereu u
| u == hereu = addName n "here"
| otherwise = n
where
n = finddescription m u
{- Filters a list of remotes to ones that have the listed uuids. -} {- Filters a list of remotes to ones that have the listed uuids. -}
remotesWithUUID :: [Remote] -> [UUID] -> [Remote] remotesWithUUID :: [Remote] -> [UUID] -> [Remote]

3
templates/intro.hamlet
View file

@ -15,9 +15,8 @@
<span .badge .badge-success>#{numrepos}</span> <span .badge .badge-success>#{numrepos}</span>
\ repositories and devices: \ repositories and devices:
<ul> <ul>
<li>here
$forall name <- remotelist $forall name <- remotelist
<li>#{name} <li>#{name}
<a .btn .btn-primary .btn-large href="@{AddRepositoryR}">Add another repository</a> <a .btn .btn-primary .btn-large href="@{AddRepositoryR}">Add another repository</a>
<div> <p>
Or just sit back, watch the magic, and get on with using your files. Or just sit back, watch the magic, and get on with using your files.