Check indicator targets

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
 

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]