0bab4e1bef48cc350720b3ca4ab89151b2685317
[pulsecounter.git] / linux / query.cgi
1 #!/bin/env runhaskell
2
3 {-# LANGUAGE OverloadedStrings #-}
4
5 module Main where
6
7 import Control.Monad
8 import Data.Maybe
9 import Data.List
10 import System.Locale
11 import System.Time
12 import Network.CGI
13 import Database.MySQL.Simple
14
15 main = runCGI $ handleErrors cgiMain
16
17 cgiMain :: CGI CGIResult
18 cgiMain = do
19   conf <- liftIO $ readConf "/etc/watermeter.db"
20   conn <- liftIO $ connect defaultConnectInfo { connectHost = host conf
21                                               , connectUser = user conf
22                                               , connectPassword = pass conf
23                                               , connectDatabase = dbnm conf
24                                               }
25   today <- liftIO getClockTime
26   let tomorrow = addToClockTime (noTimeDiff {tdDay = 1}) today
27       daystart x = (toUTCTime x) { ctHour = 0, ctMin = 0
28                                  , ctSec = 0, ctPicosec = 0}
29       dtstr x = formatCalendarTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" x
30       dlo = dtstr $ daystart today
31       dhi = dtstr $ daystart tomorrow
32   ilo <- getInput "lo"
33   ihi <- getInput "hi"
34   -- _ <- liftIO $ putStrLn $ " dlo=" ++ show dlo ++ " ilo=" ++ show ilo
35   --                      ++ " dhi=" ++ show dhi ++ " ihi=" ++ show ihi
36   let slo = fromMaybe dlo ilo :: String
37       shi = fromMaybe dhi ihi :: String
38   [(olo, ohi)] <- liftIO $ query conn "select to_seconds(?), to_seconds(?);"
39                          [slo, shi]
40   cold <- liftIO $ query conn
41     "select to_seconds(timestamp) as time, value+adj as value from \
42        \(select c.timestamp timestamp, c.value value, \
43          \(select sum(value) from coldadj a where a.timestamp <= c.timestamp \
44          \) adj from coldcnt c \
45            \where timestamp between ? and ? order by timestamp \
46        \) t;" (slo, shi)
47   hot <- liftIO $ query conn
48     "select to_seconds(timestamp) as time, value+adj as value from \
49        \(select c.timestamp timestamp, c.value value, \
50          \(select sum(value) from hotadj a where a.timestamp <= c.timestamp \
51          \) adj from hotcnt c \
52            \where timestamp between ? and ? order by timestamp \
53        \) t;" (slo, shi)
54   _ <- liftIO $ close conn
55   setHeader "Content-type" "application/json"
56   output $ "{\"range\": {\"lo\": " ++ show (olo :: Int)
57           ++ ", \"hi\": " ++ show (ohi :: Int)
58           ++ "}, \"cold\": [" ++ showjson cold
59           ++ "], \"hot\": [" ++ showjson hot ++ "]}\n"
60
61 showjson :: [(Int, Double)] -> String
62 showjson l = intercalate "," $ map (\(t, c) -> "[" ++ show t ++ "," ++ show (floor c) ++ "]") l
63
64 data Conf = Conf { host :: String
65                  , user :: String
66                  , pass :: String
67                  , dbnm :: String
68                  }
69
70 readConf :: String -> IO Conf
71 readConf fn =
72   readFile fn >>= return . (foldr parseLine (Conf "" "" "" "")) . lines
73   where
74     parseLine :: String -> Conf -> Conf
75     parseLine l sum =
76       case words l of
77         [k, v] ->
78           case k of
79             "host" -> sum { host = v }
80             "user" -> sum { user = v }
81             "password" -> sum { pass = v }
82             "database" -> sum { dbnm = v }
83             _ -> error $ "bad key in config line \"" ++ l ++ "\""
84         _ -> error $ "bad config line \"" ++ l ++ "\""