{-
 - Connect to the LIRC socket and convert 
 - the input into Keys
 -}
module Hmpf.LIRC (clear, lirc, testLirc ) where

import Control.Concurrent (threadDelay)
import qualified Data.ByteString as B
import Data.Word (Word8)
import Network.Socket {- network package -}
import System.IO
import qualified Control.Exception as E  ( catch , throw )
import Hmpf.Keys
import Hmpf.ApplicationTypes
--import Control.Monad.State (lift)

-- Exception: bind: resource busy (Address already in use)
--addr :: SockAddr
--addr = SockAddrUnix "/dev/lircd"

lirc :: Session Key
lirc = do
 st <- get
 lift . lirc' . lircConf $ st


lirc' :: String -> IO Key
lirc' dev = input 
 where
 problem e = do
  let msg = "Unable to connect to LIRC:  " ++ (show e)
  putStrLn msg
  E.throw e
 connection =  
   do let addr = SockAddrUnix dev
      sock <- socket AF_UNIX Stream {-protocol-} 0
      connect sock addr
      h <- socketToHandle sock ReadMode 
      return h
 input =
   do h <- E.catch connection problem
      key <- B.hGetLine h >>= return . getCommand . B.unpack 
      if key == Wheel
       then do
         threadDelay 200000 >> clearBuffer h >> threadDelay 100000
	 bs <- B.hGetNonBlocking h 1
	 case B.null bs of 
	  True -> return Wheel
	  _ -> threadDelay 200000 >> clearBuffer h >> return DoubleWheel
       else return key


getCommand :: [Word8] -> Key
getCommand xs = 
 read. (!! 2) . words . map (toChar.fromEnum) $ xs
 --read. (!! 2) . words . head . lines . map (toChar.fromEnum) $ xs

toChar = toEnum :: Int -> Char

testLirc :: IO ()
testLirc = do
 key <- lirc' "/dev/lircd"
 putStrLn . show $ key
 testLirc


clearBuffer :: Handle -> IO ()
clearBuffer h = do
 bs <- B.hGetNonBlocking h 1 
 case B.null bs of 
  True  -> return ()
  _ -> clearBuffer h


clear :: Session ()
clear = do
 st <- get
 lift . clear' . lircConf $ st

clear' :: String -> IO ()
clear' dev = catch  input (\e -> return ())
 where 
 input = 
   do let addr = SockAddrUnix dev
      sock <- socket AF_UNIX Stream {-protocol-} 0
      connect sock addr
      socketToHandle sock ReadMode >>= clearBuffer