serialparser

1 files changed, 38 insertions, 12 deletions

diff --git a/datasources/serialparser.hs b/datasources/serialparser.hs
index 24686f5..f2f6c09 100644
--- a/datasources/serialparser.hs
+++ b/datasources/serialparser.hs
@@ -1,45 +1,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 System.Environment(getArgs)
-import System.IO (Handle,stdin)
 import Data.ByteString.Char8(ByteString,unpack)
-import Network.HTTP(simpleHTTP,getRequest)
-import Network.HTTP.Base(urlEncode)
+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
+parser  = do
   sensor <- takeWhile1 (/=61) <* char8 '='
   value <- takeWhile1 (not . isEndOfLine) <* endOfLine
   return $! Measurement sensor value
 
-parserIteratee :: Handle -> Iteratee ByteString IO (Message)
+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     :: Handle -> IO ()
 work port = do (Measurement sensor value) <- run_ (parserIteratee port)
-               let url = "http://localhost:8080/api/value/" ++ (urlEncode $ unpack sensor) ++ "/" ++ (urlEncode $ unpack value) in
-                   simpleHTTP (getRequest url)
+               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
+main  = do
        args <- getArgs
        port <- case args of
             [path] -> hOpenSerial path defaultSerialSettings { commSpeed = CS115200 }
             _ -> return stdin
-       work port
+       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) ]