libmodbus 1.1.0 → 1.1.1

raw patch · 4 files changed

+72/−23 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +7/−0
• System/Modbus.hsc +64/−19
• TODO +0/−3
• libmodbus.cabal +1/−1

@@ -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

@@ -23,7 +23,7 @@ 	-- * 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 @@ 	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_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_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 @@ 	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 @@ 	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 @@ 		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 @@ 		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 @@ 		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_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 @@ 			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_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 @@ 	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 @@ 			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 @@ 						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 @@ 				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 @@ 	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 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_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 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

@@ -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.

@@ -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>