linux/query.cgi

   1 #!/usr/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 ++ "\""