3 {-# LANGUAGE OverloadedStrings #-}
13 import Database.MySQL.Simple
15 main = runCGI $ handleErrors cgiMain
17 cgiMain :: CGI CGIResult
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
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
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(?);"
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 \
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 \
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"
61 showjson :: [(Int, Double)] -> String
62 showjson l = intercalate "," $ map (\(t, c) -> "[" ++ show t ++ "," ++ show (floor c) ++ "]") l
64 data Conf = Conf { host :: String
70 readConf :: String -> IO Conf
72 readFile fn >>= return . (foldr parseLine (Conf "" "" "" "")) . lines
74 parseLine :: String -> Conf -> Conf
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 ++ "\""