--------------------------------------------------------------------------------
-- Database actions


approveCommentDB :: UserId -> CommentId -> Comment -> SDB ()
approveCommentDB user_id comment_id comment = do
    now <- liftIO getCurrentTime
    -- Do an in-memory adjustment of the comment with exactly the same changes
    -- as 'upd' below (so we can avoid hitting the database).
    let updated_comment = comment
          { commentApprovedTs = Just now
          , commentApprovedBy = Just user_id
          }
    lift $ do
        updateComment now
        deleteUnapprovedCommentNotifications
    tell [ ECommentPosted comment_id updated_comment
         , ECommentApproved comment_id updated_comment
         ]
  where
    updateComment now =
        update $ \c -> do
        set c [ CommentApprovedTs =. val (Just now)
              , CommentApprovedBy =. val (Just user_id)
              ]
        where_ (c ^. CommentId ==. val comment_id)

    -- Delete all notifications sent about this pending comment, as they no
    -- longer apply. Also deletes the UnapprovedCommentNotification
    -- entities, the EventNotificationSent, and any other rows with a
    -- foreign key on NotificationId.
    deleteUnapprovedCommentNotifications = do
        notif_ids <- fmap (map unValue) $
            select $
            from $ \unc -> do
            where_ $
                unc ^. UnapprovedCommentNotificationComment ==. val comment_id
            return (unc ^. UnapprovedCommentNotificationNotification)
        deleteCascadeWhere [UserNotificationId P.<-. notif_ids]
approveCommentDB :: UserId -> CommentId -> Comment -> SDB ()
approveCommentDB user_id comment_id comment = do
    now <- liftIO getCurrentTime
    -- Do an in-memory adjustment of the comment with exactly the same changes
    -- as 'upd' below (so we can avoid hitting the database).
    let updated_comment = comment
          { commentApprovedTs = Just now
          , commentApprovedBy = Just user_id
          }
    lift $ do
        updateComment now
        deleteUnapprovedCommentNotifications
    tell [ ECommentPosted comment_id updated_comment
         , ECommentApproved comment_id updated_comment
         ]
  where
    updateComment now =
        update $ \c -> do
        set c [ CommentApprovedTs =. val (Just now)
              , CommentApprovedBy =. val (Just user_id)
              ]
        where_ (c ^. CommentId ==. val comment_id)

    -- Delete all notifications sent about this pending comment, as they no
    -- longer apply. Also deletes the UnapprovedCommentNotification
    -- entities, the EventNotificationSent, and any other rows with a
    -- foreign key on NotificationId.
    deleteUnapprovedCommentNotifications = do
        notif_ids <- fmap (map unValue) $
            select $
            from $ \unc -> do
            where_ $
                unc ^. UnapprovedCommentNotificationComment ==. val comment_id
            return (unc ^. UnapprovedCommentNotificationNotification)
        deleteCascadeWhere [UserNotificationId P.<-. notif_ids]
approveCommentDB user_id comment_id comment = do
    now <- liftIO getCurrentTime
    -- Do an in-memory adjustment of the comment with exactly the same changes
    -- as 'upd' below (so we can avoid hitting the database).
    let updated_comment = comment
          { commentApprovedTs = Just now
          , commentApprovedBy = Just user_id
          }
    lift $ do
        updateComment now
        deleteUnapprovedCommentNotifications
    tell [ ECommentPosted comment_id updated_comment
         , ECommentApproved comment_id updated_comment
         ]
  where
    updateComment now =
        update $ \c -> do
        set c [ CommentApprovedTs =. val (Just now)
              , CommentApprovedBy =. val (Just user_id)
              ]
        where_ (c ^. CommentId ==. val comment_id)

    -- Delete all notifications sent about this pending comment, as they no
    -- longer apply. Also deletes the UnapprovedCommentNotification
    -- entities, the EventNotificationSent, and any other rows with a
    -- foreign key on NotificationId.
    deleteUnapprovedCommentNotifications = do
        notif_ids <- fmap (map unValue) $
            select $
            from $ \unc -> do
            where_ $
                unc ^. UnapprovedCommentNotificationComment ==. val comment_id
            return (unc ^. UnapprovedCommentNotificationNotification)
        deleteCascadeWhere [UserNotificationId P.<-. notif_ids]