clean up and generalize code generating param charts

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

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

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: {

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

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>