UI: Some tweaks, following ikomi's suggestions, thank you ikomi :)
This commit is contained in:
fr33domlover
parent
b95e9a8006
commit
4dcd6eb1b2
8 changed files with 63 additions and 46 deletions
|
|
@ -87,6 +87,8 @@
|
|||
-- Projects
|
||||
-- ----------------------------------------------------------------------------
|
||||
|
||||
/browse BrowseR GET
|
||||
|
||||
/s/#ShrIdent/r ReposR GET POST
|
||||
/s/#ShrIdent/r/!new RepoNewR GET
|
||||
/s/#ShrIdent/r/#RpIdent RepoR GET PUT DELETE POST
|
||||
|
|
|
|||
|
|
@ -40,9 +40,9 @@ import Vervis.Model
|
|||
import Vervis.Model.Ident (text2ky)
|
||||
|
||||
sshKeyField :: Field Handler (ByteString, ByteString)
|
||||
sshKeyField = checkMMap (pure . parseKey) renderKey textField
|
||||
sshKeyField = checkMMap (pure . parseKey) renderKey textareaField
|
||||
where
|
||||
parseKey t =
|
||||
parseKey (Textarea t) =
|
||||
case T.words t of
|
||||
a:c:_ ->
|
||||
(,) <$> parseAlgo a
|
||||
|
|
@ -58,7 +58,7 @@ sshKeyField = checkMMap (pure . parseKey) renderKey textField
|
|||
case B64.decode $ encodeUtf8 t of
|
||||
Left s -> Left $ T.pack s
|
||||
Right b -> Right b
|
||||
renderKey (a, c) = T.concat [decodeUtf8 a, " ", decodeUtf8 c]
|
||||
renderKey (a, c) = Textarea $ T.concat [decodeUtf8 a, " ", decodeUtf8 c]
|
||||
|
||||
checkNameUnique :: PersonId -> Field Handler Text -> Field Handler Text
|
||||
checkNameUnique pid = checkM $ \ ident -> do
|
||||
|
|
|
|||
|
|
@ -833,6 +833,8 @@ instance YesodBreadcrumbs App where
|
|||
GitRefDiscoverR _ _ -> ("", Nothing)
|
||||
GitUploadRequestR _ _ -> ("", Nothing)
|
||||
|
||||
BrowseR -> ("Browse", Just HomeR)
|
||||
|
||||
ProjectsR shar -> ("Projects", Just $ SharerR shar)
|
||||
ProjectNewR shar -> ("New", Just $ ProjectsR shar)
|
||||
ProjectR shar proj -> ( prj2text proj
|
||||
|
|
|
|||
|
|
@ -18,6 +18,8 @@ module Vervis.Handler.Client
|
|||
, postSharerOutboxR
|
||||
, postPublishR
|
||||
|
||||
, getBrowseR
|
||||
|
||||
, postSharerFollowR
|
||||
, postProjectFollowR
|
||||
, postTicketFollowR
|
||||
|
|
@ -82,9 +84,13 @@ import Vervis.Form.Ticket
|
|||
import Vervis.Foundation
|
||||
import Vervis.Model
|
||||
import Vervis.Model.Ident
|
||||
import Vervis.Model.Repo
|
||||
import Vervis.Path
|
||||
import Vervis.Settings
|
||||
|
||||
import qualified Vervis.Client as C
|
||||
import qualified Vervis.Darcs as D
|
||||
import qualified Vervis.Git as G
|
||||
|
||||
getShowTime = showTime <$> liftIO getCurrentTime
|
||||
where
|
||||
|
|
@ -366,6 +372,43 @@ postPublishR = do
|
|||
C.follow shrAuthor uObject uRecip False
|
||||
ExceptT $ followC shrAuthor summary audience followAP
|
||||
|
||||
getBrowseR :: Handler Html
|
||||
getBrowseR = do
|
||||
rows <- do
|
||||
repos <- runDB $ E.select $ E.from $
|
||||
\ (repo `E.LeftOuterJoin` project `E.InnerJoin` sharer) -> do
|
||||
E.on $ repo E.^. RepoSharer E.==. sharer E.^. SharerId
|
||||
E.on $ repo E.^. RepoProject E.==. project E.?. ProjectId
|
||||
E.orderBy
|
||||
[ E.asc $ sharer E.^. SharerIdent
|
||||
, E.asc $ project E.?. ProjectIdent
|
||||
, E.asc $ repo E.^. RepoIdent
|
||||
]
|
||||
return
|
||||
( sharer E.^. SharerIdent
|
||||
, project E.?. ProjectIdent
|
||||
, repo E.^. RepoIdent
|
||||
, repo E.^. RepoVcs
|
||||
)
|
||||
now <- liftIO getCurrentTime
|
||||
forM repos $
|
||||
\ (E.Value sharer, E.Value mproj, E.Value repo, E.Value vcs) -> do
|
||||
path <- askRepoDir sharer repo
|
||||
mlast <- case vcs of
|
||||
VCSDarcs -> liftIO $ D.lastChange path now
|
||||
VCSGit -> do
|
||||
mt <- liftIO $ G.lastCommitTime path
|
||||
return $ Just $ case mt of
|
||||
Nothing -> Never
|
||||
Just t ->
|
||||
intervalToEventTime $
|
||||
FriendlyConvert $
|
||||
now `diffUTCTime` t
|
||||
return (sharer, mproj, repo, vcs, mlast)
|
||||
defaultLayout $ do
|
||||
setTitle "Welcome to Vervis!"
|
||||
$(widgetFile "homepage")
|
||||
|
||||
setFollowMessage :: ShrIdent -> Either Text OutboxItemId -> Handler ()
|
||||
setFollowMessage _ (Left err) = setMessage $ toHtml err
|
||||
setFollowMessage shr (Right obiid) = do
|
||||
|
|
|
|||
|
|
@ -44,43 +44,6 @@ import Vervis.Settings
|
|||
import qualified Vervis.Git as G
|
||||
import qualified Vervis.Darcs as D
|
||||
|
||||
intro :: Handler Html
|
||||
intro = do
|
||||
rows <- do
|
||||
repos <- runDB $ select $ from $
|
||||
\ (repo `LeftOuterJoin` project `InnerJoin` sharer) -> do
|
||||
on $ repo ^. RepoSharer E.==. sharer ^. SharerId
|
||||
on $ repo ^. RepoProject E.==. project ?. ProjectId
|
||||
orderBy
|
||||
[ asc $ sharer ^. SharerIdent
|
||||
, asc $ project ?. ProjectIdent
|
||||
, asc $ repo ^. RepoIdent
|
||||
]
|
||||
return
|
||||
( sharer ^. SharerIdent
|
||||
, project ?. ProjectIdent
|
||||
, repo ^. RepoIdent
|
||||
, repo ^. RepoVcs
|
||||
)
|
||||
now <- liftIO getCurrentTime
|
||||
forM repos $
|
||||
\ (Value sharer, Value mproj, Value repo, Value vcs) -> do
|
||||
path <- askRepoDir sharer repo
|
||||
mlast <- case vcs of
|
||||
VCSDarcs -> liftIO $ D.lastChange path now
|
||||
VCSGit -> do
|
||||
mt <- liftIO $ G.lastCommitTime path
|
||||
return $ Just $ case mt of
|
||||
Nothing -> Never
|
||||
Just t ->
|
||||
intervalToEventTime $
|
||||
FriendlyConvert $
|
||||
now `diffUTCTime` t
|
||||
return (sharer, mproj, repo, vcs, mlast)
|
||||
defaultLayout $ do
|
||||
setTitle "Welcome to Vervis!"
|
||||
$(widgetFile "homepage")
|
||||
|
||||
personalOverview :: Entity Person -> Handler Html
|
||||
personalOverview (Entity _pid person) = do
|
||||
(ident, projects, repos) <- runDB $ do
|
||||
|
|
@ -104,4 +67,4 @@ getHomeR = do
|
|||
mp <- maybeAuth
|
||||
case mp of
|
||||
Just p -> personalOverview p
|
||||
Nothing -> intro
|
||||
Nothing -> redirect BrowseR
|
||||
|
|
|
|||
|
|
@ -34,6 +34,9 @@ $maybe (Entity _pid person, verified, sharer, unread) <- mperson
|
|||
<span>
|
||||
<a href=@{SharerFollowingR $ sharerIdent sharer}>
|
||||
[🐔 Following]
|
||||
<span>
|
||||
<a href=@{BrowseR}>
|
||||
[📚 Browse projects]
|
||||
<span>
|
||||
<a href=@{PublishR}>
|
||||
[📣 Publish an activity]
|
||||
|
|
|
|||
|
|
@ -23,4 +23,4 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|||
<form method=POST action=@{KeysR} enctype=#{enctype}>
|
||||
^{widget}
|
||||
<div class="submit">
|
||||
<input type="submit">
|
||||
<input type="submit" value="Add key">
|
||||
|
|
|
|||
|
|
@ -12,10 +12,14 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
|
|||
$# with this software. If not, see
|
||||
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||
|
||||
<form method=POST action=@{NotificationsR shr} enctype=#{enctypeAll}>
|
||||
^{widgetAll}
|
||||
<div class="submit">
|
||||
<input type="submit" value="Mark all as read">
|
||||
$if null notifications
|
||||
<p>
|
||||
Nothing new here :-)
|
||||
$else
|
||||
<form method=POST action=@{NotificationsR shr} enctype=#{enctypeAll}>
|
||||
^{widgetAll}
|
||||
<div class="submit">
|
||||
<input type="submit" value="Mark all as read">
|
||||
|
||||
<div>
|
||||
$forall ((obj, (time, isRemote)), widget, enctype) <- notifications
|
||||
|
|
|
|||
Loading…
Reference in a new issue