rankings is now in the Page monad

3 files changed, 78 insertions, 58 deletions

diff --git a/src/Types/Classes.hs b/src/Types/Classes.hs
index 1d2fed2..930f4e5 100644
--- a/src/Types/Classes.hs
+++ b/src/Types/Classes.hs
@@ -27,60 +27,3 @@ instance Show Class where
 
 numberOfSs               :: Class -> Int
 numberOfSs (Class _ _ n) = n
-
--- Make the columns with rankingColumns, and then transpose them so
--- that we can make HTML.
-
--- Do this as two composed folds (point-free), rather than three:
--- first one accumulates to list of three rows (each step adds to all
--- three rows) and second turns list of three rows into Html.
---
--- This also means that we can have the whole column with a meaningful
--- blue background colour for the current class and the winning two
--- classes, not only the first row.
-
-rankings                     :: Maybe Class -> ScoresList -> Html
-rankings currentClass scores = table ! [htmlAttr "class" (noHtml +++ "table table-bordered table-centered table-chunky")]
-                               << foldr (\row acc -> (tr << row) +++ acc) noHtml (rankings' currentClass scores)
-
-rankings'                     :: Maybe Class -> ScoresList -> [Html]
-rankings' currentClass scores = foldr step [noHtml, noHtml, noHtml] (rankingColumns currentClass scores)
-  where
-    step (first, second, third) [firstRow, secondRow, thirdRow] =
-        [first +++ firstRow, second +++ secondRow, third +++ thirdRow]
-
-rankingColumns        :: Maybe Class -> ScoresList -> [(Html, Html, Html)]
-rankingColumns currentClass scores = fst $ foldr step ([], length sortedScores) sortedScores
-  where
-    sortedScores = reverse . sortBy (compare `on` snd) $ scores
-    step (thisClass, (Score points timeWasted)) (cols, count) =
-        (( (if count <= 2
-            then bootstrapCellClass "success"
-            else if   Just thisClass == currentClass
-                 then bootstrapCellClass "info"
-                 else bootstrapCellClass "warning")
-           << strong << (niceDashes . show) thisClass
-         , td << show points
-         , (if  timeWasted >= 60
-            then bootstrapCellClass "warning"
-            else td)
-           << secondsToTime timeWasted
-         ) : cols, count - 1)
-    maybeBorder aClass=
-        if   Just aClass == currentClass
-        then [htmlAttr "class" noHtml]
-        else undefined
-
-secondsToTime         :: Int -> String
-secondsToTime n       = minutes' ++ ":" ++ seconds'
-  where
-    minutes           = n `quot` 60
-    seconds           = n `mod`  60
-    minutes'          = show minutes
-    seconds'
-        | seconds > 9 = show seconds
-        | otherwise   = '0' : show seconds
-
--- Makes <td class="contextualClass">.
-bootstrapCellClass                 :: String -> (Html -> Html)
-bootstrapCellClass contextualClass = td ! [htmlAttr "class" (noHtml +++ contextualClass)]
diff --git a/src/Utils/Classes.hs b/src/Utils/Classes.hs
new file mode 100644
index 0000000..091b41d
--- /dev/null
+++ b/src/Utils/Classes.hs
@@ -0,0 +1,74 @@
+module Utils.Classes (rankings) where
+
+import Control.Monad.Page
+import Text.XHtml
+import Types.Session
+import Types.Classes
+import Types.Scores
+import Utils.Xhtml
+import Data.List (sortBy)
+import Data.Function (on)
+
+-- Make the columns with rankingColumns, and then transpose them so
+-- that we can make HTML.
+
+-- Do this as two composed folds (point-free), rather than three:
+-- first one accumulates to list of three rows (each step adds to all
+-- three rows) and second turns list of three rows into Html.
+--
+-- This also means that we can have the whole column with a meaningful
+-- blue background colour for the current class and the winning two
+-- classes, not only the first row.
+
+rankings :: Page Html
+rankings = do
+    session <- getSession
+    scores <- getScores
+    return (table ! [htmlAttr "class" (noHtml +++ "table table-bordered table-centered table-chunky")]
+            << foldr (\row acc -> (tr << row) +++ acc) noHtml (rankings' (currentClass session) scores))
+
+-- rankings                     :: Maybe Class -> ScoresList -> Html
+-- rankings currentClass scores = table ! [htmlAttr "class" (noHtml +++ "table table-bordered table-centered table-chunky")]
+--                                << foldr (\row acc -> (tr << row) +++ acc) noHtml (rankings' currentClass scores)
+
+rankings'                     :: Maybe Class -> ScoresList -> [Html]
+rankings' currentClass scores = foldr step [noHtml, noHtml, noHtml] (rankingColumns currentClass scores)
+  where
+    step (first, second, third) [firstRow, secondRow, thirdRow] =
+        [first +++ firstRow, second +++ secondRow, third +++ thirdRow]
+
+rankingColumns        :: Maybe Class -> ScoresList -> [(Html, Html, Html)]
+rankingColumns currentClass scores = fst $ foldr step ([], length sortedScores) sortedScores
+  where
+    sortedScores = reverse . sortBy (compare `on` snd) $ scores
+    step (thisClass, (Score points timeWasted)) (cols, count) =
+        (( (if count <= 2
+            then bootstrapCellClass "success"
+            else if   Just thisClass == currentClass
+                 then bootstrapCellClass "info"
+                 else bootstrapCellClass "warning")
+           << strong << (niceDashes . show) thisClass
+         , td << show points
+         , (if  timeWasted >= 60
+            then bootstrapCellClass "warning"
+            else td)
+           << secondsToTime timeWasted
+         ) : cols, count - 1)
+    maybeBorder aClass=
+        if   Just aClass == currentClass
+        then [htmlAttr "class" noHtml]
+        else undefined
+
+secondsToTime         :: Int -> String
+secondsToTime n       = minutes' ++ ":" ++ seconds'
+  where
+    minutes           = n `quot` 60
+    seconds           = n `mod`  60
+    minutes'          = show minutes
+    seconds'
+        | seconds > 9 = show seconds
+        | otherwise   = '0' : show seconds
+
+-- Makes <td class="contextualClass">.
+bootstrapCellClass                 :: String -> (Html -> Html)
+bootstrapCellClass contextualClass = td ! [htmlAttr "class" (noHtml +++ contextualClass)]
diff --git a/src/sariulclocks.hs b/src/sariulclocks.hs
index 3176a38..4b9bc12 100644
--- a/src/sariulclocks.hs
+++ b/src/sariulclocks.hs
@@ -13,9 +13,12 @@ import Data.Maybe (fromMaybe)
 import Types.Session
 import Types.Clocks
 import Control.Monad.Page
+import Utils.Classes
 
 makePage :: Page Html
-makePage = return (h1 << "Hello World")
+makePage = do
+    theRankings <- rankings
+    return ((h1 << "Hello World") +++ theRankings)
 
 -- makePage :: Session -> ScoresList -> (Session, ScoresList, Html)
 -- makePage session scores = (session, scores, (h1 << "Hello World!") +++ rankings (Just $ lookupSariulClass 5 3) scores)