module Handler.Announcements where import Import import Handler.Shared import Web.Announcements (sendAnnouncement, AnnouncementPiece(..), AnnouncementMessage, AnnouncementHook, toAnnouncementHook) import qualified Database.Esqueleto as E import Database.Esqueleto ((^.)) sendChallengeAnnouncement :: ChallengeId -> AnnouncementMessage -> Handler () sendChallengeAnnouncement challengeId announcementMsg = do hooks <- fetchChallengeHooks challengeId liftIO $ mapM_ (\hook -> sendAnnouncement hook announcementMsg) hooks fetchChallengeHooks :: ChallengeId -> Handler [AnnouncementHook] fetchChallengeHooks challengeId = do courses <- runDB $ E.select $ E.from $ \(course, course_challenge) -> do E.where_ (course_challenge ^. CourseChallengeChallenge E.==. E.val challengeId E.&&. course_challenge ^. CourseChallengeCourse E.==. course ^. CourseId) return course case catMaybes $ map (courseAnnouncementHook . entityVal) courses of [] -> do app <- getYesod let mWebHook = appAnnouncementHook $ appSettings app return $ maybeToList mWebHook hooks -> return $ map toAnnouncementHook hooks getTestChallengeAnnouncementsR :: Text -> Handler Html getTestChallengeAnnouncementsR challengeName = do (Entity challengeId _) <- runDB $ getBy404 $ UniqueName challengeName app <- getYesod sendChallengeAnnouncement challengeId (testMessage app) defaultLayout $ do setTitle "Test announcements" $(widgetFile "test-challenge-announcements") getTestAnnouncementsR :: Handler Html getTestAnnouncementsR = do app <- getYesod let webHook = appAnnouncementHook $ appSettings app case webHook of Just hook -> liftIO $ sendAnnouncement hook (testMessage app) Nothing -> return () defaultLayout $ do setTitle "Test announcements" $(widgetFile "test-announcements") testMessage :: App -> AnnouncementMessage testMessage app = [AnnouncementText "Test message from ", (linkInAnnouncement app name "")] where name = case appLocation $ appSettings app of Just loc -> "Gonito@" ++ loc Nothing -> "Gonito"