Merge branch 'master' of ssh://gonito.net/gonito

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

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 [

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 ++ ">"
+slackLink :: App -> Text -> Text -> Text
-  where link = (appRoot $ appSettings app) ++ "/" ++ addr
+slackLink app title addr = "<" ++ slink ++ "|" ++ title ++ ">"
+  where slink = (appRoot $ appSettings app) ++ "/" ++ addr

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"

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

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

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

config/models

@@ -42,7 +42,7 @@ Challenge
     archived Bool Maybe
 Test
     challenge ChallengeId
-    metric Metric
+    metric EvaluationScheme
     name Text
     checksum SHA1
     commit SHA1

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