From e263a37eca8c2bf391f8e4c6ffc2edb5f1d76949 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Sat, 28 Jul 2018 19:16:07 +0200
Subject: [PATCH] clean up and generalize code generating param charts

---
 Foundation.hs                              |  8 +++++---
 Handler/Graph.hs                           |  8 +++-----
 Handler/ShowChallenge.hs                   | 10 +++++-----
 config/routes                              |  2 +-
 templates/challenge-all-submissions.hamlet |  2 +-
 5 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/Foundation.hs b/Foundation.hs
index 93923f9..88d29f5 100644
--- a/Foundation.hs
+++ b/Foundation.hs
@@ -5,8 +5,7 @@ module Foundation where
 import Database.Persist.Sql        (ConnectionPool, runSqlPool)
 import Import.NoFoundation
 import Text.Hamlet                 (hamletFile)
-import Yesod.Auth.HashDB           (HashDBUser(..),authHashDB,authHashDBWithForm)
-import Yesod.Auth.Message          (AuthMessage (InvalidLogin))
+import Yesod.Auth.HashDB           (HashDBUser(..), authHashDBWithForm)
 import qualified Yesod.Core.Unsafe as Unsafe
 import Yesod.Core.Types            (Logger)
 import Yesod.Default.Util          (addStaticContentExternal)
@@ -50,6 +49,7 @@ mkMessage "App" "messages" "en"
 -- | A convenient synonym for creating forms.
 type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget)
 
+isTrustedAuthorized :: (AuthEntity (HandlerSite m) ~ User, AuthId (HandlerSite m) ~ Key User, MonadHandler m, YesodAuthPersist (HandlerSite m)) => m AuthResult
 isTrustedAuthorized = do
   mauth <- maybeAuth
   case mauth of
@@ -58,6 +58,7 @@ isTrustedAuthorized = do
       | isTrusted user -> return Authorized
       | otherwise    -> return $ Unauthorized "???"
 
+isAdmin :: (AuthEntity (HandlerSite m) ~ User, AuthId (HandlerSite m) ~ Key User, MonadHandler m, YesodAuthPersist (HandlerSite m)) => m AuthResult
 isAdmin = do
   mauth <- maybeAuth
   case mauth of
@@ -153,7 +154,7 @@ instance Yesod App where
 
     isAuthorized (ApiTxtScoreR _) _ = return Authorized
 
-    isAuthorized (ChallengeParamGraphDataR _ _) _ = return Authorized
+    isAuthorized (ChallengeParamGraphDataR _ _ _) _ = return Authorized
 
     -- Default to Authorized for now.
     isAuthorized _ _ = isTrustedAuthorized
@@ -228,6 +229,7 @@ contactEmailLabel site =
      Nothing -> ""
    where maybeContactMail = appContactEmail $ appSettings site
 
+myLoginForm :: App -> Route site -> WidgetFor site ()
 myLoginForm site action = $(whamletFile "templates/auth.hamlet")
 
 instance YesodAuthPersist App
diff --git a/Handler/Graph.hs b/Handler/Graph.hs
index 07935cf..9ac3607 100644
--- a/Handler/Graph.hs
+++ b/Handler/Graph.hs
@@ -18,17 +18,15 @@ data ParamGraphItem = ParamGraphItem TableEntry Text Text MetricValue
 
 data ParamGraphSeries = ParamGraphSeries Text [(TableEntry, Text, MetricValue)]
 
-getChallengeParamGraphDataR :: Text -> Text -> Handler Value
-getChallengeParamGraphDataR challengeName paramName = do
+getChallengeParamGraphDataR :: Text -> (Key Test) -> Text -> Handler Value
+getChallengeParamGraphDataR challengeName testId paramName = do
   (Entity challengeId _) <- runDB $ getBy404 $ UniqueName challengeName
 
   (entries, tests) <- getChallengeSubmissionInfos (const True) challengeId
 
-  let mainTestId = entityKey $ getMainTest tests
-
   let values = map (findParamValue paramName) entries
 
-  let items = Data.Maybe.catMaybes $ map (toParamGraphItem mainTestId paramName) $ zip entries values
+  let items = Data.Maybe.catMaybes $ map (toParamGraphItem testId paramName) $ zip entries values
 
   let series = map (\(label, rs) -> ParamGraphSeries label rs)
                $ organizeBy
diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs
index 2d6ad7b..c6ccc95 100644
--- a/Handler/ShowChallenge.hs
+++ b/Handler/ShowChallenge.hs
@@ -529,16 +529,16 @@ challengeAllSubmissionsWidget :: Maybe UserId
 challengeAllSubmissionsWidget muserId challenge scheme challengeRepo submissions tests params =
   $(widgetFile "challenge-all-submissions")
   where chartJSs = mconcat $ map (getChartJs challenge mainTest) params
-        mainTest = entityVal $ getMainTest tests
+        mainTest = getMainTest tests
 
 getChartJs :: Challenge
-             -> Test
+             -> Entity Test
              -> Text
              -> JavascriptUrl (Route App)
-getChartJs challenge test param = [julius|
-$.getJSON("@{ChallengeParamGraphDataR (challengeName challenge) param}", function(data) {
+getChartJs challenge (Entity testId test) param = [julius|
+$.getJSON("@{ChallengeParamGraphDataR (challengeName challenge) testId param}", function(data) {
         c3.generate({
-                bindto: '#chart-' + #{toJSON param},
+                bindto: '#chart-' + #{toJSON param} + '-' + #{toJSON testId},
                 data: data,
                 axis: {
                    x: {
diff --git a/config/routes b/config/routes
index 7963174..efb8647 100644
--- a/config/routes
+++ b/config/routes
@@ -20,7 +20,7 @@
 /challenge-how-to/#Text ChallengeHowToR GET
 /challenge-graph-data/#Text ChallengeGraphDataR GET
 /challenge-discussion/#Text ChallengeDiscussionR GET POST
-/challenge-param-graph-data/#Text/#Text ChallengeParamGraphDataR GET
+/challenge-param-graph-data/#Text/#TestId/#Text ChallengeParamGraphDataR GET
 /challenge-discussion-rss/#Text ChallengeDiscussionFeedR GET
 /trigger-remotely TriggerRemotelyR POST
 /trigger-locally TriggerLocallyR POST
diff --git a/templates/challenge-all-submissions.hamlet b/templates/challenge-all-submissions.hamlet
index 371befd..ab858dd 100644
--- a/templates/challenge-all-submissions.hamlet
+++ b/templates/challenge-all-submissions.hamlet
@@ -15,7 +15,7 @@ $if not (null params)
   <h3>Graphs by parameters
 
   $forall param <- params
-    <div id="chart-#{param}"></div>
+    <div id="chart-#{param}-#{toPathPiece $ entityKey mainTest}"></div>
 
   <script src="/static/js/d3.min.js" charset="utf-8"></script>
   <script src="/static/js/c3.min.js"></script>