2 {-# LANGUAGE OverloadedStrings #-}
12 import Database.MySQL.Simple
14 main = runCGI $ handleErrors cgiMain
16 cgiMain :: CGI CGIResult
18 conn <- liftIO $ connect defaultConnectInfo { connectUser = "watermeter"
19 , connectPassword = "xxxxxxxx"
20 , connectDatabase = "watermeter"
22 today <- liftIO getClockTime
23 let tomorrow = addToClockTime (noTimeDiff {tdDay = 1}) today
24 daystart x = (toUTCTime x) { ctHour = 0, ctMin = 0
25 , ctSec = 0, ctPicosec = 0}
26 dtstr x = formatCalendarTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" x
27 dlo = dtstr $ daystart today
28 dhi = dtstr $ daystart tomorrow
31 -- _ <- liftIO $ putStrLn $ " dlo=" ++ show dlo ++ " ilo=" ++ show ilo
32 -- ++ " dhi=" ++ show dhi ++ " ihi=" ++ show ihi
33 let slo = fromMaybe dlo ilo :: String
34 shi = fromMaybe dhi ihi :: String
35 [(olo, ohi)] <- liftIO $ query conn "select to_seconds(?), to_seconds(?);"
37 cold <- liftIO $ query conn
38 "select to_seconds(timestamp) as time, value+adj as value from \
39 \(select c.timestamp timestamp, c.value value, \
40 \(select sum(value) from coldadj a where a.timestamp <= c.timestamp \
41 \) adj from coldcnt c \
42 \where timestamp between ? and ? order by timestamp \
44 hot <- liftIO $ query conn
45 "select to_seconds(timestamp) as time, value+adj as value from \
46 \(select c.timestamp timestamp, c.value value, \
47 \(select sum(value) from hotadj a where a.timestamp <= c.timestamp \
48 \) adj from hotcnt c \
49 \where timestamp between ? and ? order by timestamp \
51 _ <- liftIO $ close conn
52 setHeader "Content-type" "application/json"
53 output $ "{\"range\": {\"lo\": " ++ show (olo :: Int)
54 ++ ", \"hi\": " ++ show (ohi :: Int)
55 ++ "}, \"cold\": [" ++ showjson cold
56 ++ "], \"hot\": [" ++ showjson hot ++ "]}\n"
58 showjson :: [(Int, Double)] -> String
59 showjson l = intercalate "," $ map (\(t, c) -> "[" ++ show t ++ "," ++ show (floor c) ++ "]") l