UI: Some tweaks, following ikomi's suggestions, thank you ikomi :)

config/routes

@@ -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

src/Vervis/Field/Key.hs

@@ -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

src/Vervis/Foundation.hs

@@ -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

src/Vervis/Handler/Client.hs

@@ -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

src/Vervis/Handler/Home.hs

@@ -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

templates/default-layout.hamlet

@@ -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]

templates/key/new.hamlet

@@ -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">

templates/person/notifications.hamlet

@@ -12,7 +12,11 @@ $# 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}>
+$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">