From: Eugene Crosser <crosser@average.org>
Date: Mon, 21 Dec 2015 20:52:09 +0000 (+0300)
Subject: provide last count values
X-Git-Url: http://www.average.org/gitweb/?p=pulsecounter.git;a=commitdiff_plain;h=57ab1d5776f832c3df5c8b2514f34e282b39fbd9

provide last count values
---

diff --git a/linux/query.cgi b/linux/query.cgi
deleted file mode 100755
index a629c79..0000000
--- a/linux/query.cgi
+++ /dev/null
@@ -1,84 +0,0 @@
-#!/usr/bin/env runhaskell
-
-{-# LANGUAGE OverloadedStrings #-}
-
-module Main where
-
-import Control.Monad
-import Data.Maybe
-import Data.List
-import System.Locale
-import System.Time
-import Network.CGI
-import Database.MySQL.Simple
-
-main = runCGI $ handleErrors cgiMain
-
-cgiMain :: CGI CGIResult
-cgiMain = do
-  conf <- liftIO $ readConf "/etc/watermeter.db"
-  conn <- liftIO $ connect defaultConnectInfo { connectHost = host conf
-					      , connectUser = user conf
-                                              , connectPassword = pass conf
-                                              , connectDatabase = dbnm conf
-                                              }
-  today <- liftIO getClockTime
-  let tomorrow = addToClockTime (noTimeDiff {tdDay = 1}) today
-      daystart x = (toUTCTime x) { ctHour = 0, ctMin = 0
-                                 , ctSec = 0, ctPicosec = 0}
-      dtstr x = formatCalendarTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" x
-      dlo = dtstr $ daystart today
-      dhi = dtstr $ daystart tomorrow
-  ilo <- getInput "lo"
-  ihi <- getInput "hi"
-  -- _ <- liftIO $ putStrLn $ " dlo=" ++ show dlo ++ " ilo=" ++ show ilo
-  --                      ++ " dhi=" ++ show dhi ++ " ihi=" ++ show ihi
-  let slo = fromMaybe dlo ilo :: String
-      shi = fromMaybe dhi ihi :: String
-  [(olo, ohi)] <- liftIO $ query conn "select to_seconds(?), to_seconds(?);"
-                         [slo, shi]
-  cold <- liftIO $ query conn
-    "select to_seconds(timestamp) as time, value+adj as value from \
-       \(select c.timestamp timestamp, c.value value, \
-         \(select sum(value) from coldadj a where a.timestamp <= c.timestamp \
-         \) adj from coldcnt c \
-           \where timestamp between ? and ? order by timestamp \
-       \) t;" (slo, shi)
-  hot <- liftIO $ query conn
-    "select to_seconds(timestamp) as time, value+adj as value from \
-       \(select c.timestamp timestamp, c.value value, \
-         \(select sum(value) from hotadj a where a.timestamp <= c.timestamp \
-         \) adj from hotcnt c \
-           \where timestamp between ? and ? order by timestamp \
-       \) t;" (slo, shi)
-  _ <- liftIO $ close conn
-  setHeader "Content-type" "application/json"
-  output $ "{\"range\": {\"lo\": " ++ show (olo :: Int)
-          ++ ", \"hi\": " ++ show (ohi :: Int)
-          ++ "}, \"cold\": [" ++ showjson cold
-          ++ "], \"hot\": [" ++ showjson hot ++ "]}\n"
-
-showjson :: [(Int, Double)] -> String
-showjson l = intercalate "," $ map (\(t, c) -> "[" ++ show t ++ "," ++ show (floor c) ++ "]") l
-
-data Conf = Conf { host :: String
-		 , user :: String
-		 , pass :: String
-		 , dbnm :: String
-		 }
-
-readConf :: String -> IO Conf
-readConf fn =
-  readFile fn >>= return . (foldr parseLine (Conf "" "" "" "")) . lines
-  where
-    parseLine :: String -> Conf -> Conf
-    parseLine l sum =
-      case words l of
-        [k, v] ->
-          case k of
-            "host" -> sum { host = v }
-            "user" -> sum { user = v }
-            "password" -> sum { pass = v }
-            "database" -> sum { dbnm = v }
-            _ -> error $ "bad key in config line \"" ++ l ++ "\""
-        _ -> error $ "bad config line \"" ++ l ++ "\""
diff --git a/web/query.cgi b/web/query.cgi
new file mode 100755
index 0000000..8720237
--- /dev/null
+++ b/web/query.cgi
@@ -0,0 +1,100 @@
+#!/usr/bin/env runhaskell
+
+--                                                                        --
+-- I am truly sorry. I would have used servant, but it failed to install. --
+-- I would have used sqeletto, but got thrown back by depencencies.       --
+-- I would have used some standard config file parser but they are all    --
+-- overkills. This program is a very quick and dirty hack.                --
+--                                                                        --
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Control.Monad
+import Data.Maybe
+import Data.List
+import System.Locale
+import System.Time
+import Network.CGI
+import Database.MySQL.Simple
+
+main = runCGI $ handleErrors cgiMain
+
+cgiMain :: CGI CGIResult
+cgiMain = do
+  conf <- liftIO $ readConf "/etc/watermeter.db"
+  conn <- liftIO $ connect defaultConnectInfo { connectHost = host conf
+					      , connectUser = user conf
+                                              , connectPassword = pass conf
+                                              , connectDatabase = dbnm conf
+                                              }
+  today <- liftIO getClockTime
+  let tomorrow = addToClockTime (noTimeDiff {tdDay = 1}) today
+      daystart x = (toUTCTime x) { ctHour = 0, ctMin = 0
+                                 , ctSec = 0, ctPicosec = 0}
+      dtstr x = formatCalendarTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" x
+      dlo = dtstr $ daystart today
+      dhi = dtstr $ daystart tomorrow
+  ilo <- getInput "lo"
+  ihi <- getInput "hi"
+  -- _ <- liftIO $ putStrLn $ " dlo=" ++ show dlo ++ " ilo=" ++ show ilo
+  --                      ++ " dhi=" ++ show dhi ++ " ihi=" ++ show ihi
+  let slo = fromMaybe dlo ilo :: String
+      shi = fromMaybe dhi ihi :: String
+  [(olo, ohi)] <- liftIO $ query conn "select to_seconds(?), to_seconds(?);"
+                         [slo, shi]
+  cold <- liftIO $ query conn
+    "select to_seconds(timestamp) as time, value+adj as value from \
+       \(select c.timestamp timestamp, c.value value, \
+         \(select sum(value) from coldadj a where a.timestamp <= c.timestamp \
+         \) adj from coldcnt c \
+           \where timestamp between ? and ? order by timestamp \
+       \) t;" (slo, shi)
+  hot <- liftIO $ query conn
+    "select to_seconds(timestamp) as time, value+adj as value from \
+       \(select c.timestamp timestamp, c.value value, \
+         \(select sum(value) from hotadj a where a.timestamp <= c.timestamp \
+         \) adj from hotcnt c \
+           \where timestamp between ? and ? order by timestamp \
+       \) t;" (slo, shi)
+  [(ccold, chot)] <- liftIO $ query_ conn
+    "select lcold+acold as cold, lhot+ahot as hot from \
+    \(select value as lcold from coldcnt order by timestamp desc limit 1) cc, \
+    \(select sum(value) as acold from coldadj) ac, \
+    \(select value as lhot from hotcnt order by timestamp desc limit 1) ch, \
+    \(select sum(value) as ahot from hotadj) ah;"
+  _ <- liftIO $ close conn
+
+  setHeader "Content-type" "application/json"
+  output $ "{\"range\": {\"lo\": " ++ show (olo :: Int)
+          ++ ", \"hi\": " ++ show (ohi :: Int)
+          ++ "}, \"current\": {\"cold\": " ++ show (floor (ccold :: Double))
+          ++ ", \"hot\": " ++ show (floor (chot :: Double))
+          ++ "}}, \"cold\": [" ++ showjson cold
+          ++ "], \"hot\": [" ++ showjson hot ++ "]}\n"
+
+showjson :: [(Int, Double)] -> String
+showjson l = intercalate "," $ map (\(t, c) -> "[" ++ show t ++ "," ++ show (floor c) ++ "]") l
+
+data Conf = Conf { host :: String
+		 , user :: String
+		 , pass :: String
+		 , dbnm :: String
+		 }
+
+readConf :: String -> IO Conf
+readConf fn =
+  readFile fn >>= return . (foldr parseLine (Conf "" "" "" "")) . lines
+  where
+    parseLine :: String -> Conf -> Conf
+    parseLine l sum =
+      case words l of
+        [k, v] ->
+          case k of
+            "host" -> sum { host = v }
+            "user" -> sum { user = v }
+            "password" -> sum { pass = v }
+            "database" -> sum { dbnm = v }
+            _ -> error $ "bad key in config line \"" ++ l ++ "\""
+        _ -> error $ "bad config line \"" ++ l ++ "\""