added support to show a plot of metrics over time

app/Pages/Admin/Admin.hs

@@ -7,12 +7,13 @@ import Database.Schema (GuestbookEntry (GuestbookEntry), Snake (Snake), Token (T
 import IHP.HSX.QQ (hsx)
 import Layout (layout)
 import Page (Page, PageSetting (Description, Route), getArgs)
-import Text.Blaze.Html (Html)
+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.MySQL (rawSql, mkColumns)
 import Logger (warning)
+import Plot (plotSVG)
 
 panel :: IO Html
 panel = do 
@@ -39,6 +40,8 @@ panel = do
                 ("valid_tokens", [length valid_tokens])
             ]}
         </table>
+        <br>
+        <a href="/admin/metrics">Show metrics</a>
     |]
     where
         th x = [hsx|<th class="common-table-element">{x}</th>|]
@@ -53,6 +56,16 @@ panel = do
             </tr>
         |]
 
+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)
+    return [hsx|
+        Visits over time:
+        {preEscapedToHtml plot}
+    |]
+
 browse :: String -> IO Html
 browse table = do 
     tableData <- getTableData table
@@ -134,6 +147,7 @@ browse table = do
         empty = [hsx||]
 
 route :: [String] -> IO Html
+route [_, "metrics"] = metrics
 route [_, "browse", table] = browse table
 route _ = panel
 

flake.nix

@@ -12,8 +12,19 @@
             packages = with pkgs; [
                 (haskellPackages.ghcWithPackages (hs: with hs; [
                     cabal-install
+                    matplotlib
                     haskell-language-server
+                    (python311.withPackages (py: with py; [
+                        matplotlib
+                        ipython
+                    ]))
                 ] ++ ((pkgs.callPackage ./nix-support/package.nix {}).buildInputs)))
+                (python311.withPackages (py: with py; [
+                    matplotlib
+                    ipython
+                    scipy
+                ]))
+
             ];
         };
         packages.${system} = let 

homepage.cabal

@@ -16,7 +16,8 @@ library lib-homepage
         Repl,
         Scripts,
         Page,
-        State
+        State,
+        Plot
     build-depends:
         base,
         ihp-hsx,
@@ -43,7 +44,8 @@ library lib-homepage
         persistent-mysql,
         persistent-sqlite,
         monad-logger,
-        raw-strings-qq
+        raw-strings-qq,
+        matplotlib
     hs-source-dirs:   lib
     default-language: GHC2021
     default-extensions:

lib/Plot.hs

@@ -0,0 +1,14 @@
+module Plot where
+import Graphics.Matplotlib (onscreen, plot, Matplotlib, toSvg)
+import Graphics.Matplotlib.Internal (pySVG)
+import Data.Aeson (ToJSON)
+import Text.Blaze.Html (Html, preEscapedToHtml)
+
+
+plotSVG :: (ToJSON a, Num a) => [a] -> [a] -> IO Html
+plotSVG xs ys = preEscapedToHtml <$> do 
+    let p = plot xs ys
+    svg <- toSvg p
+    return $ case svg of
+        (Left x) -> x
+        (Right x) -> x

nix-support/package.nix

@@ -17,6 +17,11 @@ pkgs.haskellPackages.mkDerivation {
         directory http-conduit http-types ihp-hsx monad-logger password
         persistent persistent-mysql regex-compat split string-random text
         time utf8-string uuid wai warp yaml raw-strings-qq persistent-sqlite
+        matplotlib
+        (pkgs.python311.withPackages (py: with py; [
+            matplotlib
+            scipy
+        ]))
     ];
     testHaskellDepends = with pkgs.haskellPackages; [ base ];
     doHaddock = false;