From e158459bf8e221fcc4b9a0de614ab61b97a86373 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Sat, 5 Sep 2020 16:45:09 +0200
Subject: [PATCH] Handle showing as percentage

---
 Handler/CreateChallenge.hs |  4 +++-
 Handler/Query.hs           |  6 +++---
 Handler/Shared.hs          | 16 +++++++++-------
 Handler/Tables.hs          |  3 ++-
 config/models              |  1 +
 5 files changed, 18 insertions(+), 12 deletions(-)

diff --git a/Handler/CreateChallenge.hs b/Handler/CreateChallenge.hs
index e1f57e0..1f4d50e 100644
--- a/Handler/CreateChallenge.hs
+++ b/Handler/CreateChallenge.hs
@@ -393,7 +393,8 @@ insertOrUpdateTest testDir challengeId checksum commit opts (priority, metric) =
   mAlreadyExistingTest <- getBy $ UniqueChallengeNameMetricChecksum challengeId name metric checksum
   case mAlreadyExistingTest of
     Just (Entity testId _) -> update testId [TestCommit=.commit,
-                                            TestPrecision=. (decimalPlaces $ gesFormatting $ geoSpec opts),
+                                            TestPrecision=.(decimalPlaces $ gesFormatting $ geoSpec opts),
+                                            TestAsPercentage=.(Just $ asPercentage $ gesFormatting $ geoSpec opts),
                                             TestPriority=.Just priority]
     Nothing -> do
                 _ <- insert $ Test {
@@ -404,6 +405,7 @@ insertOrUpdateTest testDir challengeId checksum commit opts (priority, metric) =
                   testCommit=commit,
                   testActive=True,
                   testPrecision=decimalPlaces $ gesFormatting $ geoSpec opts,
+                  testAsPercentage=Just $ asPercentage $ gesFormatting $ geoSpec opts,
                   testPriority=Just priority}
                 return ()
 
diff --git a/Handler/Query.hs b/Handler/Query.hs
index 346e6bd..d4dcbc5 100644
--- a/Handler/Query.hs
+++ b/Handler/Query.hs
@@ -119,7 +119,7 @@ doGetScore mMetricName submission = do
                       return (evaluation)
 
       case evals of
-        [eval] -> return $ formatTruncatedScore (testPrecision $ entityVal testEnt) (Just $ entityVal eval)
+        [eval] -> return $ formatTruncatedScore (getTestFormattingOpts $ entityVal testEnt) (Just $ entityVal eval)
         _ -> return "NONE"
     Nothing -> return "NONE"
 
@@ -149,7 +149,7 @@ doGetScoreForOut mMetricName submission sha1code = do
                               Just mn -> find (\(_, t) -> formatTestEvaluationScheme (entityVal t) == mn) evals
   case evalSelected of
     Nothing -> return "None"
-    Just (eval, testEnt) -> return $ formatTruncatedScore (testPrecision $ entityVal testEnt)
+    Just (eval, testEnt) -> return $ formatTruncatedScore (getTestFormattingOpts $ entityVal testEnt)
                                                          (Just $ entityVal eval)
 
 
@@ -295,7 +295,7 @@ viewOutputWithNonDefaultTestSelected entry tests mainTest (outputHash, testSet)
   let testLabels = map (formatTestEvaluationScheme . entityVal) tests'
   let mapping = LM.fromList $ map (\test -> (formatTestEvaluationScheme $ entityVal test,
                                             (test,
-                                             (formatTruncatedScore (testPrecision $ entityVal test)
+                                             (formatTruncatedScore (getTestFormattingOpts $ entityVal test)
                                               $ extractScore (getTestReference test) entry)))) tests'
   let crossTables = splitIntoTablesWithValues "Metric" "Score" mapping testLabels
 
diff --git a/Handler/Shared.hs b/Handler/Shared.hs
index 86e275d..51ca1b7 100644
--- a/Handler/Shared.hs
+++ b/Handler/Shared.hs
@@ -491,18 +491,20 @@ formatFullScore :: Maybe Evaluation -> Text
 formatFullScore (Just evaluation) = fromMaybe "???" (formatNonScientifically <$> evaluationScore evaluation)
 formatFullScore Nothing = "N/A"
 
-formatTruncatedScore :: Maybe Int -> Maybe Evaluation -> Text
-formatTruncatedScore Nothing e = formatFullScore e
+formatTruncatedScore :: FormattingOptions -> Maybe Evaluation -> Text
 formatTruncatedScore _ Nothing  = formatFullScore Nothing
-formatTruncatedScore (Just precision) (Just evaluation) = case evaluationScore evaluation of
+formatTruncatedScore formattingOpts (Just evaluation) = case evaluationScore evaluation of
   Just score -> T.pack $ formatTheResultWithErrorBounds formattingOpts score (evaluationErrorBound evaluation)
   Nothing -> formatFullScore Nothing
- where formattingOpts = FormattingOptions {
-         decimalPlaces = Just precision,
-         asPercentage = False
-      }
 
 
+getTestFormattingOpts :: Test -> FormattingOptions
+getTestFormattingOpts test =
+  FormattingOptions {
+     decimalPlaces = testPrecision test,
+     asPercentage = fromMaybe False $ testAsPercentage test
+  }
+
 formatScore :: Maybe Int -> Double -> Text
 formatScore Nothing = T.pack . show
 formatScore (Just precision) = T.pack . (printf "%0.*f" precision)
diff --git a/Handler/Tables.hs b/Handler/Tables.hs
index 44dbf27..a958d6a 100644
--- a/Handler/Tables.hs
+++ b/Handler/Tables.hs
@@ -176,7 +176,8 @@ statusCell :: Text -> RepoScheme -> Repo -> (a -> (SubmissionId, Submission, Var
 statusCell challengeName repoScheme challengeRepo fun = Table.widget "" (statusCellWidget challengeName repoScheme challengeRepo . fun)
 
 resultCell :: Test -> (a -> Maybe Evaluation) -> Table App a
-resultCell test fun = hoverTextCell (formatTestForHtml test) (formatTruncatedScore (testPrecision test) . fun) (formatFullScore . fun)
+resultCell test fun = hoverTextCell (formatTestForHtml test) (formatTruncatedScore formattingOpts . fun) (formatFullScore . fun)
+  where formattingOpts = getTestFormattingOpts test
 
 textLimited :: Int -> Text -> Text
 textLimited limit t
diff --git a/config/models b/config/models
index f531806..8407532 100644
--- a/config/models
+++ b/config/models
@@ -75,6 +75,7 @@ Test
     commit SHA1
     active Bool default=True
     precision Int Maybe
+    asPercentage Bool Maybe
     priority Int Maybe
     UniqueChallengeNameMetricChecksum challenge name metric checksum
     deriving Show