Refactor towards general announcements
This commit is contained in:
parent
8417e20851
commit
2a6515d872
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
32
Web/Announcements.hs
Normal 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 <> ">"
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user