diff --git a/Handler/Dashboard.hs b/Handler/Dashboard.hs index cc84695..26e6d7d 100644 --- a/Handler/Dashboard.hs +++ b/Handler/Dashboard.hs @@ -18,6 +18,9 @@ import qualified Data.Map as M import Handler.Tables (timestampCell) import GEval.Core (isBetter) +import qualified Database.Esqueleto as E +import Database.Esqueleto ((^.)) + data IndicatorEntry = IndicatorEntry { indicatorEntryIndicator :: Entity Indicator, indicatorEntryTest :: Entity Test, @@ -30,6 +33,11 @@ data IndicatorEntry = IndicatorEntry { data TargetStatus = TargetPassed | TargetFailed | TargetOngoing deriving (Eq, Show) +isOngoingStatus :: TargetStatus -> Bool +isOngoingStatus TargetPassed = False +isOngoingStatus TargetFailed = False +isOngoingStatus TargetOngoing = True + getDashboardR :: Handler Html getDashboardR = do (formWidget, formEnctype) <- generateFormPost targetForm @@ -230,6 +238,23 @@ getTargetStatus theNow entries indicator target = $ filterEntries (indicatorEntryTargetCondition indicator) entries testId = entityKey $ indicatorEntryTest indicator +getOngoingTargets :: ChallengeId -> Handler [IndicatorEntry] +getOngoingTargets challengeId = do + indicators <- runDB $ E.select $ E.from $ \(test, indicator) -> do + E.where_ (test ^. TestChallenge E.==. E.val challengeId + E.&&. indicator ^. IndicatorTest E.==. test ^. TestId) + return indicator + indicatorEntries <- mapM indicatorToEntry indicators + theNow <- liftIO $ getCurrentTime + (entries, _) <- runDB $ getChallengeSubmissionInfos (const True) challengeId + let indicatorEntries' = map (onlyWithOngoingTargets theNow entries) indicatorEntries + return indicatorEntries' + + +onlyWithOngoingTargets :: UTCTime -> [TableEntry] -> IndicatorEntry -> IndicatorEntry +onlyWithOngoingTargets theNow entries indicatorEntry = + indicatorEntry { indicatorEntryTargets = filter (\t -> isOngoingStatus (getTargetStatus theNow entries indicatorEntry t)) (indicatorEntryTargets indicatorEntry) } + formatTargets :: IndicatorEntry -> Text formatTargets entry = T.intercalate ", " $ (map (formatTarget (testPrecision $ entityVal $ indicatorEntryTest entry))) $ indicatorEntryTargets entry diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs index 7f972bb..0542eba 100644 --- a/Handler/ShowChallenge.hs +++ b/Handler/ShowChallenge.hs @@ -17,6 +17,7 @@ import Handler.Runner import Handler.Tables import Handler.TagUtils import Handler.MakePublic +import Handler.Dashboard import Gonito.ExtractMetadata (ExtractionOptions(..), extractMetadataFromRepoDir, @@ -247,6 +248,8 @@ doCreateSubmission userId challengeId mDescription mTags repoSpec chan = do challenge <- runDB $ get404 challengeId user <- runDB $ get404 userId + relevantIndicators <- getOngoingTargets challengeId + activeTests <- runDB $ selectList [TestChallenge ==. challengeId, TestActive ==. True] [] let (Entity mainTestId mainTest) = getMainTest activeTests @@ -320,12 +323,14 @@ doCreateSubmission userId challengeId mDescription mTags repoSpec chan = do let compOp = case getMetricOrdering (testMetric mainTest) of TheLowerTheBetter -> (<) TheHigherTheBetter -> (>) + + let submissionLink = slackLink app "submission" ("q/" ++ (fromSHA1ToText (repoCurrentCommit repo))) + case bestScoreSoFar of Just b -> case newScores'' of (s:_) -> if compOp s b then do - let submissionLink = slackLink app "submission" ("q/" ++ (fromSHA1ToText (repoCurrentCommit repo))) let challengeLink = slackLink app (challengeTitle challenge) ("challenge/" ++ (challengeName challenge)) let message = ("Whoa! New best result for " @@ -359,8 +364,48 @@ doCreateSubmission userId challengeId mDescription mTags repoSpec chan = do doMakePublic userId submissionId chan else return () + + if not (null relevantIndicators) + then + checkIndicators user challengeId submissionId submissionLink relevantIndicators chan + else + return () + Nothing -> return () +checkIndicators :: User -> ChallengeId -> SubmissionId -> Text -> [IndicatorEntry] -> Channel -> Handler () +checkIndicators user challengeId submissionId submissionLink relevantIndicators chan = do + msg chan "Checking indicators..." + theNow <- liftIO $ getCurrentTime + mapM_ (\indicator -> checkIndicator theNow user challengeId submissionId submissionLink indicator chan) relevantIndicators + +checkIndicator :: UTCTime -> User -> ChallengeId -> SubmissionId -> Text -> IndicatorEntry -> Channel -> Handler () +checkIndicator theNow user challengeId submissionId submissionLink indicator chan = do + (entries, _) <- runDB $ getChallengeSubmissionInfos (\(Entity sid _) -> sid == submissionId) challengeId + mapM_ (\t -> checkTarget theNow user submissionLink entries indicator t chan) (indicatorEntryTargets indicator) + +checkTarget :: UTCTime -> User -> Text -> [TableEntry] -> IndicatorEntry -> Entity Target -> Channel -> Handler () +checkTarget theNow user submissionLink entries indicator target chan = do + app <- getYesod + let status = getTargetStatus theNow entries indicator target + if status == TargetPassed + then + do + let message = "Congratulations!!! The target " ++ indicatorText + ++ " was beaten by " + ++ (fromMaybe "???" $ userName user) + ++ ", " + ++ " See " ++ submissionLink ++ "." + ++ (T.replicate 10 " :champagne: ") ++ " :mleczko: " + msg chan message + case appNewBestResultSlackHook $ appSettings app of + Just "" -> return () + Just hook -> liftIO $ runSlackHook hook message + Nothing -> return () + else + return () + where indicatorText = prettyIndicatorEntry indicator + getScoreForOut mainTestId out = do mEvaluation <- runDB $ selectFirst [EvaluationChecksum ==. (outChecksum out), EvaluationTest ==. mainTestId]