{-# 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) ]