more metrics

app/Main.hs

@@ -36,7 +36,7 @@ import Data.List.Split (splitOn)
 import Database.Database (doMigration)
 import Logger (info, logger, tableify, warning)
 import Page (description, embedImage, embedText)
-import Pages.Admin.Admin (admin)
+import Pages.Admin.Admin (admin, aggregatedVisits)
 import Pages.Pages (findPage)
 import Repl (repl)
 import Settings (getInteractiveState, getMigrate, getPort)
@@ -45,6 +45,7 @@ import Text.Regex (Regex, matchRegex, mkRegex)
 import Utils (unpackBS)
 import State (getStates, getCookies)
 import Footer (footer)
+import Graphics.Matplotlib (onscreen, bar, plot)
 
 serve :: Html -> Response
 serve content = responseBuilder status200 [("Content-Type", "text/html")] $ copyByteString (fromString (renderHtml content))

app/Pages/Admin/Admin.hs

@@ -3,17 +3,19 @@ module Pages.Admin.Admin where
 import CodeBlock (codeBlock)
 import Data.Text (Text, unpack, pack)
 import Database.Database (prettyPrintSchema, validateToken, runDb, AdminTable (makeButton, toList, getRows))
-import Database.Schema (GuestbookEntry (GuestbookEntry), Snake (Snake), Token (Token), User (User), Visit (Visit), defs, EntityField (UserName, TokenToken))
+import Database.Schema (GuestbookEntry (GuestbookEntry, guestbookEntryTimestamp), Snake (Snake, snakeTimestamp), Token (Token), User (User), Visit (Visit, visitTimestamp), defs, EntityField (UserName, TokenToken))
 import IHP.HSX.QQ (hsx)
 import Layout (layout)
 import Page (Page, PageSetting (Description, Route), getArgs)
 import Text.Blaze.Html (Html, preEscapedToHtml)
 import Network.Wai (Request (pathInfo))
 import State (getStates, loggedIn, accessToken)
-import Database.Persist (Entity(Entity), selectList, EntityNameDB (unEntityNameDB), getEntityDBName, FieldNameHS (unFieldNameHS), FieldDef (fieldHaskell), getEntityFields, (==.), PersistQueryWrite (deleteWhere))
+import Database.Persist (Entity(Entity, entityVal), selectList, EntityNameDB (unEntityNameDB), getEntityDBName, FieldNameHS (unFieldNameHS), FieldDef (fieldHaskell), getEntityFields, (==.), PersistQueryWrite (deleteWhere))
 import Database.Persist.MySQL (rawSql, mkColumns)
 import Logger (warning)
-import Plot (plotSVG)
+import Plot (plotSVG, barSVG)
+import Data.List (nub)
+import Graphics.Matplotlib (toSvg, bar, onscreen, ylim, (%), ylabel, title)
 
 panel :: IO Html
 panel = do 
@@ -56,14 +58,66 @@ panel = do
             </tr>
         |]
 
+aggregatedVisits :: IO [Int]
+aggregatedVisits = do
+    timestamps <- fmap (fromIntegral . visitTimestamp . entityVal) <$> getRows [] []
+    return $ nub $ map (\x -> div x (60*60*24)) timestamps
+
+aggregatedGuestbook :: IO [Int]
+aggregatedGuestbook = do
+    timestamps <- fmap (fromIntegral . guestbookEntryTimestamp . entityVal) <$> getRows [] []
+    return $ nub $ map (\x -> div x (60*60*24)) timestamps
+
+aggregatedLeaderboard :: IO [Int]
+aggregatedLeaderboard = do
+    timestamps <- fmap (fromIntegral . snakeTimestamp . entityVal) <$> getRows [] []
+    return $ nub $ map (\x -> div x (60*60*24)) timestamps
+
 metrics :: IO Html
 metrics = do
-    rows <- fmap toList <$> (getRows [] [] :: IO [Entity Visit])
-    print rows
-    plot <- plotSVG (fmap (read . (!!1)) rows :: [Int]) (fmap (read . (!!0)) rows)
+    visitsPlot <- do 
+        aggregated <- aggregatedVisits
+        svg <- toSvg $
+            bar [show i | i <- [0 .. length aggregated - 1]] aggregated %
+            ylim (head aggregated - 1) (last aggregated) %
+            ylabel "daysSinceEpoch" %
+            title "Visits"
+        return $ case svg of
+            Left x -> x
+            Right x -> x
+
+    guestbookPlot <- do
+        aggregated <- aggregatedGuestbook
+        print aggregated
+        svg <- toSvg $
+            bar [show i | i <- [0 .. length aggregated - 1]] aggregated %
+            ylim (head aggregated - 1) (last aggregated) %
+            ylabel "daysSinceEpoch" %
+            title "Guestbook"
+        return $ case svg of
+            Left x -> x
+            Right x -> x
+
+    leaderboardPlot <- do
+        aggregated <- aggregatedLeaderboard
+        svg <- toSvg $
+            bar [show i | i <- [0 .. length aggregated - 1]] aggregated %
+            ylim (head aggregated - 1) (last aggregated) %
+            ylabel "daysSinceEpoch" %
+            title "Snake Leaderboard"
+        return $ case svg of
+            Left x -> x
+            Right x -> x
+
     return [hsx|
-        Visits over time:
-        {preEscapedToHtml plot}
+        Visits over time:<br>
+        {preEscapedToHtml visitsPlot}
+        <hr>
+        Guestbook entries over time:<br>
+        {preEscapedToHtml guestbookPlot}
+        <hr>
+        Snake leaderboard entries over time:<br>
+        {preEscapedToHtml leaderboardPlot}
     |]
 
 browse :: String -> IO Html

homepage.cabal

@@ -108,6 +108,7 @@ executable homepage
         persistent,
         persistent-mysql,
         monad-logger,
+        matplotlib,
         lib-homepage
 
     hs-source-dirs:   app

lib/Plot.hs

@@ -1,8 +1,8 @@
 module Plot where
-import Graphics.Matplotlib (onscreen, plot, Matplotlib, toSvg)
-import Graphics.Matplotlib.Internal (pySVG)
+import Graphics.Matplotlib (onscreen, plot, Matplotlib, toSvg, bar, xticks, (##), (%))
 import Data.Aeson (ToJSON)
 import Text.Blaze.Html (Html, preEscapedToHtml)
+import GHC.Base (maxInt)
 
 
 plotSVG :: (ToJSON a, Num a) => [a] -> [a] -> IO Html
@@ -12,3 +12,11 @@ plotSVG xs ys = preEscapedToHtml <$> do
     return $ case svg of
         (Left x) -> x
         (Right x) -> x
+
+barSVG :: (ToJSON a, Num a) => [a] -> [String] -> IO Html
+barSVG xs names = preEscapedToHtml <$> do
+    svg <- toSvg $ bar names xs
+    return $ case svg of
+        (Left x) -> x
+        (Right x) -> x
+