Add GHC Handle creation

System/Hardware/Serialport.hs

@@ -27,6 +27,7 @@ module System.Hardware.Serialport (
   ,getSerialSettings
   -- * Serial methods
   -- ** Device
+  ,hOpenSerial
   ,openSerial
   ,closeSerial
   ,withSerial

System/Hardware/Serialport/Posix.hsc

@@ -10,14 +10,72 @@ import System.Posix.Terminal
 import System.Hardware.Serialport.Types
 import Foreign
 import Foreign.C
+import GHC.IO.Handle
+import GHC.IO.Device
+import GHC.IO.BufferedIO
+import Data.Typeable.Internal
+import GHC.Fingerprint.Type
+import GHC.IO.Buffer
+
+
+data SerialPort = SerialPort {
+                      fd :: Fd,
+                      portSettings :: SerialPortSettings
+                  }
+
+
+
+instance RawIO SerialPort where
+  read (SerialPort fd' _) ptr n = return . fromIntegral =<< fdReadBuf fd' ptr (fromIntegral n)
+  readNonBlocking _ _ _ = error "readNonBlocking not implemented"
+  write (SerialPort fd' _) ptr n = fdWriteBuf fd' ptr (fromIntegral n) >> return ()
+  writeNonBlocking _ _ _ = error "writenonblocking not implemented"
+
+
+instance IODevice SerialPort where
+  ready _ _ _ = return True
+  close = closeSerial
+  isTerminal _ = return False
+  isSeekable _ = return False
+  seek _ _ _ = return ()
+  tell _ = return 0
+  getSize _ = return 0
+  setSize _ _ = return ()
+  setEcho _ _ = return ()
+  getEcho _ = return False
+  setRaw _ _ = return ()
+  devType _ = return Stream
+
+
+instance BufferedIO SerialPort where
+  newBuffer _ = newByteBuffer 100
+  fillReadBuffer = readBuf
+  fillReadBuffer0 = readBufNonBlocking
+  flushWriteBuffer = writeBuf
+  flushWriteBuffer0 = writeBufNonBlocking
+
+
+instance Typeable SerialPort where
+  typeOf _ = TypeRep (Fingerprint 0 0) (mkTyCon3 "" "" "") []
+
+
+-- |Open and configure a serial port returning a standard Handle
+hOpenSerial :: FilePath
+           -> SerialPortSettings
+           -> IO Handle
+hOpenSerial dev settings = do
+  ser <- openSerial dev settings
+  h <- mkDuplexHandle ser dev Nothing noNewlineTranslation
+  hSetBuffering h NoBuffering
+  return h
 
 
 -- |Open and configure a serial port
 openSerial :: FilePath            -- ^ Serial port, such as @\/dev\/ttyS0@ or @\/dev\/ttyUSB0@
            -> SerialPortSettings
            -> IO SerialPort
 openSerial dev settings = do
-  fd' <- openFd dev ReadWrite Nothing defaultFileFlags { noctty = True, nonBlock = True }
+  fd' <- openFd dev ReadWrite Nothing defaultFileFlags { noctty = True }
   let serial_port = SerialPort fd' defaultSerialSettings
   return =<< setSerialSettings serial_port settings
 

System/Hardware/Serialport/Types.hs

@@ -1,13 +1,7 @@
-{-# LANGUAGE CPP #-}
 {-# OPTIONS_HADDOCK hide #-}
 module System.Hardware.Serialport.Types where
 
 import Data.Word
-#if defined(mingw32_HOST_OS)
-import System.Win32.Types (HANDLE)
-#else
-import System.Posix.Types (Fd)
-#endif
 
 
 -- | Supported baudrates
@@ -40,16 +34,6 @@ data SerialPortSettings = SerialPortSettings {
                   }
 
 
-data SerialPort = SerialPort {
-#if defined(mingw32_HOST_OS)
-                      handle :: HANDLE,
-#else
-                      fd :: Fd,
-#endif
-                      portSettings :: SerialPortSettings
-                  }
-
-
 -- | Most commonly used configuration
 --
 --  - 9600 baud

System/Hardware/Serialport/Windows.hs

@@ -10,6 +10,62 @@ import System.Win32.File
 import Foreign.Marshal.Alloc
 import System.Hardware.Serialport.Types
 import Control.Monad
+import GHC.IO.Handle
+import GHC.IO.Device
+import GHC.IO.BufferedIO
+import Data.Typeable
+import GHC.IO.Buffer
+
+
+data SerialPort = SerialPort {
+                      handle :: HANDLE,
+                      portSettings :: SerialPortSettings
+                  }
+
+
+instance RawIO SerialPort where
+  read (SerialPort h _) ptr n = return . fromIntegral =<< win32_ReadFile h ptr (fromIntegral n) Nothing
+  readNonBlocking _ _ _ = error "readNonBlocking not implemented"
+  write (SerialPort h _) ptr n = win32_WriteFile h ptr (fromIntegral n) Nothing >> return ()
+  writeNonBlocking _ _ _ = error "writenonblocking not implemented"
+
+
+instance IODevice SerialPort where
+  ready _ _ _ = return True
+  close = closeSerial
+  isTerminal _ = return False
+  isSeekable _ = return False
+  seek _ _ _ = return ()
+  tell _ = return 0
+  getSize _ = return 0
+  setSize _ _ = return ()
+  setEcho _ _ = return ()
+  getEcho _ = return False
+  setRaw _ _ = return ()
+  devType _ = return Stream
+
+
+instance BufferedIO SerialPort where
+  newBuffer _ = newByteBuffer 100
+  fillReadBuffer = readBuf
+  fillReadBuffer0 = readBufNonBlocking
+  flushWriteBuffer = writeBuf
+  flushWriteBuffer0 = writeBufNonBlocking
+
+
+instance Typeable SerialPort where
+  typeOf _ = mkTyConApp (mkTyCon "") []
+
+
+-- |Open and configure a serial port returning a standard Handle.
+hOpenSerial :: String
+           -> SerialPortSettings
+           -> IO Handle
+hOpenSerial dev settings = do
+  ser <- openSerial dev settings
+  h <- mkDuplexHandle ser dev Nothing noNewlineTranslation
+  hSetBuffering h NoBuffering
+  return h
 
 
 -- | Open and configure a serial port

serialport.cabal

@@ -1,5 +1,5 @@
 Name:           serialport
-Version:        0.4.4
+Version:        0.4.5
 Cabal-Version:  >= 1.6
 Build-Type:     Custom
 license:        BSD3