Merge pull request #818 from tsoding/friday-count-on-next-video

Friday count on next video

Author: rexim

src/Bot/Friday.hs

@@ -134,10 +134,7 @@ fridayCommand =
        [qms|Could not check friday video
             duplicates because there is no YouTube
             id in the message.|]) $
-  liftR
-    (\ytId ->
-       selectEntities (Proxy :: Proxy FridayVideo) $
-       Filter (PropertyTextLike "name" ("%" <> ytId <> "%")) All) $
+  liftR fridayVideosByYtId $
   cmapR
     (\dups ->
        [qms|Added to the suggested video.
@@ -216,11 +213,13 @@ videoCommand =
   liftR (const currentVideo) $
   replyOnNothing "No videos in the queue" $
   cmapR entityPayload $
+  liftFst (fmap length . fridayVideosByYtId . fridayVideoName) $
   cmapR
-    (\video ->
+    (\(video, times) ->
        [qms|{fridayVideoDate video}
             <{fridayVideoAuthor video}>
-            {fridayVideoName video}|]) $
+            {fridayVideoName video} —
+            This video was suggested {times} times.|]) $
   Reaction replyMessage
 
 currentFridayState :: Effect (Entity FridayState)
@@ -323,13 +322,15 @@ videoQueueCommand =
         cmapR (const "Freshness invalidated 👌") $ Reaction replyMessage)
     ]
 
+fridayVideosByYtId :: T.Text -> Effect [Entity FridayVideo]
+fridayVideosByYtId ytId =
+  selectEntities Proxy $
+  Filter (PropertyTextLike "name" ("%" <> ytId <> "%")) All
+
 fridayCountCommand :: Reaction Message T.Text
 fridayCountCommand =
   cmapR ytLinkId $
   replyOnNothing "Please submit a YouTube link" $
-  liftR
-    (\ytId ->
-       selectEntities (Proxy :: Proxy FridayVideo) $
-       Filter (PropertyTextLike "name" ("%" <> ytId <> "%")) All) $
+  liftR fridayVideosByYtId $
   cmapR (\dups -> [qms|This video was suggested {length dups} times|]) $
   Reaction replyMessage