summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoeyHess <>2019-10-09 02:25:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-10-09 02:25:00 (GMT)
commit408e59ff6d9d87106ab07bdccf830270955fe786 (patch)
treeae8f0a416e83658d05bdc4638338924461b51bcf
parent3550fdff67876fc7cdc83d857ceb56131f766116 (diff)
version 1.1.1HEAD1.1.1master
-rw-r--r--CHANGELOG7
-rw-r--r--System/Modbus.hsc83
-rw-r--r--TODO3
-rw-r--r--libmodbus.cabal2
4 files changed, 72 insertions, 23 deletions
diff --git a/CHANGELOG b/CHANGELOG
index 2e33b2d..fb72abb 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,3 +1,10 @@
+haskell-libmodbus (1.1.1) unstable; urgency=medium
+
+ * Use modbus_strerror for better messages in exceptions.
+ * Add set_error_recovery.
+
+ -- Joey Hess <id@joeyh.name> Tue, 08 Oct 2019 21:20:18 -0400
+
haskell-libmodbus (1.1.0) unstable; urgency=medium
* Added a full working example of reading data from an epsolar charge
diff --git a/System/Modbus.hsc b/System/Modbus.hsc
index 0f57831..91324f6 100644
--- a/System/Modbus.hsc
+++ b/System/Modbus.hsc
@@ -23,7 +23,7 @@ module System.Modbus (
-- * Example
--
-- | This example reads some of the registers of an Epever solar
- -- charge controller. It shows how `Data.Binary` can be used
+ -- charge controller. It shows how the binary library can be used
-- to decode the modbus registers into a haskell data structure.
--
-- > import System.Modbus
@@ -98,6 +98,8 @@ module System.Modbus (
set_byte_timeout,
get_response_timeout,
set_response_timeout,
+ ErrorRecoveryMode(..),
+ set_error_recovery,
-- * Accessing registers
RegisterVector,
@@ -188,6 +190,9 @@ foreign import ccall unsafe "modbus.h modbus_get_response_timeout" modbus_get_re
foreign import ccall unsafe "modbus.h modbus_set_response_timeout" modbus_set_response_timeout
:: Ptr () -> Ptr Word32 -> Ptr Word32 -> IO Int
+foreign import ccall unsafe "modbus.h modbus_set_error_recovery" modbus_set_error_recovery
+ :: Ptr () -> Int -> IO Int
+
foreign import ccall unsafe "modbus.h modbus_read_registers" modbus_read_registers
:: Ptr () -> Int -> Int -> Ptr Word16 -> IO Int
@@ -215,6 +220,9 @@ foreign import ccall unsafe "modbus.h modbus_write_bits" modbus_write_bits
foreign import ccall unsafe "modbus.h modbus_write_bit" modbus_write_bit
:: Ptr () -> Int -> Int -> IO Int
+foreign import ccall unsafe "modbus.h modbus_strerror" modbus_strerror
+ :: Errno -> IO (Ptr CChar)
+
accessVector
:: Storable t
=> Context
@@ -227,7 +235,7 @@ accessVector h (Addr addr) v action actionname = withContext h $ \ctx -> do
let (fptr, nb) = VM.unsafeToForeignPtr0 v
r <- withForeignPtr fptr $ action ctx addr nb
if r == -1
- then throwErrno actionname
+ then throwErrnoModbus actionname
else if r /= nb
then ioError $ IOError Nothing OtherError
actionname "short read/write" Nothing Nothing
@@ -270,7 +278,7 @@ new_rtu f (Baud b) p (DataBits d) (StopBits s) = do
ctx <- withCString f $ \cf ->
modbus_new_rtu cf b pc d s
if ctx == nullPtr
- then throwErrno "modbus_new_rtu"
+ then throwErrnoModbus "modbus_new_rtu"
else mkContext ctx
where
pc = fromIntegral $ ord $ case p of
@@ -299,7 +307,7 @@ new_tcp ipaddr (Port port) = do
AnyAddress ->
modbus_new_tcp nullPtr port
if ctx == nullPtr
- then throwErrno "modbus_new_tcp"
+ then throwErrnoModbus "modbus_new_tcp"
else mkContext ctx
-- | Host name or IP address to connect to. In server mode, use AnyNode
@@ -326,7 +334,7 @@ new_tcp_pi node (Service service) = withCString service $ \cservice -> do
AnyNode ->
modbus_new_tcp_pi nullPtr cservice
if ctx == nullPtr
- then throwErrno "modbus_new_tcp_pi"
+ then throwErrnoModbus "modbus_new_tcp_pi"
else mkContext ctx
data SerialMode = RTU_RS232 | RTU_RS485
@@ -339,7 +347,7 @@ rtu_get_serial_mode h = withContext h $ \ctx -> do
then return RTU_RS232
else if r == #const (MODBUS_RTU_RS485)
then return RTU_RS485
- else throwErrno "modbus_rtu_get_serial_mode"
+ else throwErrnoModbus "modbus_rtu_get_serial_mode"
rtu_set_serial_mode :: Context -> SerialMode -> IO ()
rtu_set_serial_mode h m = withContext h $ \ctx -> do
@@ -348,7 +356,7 @@ rtu_set_serial_mode h m = withContext h $ \ctx -> do
RTU_RS485 -> #const (MODBUS_RTU_RS485)
if r == 0
then return ()
- else throwErrno "modbus_rtu_set_serial_mode"
+ else throwErrnoModbus "modbus_rtu_set_serial_mode"
data RTS = RTU_RTS_NONE | RTU_RTS_UP | RTU_RTS_DOWN
deriving (Show, Eq)
@@ -362,7 +370,7 @@ rtu_get_rts h = withContext h $ \ctx -> do
then return RTU_RTS_UP
else if r == #const (MODBUS_RTU_RTS_DOWN)
then return RTU_RTS_DOWN
- else throwErrno "modbus_rtu_get_serial_mode"
+ else throwErrnoModbus "modbus_rtu_get_serial_mode"
rtu_set_rts :: Context -> RTS -> IO ()
rtu_set_rts h m = withContext h $ \ctx -> do
@@ -372,21 +380,21 @@ rtu_set_rts h m = withContext h $ \ctx -> do
RTU_RTS_DOWN -> #const (MODBUS_RTU_RTS_DOWN)
if r == 0
then return ()
- else throwErrno "modbus_rtu_set_rts"
+ else throwErrnoModbus "modbus_rtu_set_rts"
rtu_get_rts_delay :: Context -> IO Int
rtu_get_rts_delay h = withContext h $ \ctx -> do
r <- modbus_rtu_get_rts_delay ctx
if r /= -1
then return r
- else throwErrno "modbus_rtu_get_rts_delay"
+ else throwErrnoModbus "modbus_rtu_get_rts_delay"
rtu_set_rts_delay :: Context -> Int -> IO ()
rtu_set_rts_delay h n = withContext h $ \ctx -> do
r <- modbus_rtu_set_rts_delay ctx n
if r == 0
then return ()
- else throwErrno "modbus_rtu_set_rts_delay"
+ else throwErrnoModbus "modbus_rtu_set_rts_delay"
-- | The address of a modbus device.
newtype DeviceAddress = DeviceAddress Int
@@ -402,14 +410,14 @@ set_slave h (DeviceAddress n) = withContext h $ \ctx -> do
r <- modbus_set_slave ctx n
if r == 0
then return ()
- else throwErrno "modbus_set_slave"
+ else throwErrnoModbus "modbus_set_slave"
connect :: Context -> IO ()
connect h = withContext h $ \ctx -> do
r <- modbus_connect ctx
if r == 0
then return ()
- else throwErrno "modbus_connect"
+ else throwErrnoModbus "modbus_connect"
set_debug :: Context -> Bool -> IO ()
set_debug h b = withContext h $ \ctx -> do
@@ -419,7 +427,7 @@ set_debug h b = withContext h $ \ctx -> do
else #const (FALSE)
if r == 0
then return ()
- else throwErrno "modbus_set_debug"
+ else throwErrnoModbus "modbus_set_debug"
data Timeout = Timeout
{ to_sec :: Word32
@@ -438,7 +446,7 @@ get_timeout action actionname h =
sec <- peek secp
usec <- peek usecp
return $ Timeout sec usec
- else throwErrno actionname
+ else throwErrnoModbus actionname
set_timeout :: (Ptr () -> Ptr Word32 -> Ptr Word32 -> IO Int) -> String -> Context -> Timeout -> IO ()
set_timeout action actionname h timeout =
@@ -450,7 +458,7 @@ set_timeout action actionname h timeout =
r <- action ctx secp usecp
if r == 0
then return ()
- else throwErrno actionname
+ else throwErrnoModbus actionname
get_byte_timeout :: Context -> IO Timeout
get_byte_timeout = get_timeout
@@ -472,6 +480,33 @@ set_response_timeout = set_timeout
modbus_set_response_timeout
"modbus_set_response_timeout"
+data ErrorRecoveryMode
+ = ErrorRecoveryNone
+ | ErrorRecoveryLink
+ -- ^ Reconnect after response timeout.
+ | ErrorRecoveryProtocol
+ -- ^ Clean up ongoing communication.
+ | ErrorRecoveryLinkProtocol
+ -- ^ Combine both.
+
+set_error_recovery :: Context -> ErrorRecoveryMode -> IO ()
+set_error_recovery h m =
+ withContext h $ \ctx -> do
+ r <- modbus_set_error_recovery ctx $ case m of
+ ErrorRecoveryNone ->
+ #const (MODBUS_ERROR_RECOVERY_NONE)
+ ErrorRecoveryLink ->
+ #const (MODBUS_ERROR_RECOVERY_LINK)
+ ErrorRecoveryProtocol ->
+ #const (MODBUS_ERROR_RECOVERY_PROTOCOL)
+ ErrorRecoveryLinkProtocol ->
+ #const (MODBUS_ERROR_RECOVERY_LINK)
+ .|.
+ #const (MODBUS_ERROR_RECOVERY_PROTOCOL)
+ if r == 0
+ then return ()
+ else throwErrnoModbus "modbus_set_error_recovery"
+
-- | An address on a modbus device.
newtype Addr = Addr Int
deriving (Show, Eq)
@@ -554,7 +589,7 @@ write_register :: Context -> Addr -> Word16 -> IO ()
write_register h (Addr addr) val = withContext h $ \ctx -> do
r <- modbus_write_register ctx addr val
if r == -1
- then throwErrno "modbus_write_register"
+ then throwErrnoModbus "modbus_write_register"
else return ()
write_and_read_registers
@@ -578,7 +613,7 @@ write_and_read_registers h (Addr write_addr) write_v (Addr read_addr) read_v =
write_addr write_nb write_ptr
read_addr read_nb read_ptr
if r == -1
- then throwErrno actionname
+ then throwErrnoModbus actionname
else if r /= read_nb
then ioError $ IOError Nothing OtherError
actionname "short read" Nothing Nothing
@@ -655,5 +690,15 @@ write_bit :: Context -> Addr -> Bit -> IO ()
write_bit h (Addr addr) val = withContext h $ \ctx -> do
r <- modbus_write_bit ctx addr (fromIntegral val)
if r == -1
- then throwErrno "modbus_write_bit"
+ then throwErrnoModbus "modbus_write_bit"
else return ()
+
+-- libmodbus extends errno with its own error codes,
+-- and modbus_strerror can generate more useful error messages.
+throwErrnoModbus :: String -> IO a
+throwErrnoModbus loc = do
+ errno@(Errno n) <- getErrno
+ -- This has a complicated mapping from standard errno to error type.
+ let herr = errnoToIOError loc errno Nothing Nothing
+ str <- modbus_strerror errno >>= peekCString
+ ioError $ IOError Nothing (ioe_type herr) loc str (Just n) Nothing
diff --git a/TODO b/TODO
index d213bd9..742952d 100644
--- a/TODO
+++ b/TODO
@@ -1,6 +1,3 @@
-* modbus_set_error_recovery binding
-* Use modbus_strerror when throwing exceptions to generate better error
- messages.
* Perhaps some of the float conversion functions and other data
manipulation stuff. Although it's not hard to write that in pure haskell
as needed.
diff --git a/libmodbus.cabal b/libmodbus.cabal
index 576dddf..65a8811 100644
--- a/libmodbus.cabal
+++ b/libmodbus.cabal
@@ -1,5 +1,5 @@
Name: libmodbus
-Version: 1.1.0
+Version: 1.1.1
Cabal-Version: >= 1.8
License: BSD2
Maintainer: Joey Hess <id@joeyh.name>