Refactor towards general announcements

This commit is contained in:
Filip Gralinski 2021-08-21 09:45:37 +02:00
parent 8417e20851
commit 2a6515d872
5 changed files with 38 additions and 18 deletions

View File

@ -3,6 +3,7 @@ module Handler.Announcements where
import Import import Import
import Handler.Shared import Handler.Shared
import Web.Announcements (runSlackHook)
getTestAnnouncementsR :: Handler Html getTestAnnouncementsR :: Handler Html
getTestAnnouncementsR = do getTestAnnouncementsR = do

View File

@ -15,7 +15,6 @@ import System.Exit
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as DTE
import Database.Persist.Sql (fromSqlKey) import Database.Persist.Sql (fromSqlKey)
@ -43,6 +42,8 @@ import System.IO.Unsafe (unsafePerformIO)
import Text.Regex.TDFA import Text.Regex.TDFA
import Web.Announcements (formatLink)
import GEval.Core import GEval.Core
import GEval.Common import GEval.Common
import GEval.EvaluationScheme import GEval.EvaluationScheme
@ -50,8 +51,6 @@ import GEval.Formatting (formatTheResultWithErrorBounds)
import qualified Data.Vector as DV import qualified Data.Vector as DV
import Network.HTTP.Req as R
arena :: Handler FilePath arena :: Handler FilePath
arena = do arena = do
app <- getYesod app <- getYesod
@ -744,21 +743,8 @@ compareFun :: MetricOrdering -> Double -> Double -> Ordering
compareFun TheLowerTheBetter = flip compare compareFun TheLowerTheBetter = flip compare
compareFun TheHigherTheBetter = compare compareFun TheHigherTheBetter = compare
runSlackHook :: Text -> Text -> IO ()
runSlackHook hook message = do
let (Just (hookUrl, _)) = parseUrlHttps $ DTE.encodeUtf8 hook
R.runReq def $ do
let payload = object [ "text" .= message ]
(_ :: IgnoreResponse) <- R.req R.POST
hookUrl
(R.ReqBodyJson payload)
R.ignoreResponse
mempty
return ()
slackLink :: App -> Text -> Text -> Text slackLink :: App -> Text -> Text -> Text
slackLink app title addr = "<" ++ slink ++ "|" ++ title ++ ">" slackLink app title addr = formatLink slink title
where slink = (appRoot $ appSettings app) ++ "/" ++ addr where slink = (appRoot $ appSettings app) ++ "/" ++ addr
formatVersion :: (Int, Int, Int) -> Text formatVersion :: (Int, Int, Int) -> Text

View File

@ -33,7 +33,7 @@ import Database.Persist.Sql (fromSqlKey)
import qualified Data.Map as Map import qualified Data.Map as Map
import Web.Announcements
import Data.Maybe (fromJust) import Data.Maybe (fromJust)

32
Web/Announcements.hs Normal file
View File

@ -0,0 +1,32 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module Web.Announcements
(runSlackHook,
formatLink)
where
import Data.Text
import qualified Data.Text.Encoding as DTE
import Data.Maybe
import Network.HTTP.Req as R
import Prelude
import Data.Aeson
import Data.Default
runSlackHook :: Text -> Text -> IO ()
runSlackHook hook message = do
let (Just (hookUrl, _)) = parseUrlHttps $ DTE.encodeUtf8 hook
R.runReq def $ do
let payload = object [ "text" .= message ]
(_ :: IgnoreResponse) <- R.req R.POST
hookUrl
(R.ReqBodyJson payload)
R.ignoreResponse
mempty
return ()
formatLink :: Text -> Text -> Text
formatLink url title = "<" <> url <> "|" <> title <> ">"

View File

@ -64,6 +64,7 @@ library
Handler.JWT Handler.JWT
Handler.Team Handler.Team
Handler.Announcements Handler.Announcements
Web.Announcements
if flag(dev) || flag(library-only) if flag(dev) || flag(library-only)
cpp-options: -DDEVELOPMENT cpp-options: -DDEVELOPMENT