From 6a7a4b72cfcaa88af413cd96ec0ab432e8308e5c Mon Sep 17 00:00:00 2001
From: Thomas <mast3r@skade.dev>
Date: Thu, 14 Nov 2024 12:49:59 +0100
Subject: [PATCH] added support to show a plot of metrics over time

---
 app/Pages/Admin/Admin.hs | 16 +++++++++++++++-
 flake.nix                | 11 +++++++++++
 homepage.cabal           |  6 ++++--
 lib/Plot.hs              | 14 ++++++++++++++
 nix-support/package.nix  |  5 +++++
 5 files changed, 49 insertions(+), 3 deletions(-)
 create mode 100644 lib/Plot.hs

diff --git a/app/Pages/Admin/Admin.hs b/app/Pages/Admin/Admin.hs
index a1a86ed..fc08cb5 100644
--- a/app/Pages/Admin/Admin.hs
+++ b/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
 
diff --git a/flake.nix b/flake.nix
index 6d44c74..8c20222 100644
--- a/flake.nix
+++ b/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 
diff --git a/homepage.cabal b/homepage.cabal
index 44e4aec..57051ee 100644
--- a/homepage.cabal
+++ b/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:
diff --git a/lib/Plot.hs b/lib/Plot.hs
new file mode 100644
index 0000000..2b1a9c0
--- /dev/null
+++ b/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
diff --git a/nix-support/package.nix b/nix-support/package.nix
index 299add6..54cb6b1 100644
--- a/nix-support/package.nix
+++ b/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;