diff options
Diffstat (limited to 'datasources/serialparser.hs')
-rw-r--r-- | datasources/serialparser.hs | 71 |
1 files changed, 0 insertions, 71 deletions
diff --git a/datasources/serialparser.hs b/datasources/serialparser.hs deleted file mode 100644 index f2f6c09..0000000 --- a/datasources/serialparser.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# 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) ] - |