diff --git a/Handler/Dashboard.hs b/Handler/Dashboard.hs index 26e6d7d..5008626 100644 --- a/Handler/Dashboard.hs +++ b/Handler/Dashboard.hs @@ -17,6 +17,7 @@ import qualified Data.Map as M import Handler.Tables (timestampCell) import GEval.Core (isBetter) +import GEval.EvaluationScheme import qualified Database.Esqueleto as E import Database.Esqueleto ((^.)) @@ -227,7 +228,7 @@ getTargetStatus theNow entries indicator target = else TargetOngoing else TargetPassed where entries' = - filter (\v -> isBetter (testMetric $ entityVal $ indicatorEntryTest indicator) + filter (\v -> isBetter (evaluationSchemeMetric $ testMetric $ entityVal $ indicatorEntryTest indicator) v (targetValue $ entityVal target)) $ catMaybes diff --git a/Handler/Graph.hs b/Handler/Graph.hs index 91079b4..631cf8a 100644 --- a/Handler/Graph.hs +++ b/Handler/Graph.hs @@ -9,6 +9,7 @@ import Data.Maybe import Data.List ((!!)) import Database.Persist.Sql import GEval.Core (getMetricOrdering) +import GEval.EvaluationScheme import GEval.Common (MetricValue) import qualified Data.Map as M import qualified Data.Text as T @@ -247,7 +248,7 @@ entriesToPoints (Entity testId test) entries = (scores, timePoints) monotonicBy (\entry -> fromJust $ evaluationScore $ (tableEntryMapping entry) M.! testId) comparator $ filter (\entry -> testId `M.member` (tableEntryMapping entry) && isJust (evaluationScore ((tableEntryMapping entry) M.! testId))) entries - comparator = compareFun $ getMetricOrdering $ testMetric test + comparator = compareFun $ getMetricOrdering $ evaluationSchemeMetric $ testMetric test targetsToLines :: UTCTime -> IndicatorEntry -> [TargetStatus] -> Value targetsToLines theNow indicator statuses = object [ diff --git a/Handler/Shared.hs b/Handler/Shared.hs index 4357c60..7d031cd 100644 --- a/Handler/Shared.hs +++ b/Handler/Shared.hs @@ -40,6 +40,7 @@ import System.IO.Unsafe (unsafePerformIO) import Text.Regex.TDFA import GEval.Core +import GEval.EvaluationScheme import qualified Data.Vector as DV @@ -395,6 +396,7 @@ getIsHigherTheBetterArray = Array . DV.fromList . map (convertIsHigherTheBetter . getMetricOrdering + . evaluationSchemeMetric . testMetric) where convertIsHigherTheBetter TheHigherTheBetter = Bool True convertIsHigherTheBetter _ = Bool False @@ -416,5 +418,6 @@ runSlackHook hook message = do mempty return () -slackLink app title addr = "<" ++ link ++ "|" ++ title ++ ">" - where link = (appRoot $ appSettings app) ++ "/" ++ addr +slackLink :: App -> Text -> Text -> Text +slackLink app title addr = "<" ++ slink ++ "|" ++ title ++ ">" + where slink = (appRoot $ appSettings app) ++ "/" ++ addr diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs index b7b8630..d0d1706 100644 --- a/Handler/ShowChallenge.hs +++ b/Handler/ShowChallenge.hs @@ -29,6 +29,7 @@ import Gonito.ExtractMetadata (ExtractionOptions(..), import qualified Text.Read as TR import GEval.Core +import GEval.EvaluationScheme import GEval.Common (MetricValue) import GEval.OptionsParser import GEval.ParseParams (parseParamsFromFilePath, OutputFileParsed(..)) @@ -277,7 +278,7 @@ doCreateSubmission' _ userId challengeId mDescription mTags repoSpec chan = do activeTests <- runDB $ selectList [TestChallenge ==. challengeId, TestActive ==. True] [] let (Entity mainTestId mainTest) = getMainTest activeTests - let orderDirection = case getMetricOrdering (testMetric mainTest) of + let orderDirection = case getMetricOrdering (evaluationSchemeMetric $ testMetric mainTest) of TheHigherTheBetter -> E.desc TheLowerTheBetter -> E.asc @@ -341,10 +342,10 @@ doCreateSubmission' _ userId challengeId mDescription mTags repoSpec chan = do newScores <- mapM (getScoreForOut mainTestId) outs let newScores' = catMaybes newScores - let newScores'' = case getMetricOrdering (testMetric mainTest) of + let newScores'' = case getMetricOrdering (evaluationSchemeMetric $ testMetric mainTest) of TheHigherTheBetter -> reverse $ sort newScores' TheLowerTheBetter -> sort newScores' - let compOp = case getMetricOrdering (testMetric mainTest) of + let compOp = case getMetricOrdering (evaluationSchemeMetric $ testMetric mainTest) of TheLowerTheBetter -> (<) TheHigherTheBetter -> (>) @@ -554,7 +555,7 @@ checkOrInsertEvaluation repoDir chan out = do msg chan $ "Start evaluation..." challengeDir <- getRepoDir $ challengePrivateRepo challenge variant <- runDB $ get404 $ outVariant out - resultOrException <- liftIO $ rawEval challengeDir (testMetric test) repoDir (testName test) ((T.unpack $ variantName variant) <.> "tsv") + resultOrException <- liftIO $ rawEval challengeDir (evaluationSchemeMetric $ testMetric test) repoDir (testName test) ((T.unpack $ variantName variant) <.> "tsv") case resultOrException of Right (Left _) -> do err chan "Cannot parse options, check the challenge repo" diff --git a/Handler/Tables.hs b/Handler/Tables.hs index fc4ed59..e3406b4 100644 --- a/Handler/Tables.hs +++ b/Handler/Tables.hs @@ -22,6 +22,7 @@ import PersistSHA1 import qualified Data.List as DL import GEval.Core +import GEval.EvaluationScheme import GEval.ParseParams (parseParamsFromFilePath, OutputFileParsed(..)) @@ -243,7 +244,7 @@ getLeaderboardEntries ByTag challengeId = noEmptyList l = map Just l compareResult :: Test -> Maybe Double -> Maybe Double -> Ordering -compareResult test (Just x) (Just y) = (compareFun $ getMetricOrdering $ testMetric test) x y +compareResult test (Just x) (Just y) = (compareFun $ getMetricOrdering $ evaluationSchemeMetric $ testMetric test) x y compareResult _ (Just _) Nothing = GT compareResult _ Nothing (Just _) = LT compareResult _ Nothing Nothing = EQ diff --git a/Model.hs b/Model.hs index ab15558..6d8e5c9 100644 --- a/Model.hs +++ b/Model.hs @@ -6,7 +6,9 @@ import Database.Persist.Quasi import PersistSHA1 import GEval.Core +import GEval.EvaluationScheme import PersistMetric +import PersistEvaluationScheme -- You can define all of your database entities in the entities file. -- You can find more information on persistent and how to declare entities diff --git a/PersistEvaluationScheme.hs b/PersistEvaluationScheme.hs new file mode 100644 index 0000000..28ee1d1 --- /dev/null +++ b/PersistEvaluationScheme.hs @@ -0,0 +1,18 @@ +module PersistEvaluationScheme where + +import ClassyPrelude.Yesod +import Database.Persist.Sql + +import GEval.EvaluationScheme +import qualified Data.Text as T + +instance PersistField EvaluationScheme where + toPersistValue m = PersistText (T.pack $ show m) + + fromPersistValue (PersistText t) = case readMay t of + Just val -> Right val + Nothing -> Left "Unexpected value" + fromPersistValue _ = Left "Unexpected value" + +instance PersistFieldSql EvaluationScheme where + sqlType _ = SqlString diff --git a/config/models b/config/models index 42fead0..88ae1e5 100644 --- a/config/models +++ b/config/models @@ -42,7 +42,7 @@ Challenge archived Bool Maybe Test challenge ChallengeId - metric Metric + metric EvaluationScheme name Text checksum SHA1 commit SHA1 diff --git a/gonito.cabal b/gonito.cabal index 7fccbd4..01162aa 100644 --- a/gonito.cabal +++ b/gonito.cabal @@ -24,6 +24,7 @@ library Import Import.NoFoundation Model + PersistEvaluationScheme PersistMetric PersistSHA1 Settings @@ -126,7 +127,7 @@ library , filemanip , cryptohash , markdown - , geval >= 1.16.2.0 && < 1.19 + , geval >= 1.19.0.0 && < 1.20 , filepath , yesod-table , regex-tdfa