1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative((<*))
import Data.Attoparsec(Parser,takeWhile1)
import Data.Attoparsec.Char8 (char8, endOfLine, isEndOfLine)
import Data.Attoparsec.Enumerator(iterParser)
import Data.Enumerator(Iteratee,Enumerator,run_,($$))
import Data.Enumerator.Binary (enumHandle)
import Data.ByteString.Char8(ByteString,unpack)
import Network.HTTP(simpleHTTP)
import Network.HTTP.Headers(Header,mkHeader,HeaderName(HdrContentLength))
import Network.HTTP.Base(urlEncode,mkRequest,Request(..),RequestMethod(PUT))
import Network.URI(parseURI)
import System.Environment(getArgs)
import System.Hardware.Serialport(hOpenSerial,defaultSerialSettings,commSpeed,CommSpeed(CS115200))
import System.IO (Handle,hFlush,hPutStr,stdin,hWaitForInput)
data Message = Measurement ByteString ByteString deriving (Show)
parser :: Parser Message
parser = do
sensor <- takeWhile1 (/=61) <* char8 '='
value <- takeWhile1 (not . isEndOfLine) <* endOfLine
return $! Measurement sensor value
parserIteratee :: Handle -> Iteratee ByteString IO (Message)
parserIteratee handle = stdinEnumerator $$ iteratee
where stdinEnumerator :: Enumerator ByteString IO b
stdinEnumerator = enumHandle 1 handle
iteratee :: Iteratee ByteString IO (Message)
iteratee = iterParser parser
work :: Handle -> IO ()
work port = do (Measurement sensor value) <- run_ (parserIteratee port)
let url = "http://localhost:8080/api/value/" ++ (urlEncode $ unpack sensor)
request = putRequest url in
simpleHTTP (putRequest url (unpack value))
putStrLn $ (unpack sensor) ++ "=" ++ (unpack value)
loop :: Handle -> IO ()
loop port = do sendRequest
work port
work port
work port
loop port
where sendRequest :: IO (Bool)
sendRequest = do catch (hWaitForInput port 50) handler
return (True)
where handler e = do putStrLn "."
hPutStr port "0"
hFlush port
sendRequest
main :: IO ()
main = do
args <- getArgs
port <- case args of
[path] -> hOpenSerial path defaultSerialSettings { commSpeed = CS115200 }
_ -> return stdin
loop port
putRequest :: String -> String -> Request String
putRequest urlString body =
case parseURI urlString of
Nothing -> error ("putRequest: Not a valid URL - " ++ urlString)
Just u -> Request { rqURI = u
, rqBody = body
, rqHeaders = headers
, rqMethod = PUT }
where headers = [ mkHeader HdrContentLength (show (length body) :: String) ]
|
