diff --git a/config/routes b/config/routes index 01d2f2d..3551851 100644 --- a/config/routes +++ b/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 diff --git a/src/Vervis/Field/Key.hs b/src/Vervis/Field/Key.hs index 4d25872..dc5540c 100644 --- a/src/Vervis/Field/Key.hs +++ b/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 diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index d08a4eb..da7f95e 100644 --- a/src/Vervis/Foundation.hs +++ b/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 diff --git a/src/Vervis/Handler/Client.hs b/src/Vervis/Handler/Client.hs index c3994a6..236ce2f 100644 --- a/src/Vervis/Handler/Client.hs +++ b/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 diff --git a/src/Vervis/Handler/Home.hs b/src/Vervis/Handler/Home.hs index 73f901f..4678822 100644 --- a/src/Vervis/Handler/Home.hs +++ b/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 diff --git a/templates/default-layout.hamlet b/templates/default-layout.hamlet index 1996312..e544d89 100644 --- a/templates/default-layout.hamlet +++ b/templates/default-layout.hamlet @@ -34,6 +34,9 @@ $maybe (Entity _pid person, verified, sharer, unread) <- mperson [🐔 Following] + + + [📚 Browse projects] [📣 Publish an activity] diff --git a/templates/key/new.hamlet b/templates/key/new.hamlet index 508f933..434705f 100644 --- a/templates/key/new.hamlet +++ b/templates/key/new.hamlet @@ -23,4 +23,4 @@ $# .
^{widget}
- + diff --git a/templates/person/notifications.hamlet b/templates/person/notifications.hamlet index 0020565..9816ee2 100644 --- a/templates/person/notifications.hamlet +++ b/templates/person/notifications.hamlet @@ -12,10 +12,14 @@ $# You should have received a copy of the CC0 Public Domain Dedication along $# with this software. If not, see $# . - - ^{widgetAll} -
- +$if null notifications +

+ Nothing new here :-) +$else + + ^{widgetAll} +

+
$forall ((obj, (time, isRemote)), widget, enctype) <- notifications