Add "Follow" button to person, repo, project and ticket pages

src/Vervis/Handler/Person.hs

@@ -45,6 +45,7 @@ import Vervis.Model.Ident
 import Vervis.Secure
 import Vervis.Settings
 import Vervis.Widget (avatarW)
+import Vervis.Widget.Sharer
 
 -- | Account verification email resend form
 getResendVerifyEmailR :: Handler Html
@@ -145,3 +146,6 @@ getPerson shr sharer person = do
             }
     secure <- getSecure
     provideHtmlAndAP personAP $(widgetFile "person")
+    where
+    followButton =
+        followW (SharerFollowR shr) (return $ personFollowers person)

src/Vervis/Handler/Project.hs

@@ -160,6 +160,10 @@ getProjectR shar proj = do
                 }
             , AP.projectTeam = route2local $ ProjectTeamR shar proj
             }
+        followButton =
+            followW
+                (ProjectFollowR shar proj)
+                (return $ projectFollowers project)
     provideHtmlAndAP projectAP $(widgetFile "project/one")
 
 putProjectR :: ShrIdent -> PrjIdent -> Handler Html

src/Vervis/Handler/Repo/Darcs.hs

@@ -96,6 +96,9 @@ getDarcsRepoSource repository user repo dir = do
                         Just s -> return s
                 addStylesheet $ HighlightStyleR style
                 $(widgetFile "repo/source-darcs")
+    where
+    followButton =
+        followW (RepoFollowR user repo) (return $ repoFollowers repository)
 
 getDarcsRepoHeadChanges :: ShrIdent -> RpIdent -> Handler TypedContent
 getDarcsRepoHeadChanges shar repo = do

src/Vervis/Handler/Repo/Git.hs

@@ -111,6 +111,9 @@ getGitRepoSource repository user repo ref dir = do
                         Just s -> return s
                 addStylesheet $ HighlightStyleR style
                 $(widgetFile "repo/source-git")
+    where
+    followButton =
+        followW (RepoFollowR user repo) (return $ repoFollowers repository)
 
 getGitRepoHeadChanges :: Repo -> ShrIdent -> RpIdent -> Handler TypedContent
 getGitRepoHeadChanges repository shar repo =

src/Vervis/Handler/Ticket.hs

@@ -291,7 +291,12 @@ getTicketR shar proj num = do
                 encodeRouteHome . SharerR . sharerIdent . fst <$> massignee
             , AP.ticketIsResolved   = ticketStatus ticket == TSClosed
             }
-    provideHtmlAndAP' host ticketAP $(widgetFile "ticket/one")
+    provideHtmlAndAP' host ticketAP $
+        let followButton =
+                followW
+                    (TicketFollowR shar proj num)
+                    (return $ ticketFollowers ticket)
+        in  $(widgetFile "ticket/one")
 
 putTicketR :: ShrIdent -> PrjIdent -> Int -> Handler Html
 putTicketR shar proj num = do

src/Vervis/Widget.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2018, 2019 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -27,7 +27,7 @@ import Data.Time.Calendar (toGregorian)
 import Data.Time.Clock (UTCTime (..))
 import Development.Darcs.Rev
 import Formatting (sformat, (%), int, left)
-import Network.HTTP.Types (StdMethod)
+import Network.HTTP.Types.Method
 import Yesod.Core
 import Yesod.Core.Widget
 

src/Vervis/Widget/Sharer.hs

@@ -16,17 +16,25 @@
 module Vervis.Widget.Sharer
     ( sharerLinkW
     , sharerLinkFedW
+    , followW
     )
 where
 
+import Data.Foldable
+import Database.Persist
+import Network.HTTP.Types.Method
 import Yesod.Core
+import Yesod.Persist.Core
 
 import Network.FedURI
+import Yesod.Auth.Unverified
+
+import Database.Persist.Local
 
 import Vervis.Foundation
 import Vervis.Model
-import Vervis.Model.Ident (ShrIdent, shr2text)
+import Vervis.Model.Ident
-import Vervis.Settings (widgetFile)
+import Vervis.Widget
 
 sharerLinkW :: Sharer -> Widget
 sharerLinkW sharer =
@@ -50,3 +58,17 @@ sharerLinkFedW (Right (inztance, actor)) =
     |]
     where
     uActor = ObjURI (instanceHost inztance) (remoteActorIdent actor)
+
+followW :: Route App -> AppDB FollowerSetId -> Widget
+followW followRoute getFsid = do
+    mpid <- maybeVerifiedAuthId
+    for_ mpid $ \ pid -> do
+        mfollow <- handlerToWidget $ runDB $ do
+            fsid <- getFsid
+            getValBy $ UniqueFollow pid fsid
+        case mfollow of
+            Nothing -> buttonW POST "Follow" followRoute
+            Just _ ->
+                [whamlet|
+                  <div>[Following]
+                |]

templates/person.hamlet

@@ -14,6 +14,8 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 
 ^{avatarW secure $ emailText $ personEmail person}
 
+^{followButton}
+
 <p>#{personAbout person}
 
 <ul>

templates/project/one.hamlet

@@ -1,6 +1,6 @@
 $# This file is part of Vervis.
 $#
-$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+$# Written in 2016, 2019 by fr33domlover <fr33domlover@riseup.net>.
 $#
 $# ♡ Copying is an act of love. Please copy, reuse and share.
 $#
@@ -12,6 +12,8 @@ $# 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/>.
 
+^{followButton}
+
 <p>
   <a href=@{ProjectEditR shar proj}>Edit this project
 

templates/repo/source-darcs.hamlet

@@ -1,6 +1,6 @@
 $# This file is part of Vervis.
 $#
-$# Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
+$# Written in 2016, 2018, 2019 by fr33domlover <fr33domlover@riseup.net>.
 $#
 $# ♡ Copying is an act of love. Please copy, reuse and share.
 $#
@@ -12,6 +12,8 @@ $# 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/>.
 
+^{followButton}
+
 $maybe desc <- repoDesc repository
   <p>#{desc}
 

templates/repo/source-git.hamlet

@@ -1,6 +1,6 @@
 $# This file is part of Vervis.
 $#
-$# Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
+$# Written in 2016, 2018, 2019 by fr33domlover <fr33domlover@riseup.net>.
 $#
 $# ♡ Copying is an act of love. Please copy, reuse and share.
 $#
@@ -12,6 +12,8 @@ $# 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/>.
 
+^{followButton}
+
 $maybe desc <- repoDesc repository
   <p>#{desc}