hs-tango (empty) → 1.0.0
raw patch · 12 files changed
+5873/−0 lines, 12 filesdep +basedep +derive-storabledep +hs-tango
Dependencies added: base, derive-storable, hs-tango, text, unliftio
Files
- Changelog +4/−0
- LICENSE +19/−0
- README.org +109/−0
- app/ReadTestDevice.hs +127/−0
- c_tango/src/c_tango.h +547/−0
- c_tango/src/c_tango_attribute.cpp +600/−0
- c_tango/src/c_tango_command.cpp +569/−0
- c_tango/src/c_tango_dbase.cpp +678/−0
- c_tango/src/c_tango_proxy.cpp +208/−0
- hs-tango.cabal +79/−0
- lib/Tango/Client.hs +1800/−0
- lib/Tango/Raw/Common.hsc +1133/−0
+ Changelog view
@@ -0,0 +1,4 @@+2024-10-24 Philipp Middendorf <philipp.middendorf@cfel.de>++ * Initial release at 1.0.+
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2024 Deutsches Elektronen-Synchrotron (DESY)++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.org view
@@ -0,0 +1,109 @@+* hs-tango++[[https://www.gnu.org/licenses/gpl-3.0][https://img.shields.io/badge/License-GPLv3-blue.svg]]+[[Hackage][https://img.shields.io/hackage/v/hs-tango.svg]]+[[CI][https://github.com/pmiddend/hs-tango/actions/workflows/build-with-ubuntu.yaml/badge.svg]]+++** How to install+*** General instructions+A simple =cabal install hs-tango= should suffice to build and install the library, as you would for any other Haskell library. Of course, you need to have the development packages for Tango (namely "cpptango") installed.++The [[https://tango-controls.readthedocs.io/en/latest/installation/tango-on-linux.html#debian-ubuntu][Tango documentation]] has instructions on how to install Tango for different operating systems. On *Debian* and *Ubuntu*, for example, you can do =apt install libtango-dev=.+*** With Nix++If you're using the Nix package manager, you have to enable flakes, and then use the accompanying =flake.nix=. To get Tango, it uses the [[https://gitlab.desy.de/cfel-sc-public/tango-flake][tango-flake]] from your truly. You can simply clone the repository, do =nix develop=, and then =cabal build=.+** Usage+*** Client, reading attributes++There is haddock documentation available. But just to illustrate how to use the library, here's a little client example:++#+begin_src haskell+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Tango.Client(+ parseTangoUrl,+ withDeviceProxy,+ getTimeout,+ AttributeName(..),+ readBoolAttribute,+ readBoolSpectrumAttribute+)++main :: IO ()+main =+ case parseTangoUrl "sys/tg_test/1" of+ Left e -> error "couldn't resolve tango URL"+ Right deviceAddress -> withDeviceProxy deviceAddress $ \proxy -> do+ timeout <- getTimeout proxy+ putStrLn $ "proxy timeout is " <> show timeout++ booleanResult <- readBoolAttribute proxy (AttributeName "boolean_scalar")+ putStrLn $ "boolean_scalar is " <> show booleanResult++ booleanResultBetter <- readBoolAttribute proxy (AttributeName "boolean_scalar")+ putStrLn $ "boolean_scalar better is " <> show booleanResultBetter++ booleanSpectrumResult <- readBoolSpectrumAttribute proxy (AttributeName "boolean_spectrum")+ putStrLn $ "boolean_spectrum is " <> show booleanSpectrumResult+#+end_src+*** Client, subscribing to events++In this example, we are subscribing to changes in the attribute =boolean_scalar= and waiting for two changes (the =forM_= loop).++#+begin_src haskell+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import Control.Concurrent (newChan, readChan, writeChan)+import Control.Monad (forM_)+import Control.Monad.IO.Class (liftIO)+import Data.Int (Int16)+import Data.Text.IO qualified as TIO+import Tango.Client++main =+ case parseTangoUrl "sys/tg_test/1" of+ Left e -> error "couldn't resolve tango URL"+ Right deviceAddress -> withDeviceProxy deviceAddress \proxy -> do+ timeout <- getTimeout proxy++ chan <- newChan++ let attributeName = AttributeName "boolean_scalar"+ eventCallback attribute bool = liftIO do+ boolValue <- readBoolAttribute proxy attributeName+ putStrLn $ "got a change: " <> show boolValue+ writeChan chan True++ pollAttribute proxy attributeName (Milliseconds 2000)++ withSubscribedEvent proxy attributeName ChangeEvent False eventCallback do+ forM_ [0 .. 2] \_ -> do+ putStrLn "waiting for change"+ _ <- readChan chan+ putStrLn "received change"+#+end_src++** What's missing++- Server: Everything+- Client+ + Setting advanced attribute properties, specifically event-related ones like =rel_change= and the period for periodic events. This is no technical difficulty, you just have to write the code.+ + Commands returning or receiving an =UInt32=. I'm not sure how to handle this, since tango has no such data type.+ + In event callbacks, it would be good to transport more information like the list of errors, not just a boolean (see cppTango's =event.h=)+ + Dynamic attribute properties such as the "quality" (currently we're only exporting read/write value)+** Rationale for the used dependencies++- =derive-storable= so that we can just declare data types as records, and have C =Storable= instances generated+- =text= to replace =String= for textual data (=ByteString= might have been an option, we haven't decided yet)+- =unliftio= to have the opssibility to have code running in =MonadIO=+** Interesting links/documentation++- [[https://www.esrf.fr/computing/cs/tango/tango_doc/kernel_doc/cpp_doc/classTango_1_1DeviceProxy.html][DeviceProxy C++ API reference]]
+ app/ReadTestDevice.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import Control.Concurrent (newChan, readChan, writeChan)+import Control.Monad (forM_)+import Control.Monad.IO.Class (liftIO)+import Data.Int (Int16)+import Data.Text.IO qualified as TIO+import Tango.Client++data ScalarEnum = Label0 | Label1 | Label2 deriving (Enum, Show)++main =+ case parseTangoUrl "sys/tg_test/1" of+ Left e -> error "couldn't resolve tango URL"+ Right deviceAddress -> withDeviceProxy deviceAddress \proxy -> do+ aconfig <- getConfigForAttribute proxy (AttributeName "boolean_scalar")+ print aconfig++main3 =+ case parseTangoUrl "sys/tg_test/1" of+ Left e -> error "couldn't resolve tango URL"+ Right deviceAddress -> withDeviceProxy deviceAddress \proxy -> do+ timeout <- getTimeout proxy++ chan <- newChan++ let attributeName = AttributeName "boolean_scalar"+ eventCallback attribute bool = liftIO do+ boolValue <- readBoolAttribute proxy attributeName+ putStrLn $ "got a change: " <> show boolValue+ writeChan chan True++ pollAttribute proxy attributeName (Milliseconds 2000)++ withSubscribedEvent proxy attributeName ChangeEvent False eventCallback do+ forM_ [0 .. 2] \_ -> do+ putStrLn "waiting for change"+ _ <- readChan chan+ putStrLn "received change"++main2 =+ case parseTangoUrl "sys/tg_test/1" of+ Left e -> error "couldn't resolve tango URL"+ Right deviceAddress -> withDeviceProxy deviceAddress \proxy -> do+ timeout <- getTimeout proxy++ putStrLn $ "proxy timeout is " <> show timeout++ booleanResultBetter <- readBoolAttribute proxy (AttributeName "boolean_scalar")+ putStrLn $ "boolean_scalar better is " <> show booleanResultBetter++ -- booleanSpectrumResult <- readBoolSpectrumAttribute proxy (AttributeName "boolean_spectrum")+ -- putStrLn $ "boolean_spectrum is " <> show booleanSpectrumResult+ booleanSpectrumResultBetter <- readBoolSpectrumAttribute proxy (AttributeName "boolean_spectrum")+ putStrLn $ "boolean_spectrum is " <> show booleanSpectrumResultBetter++ -- booleanImageResult <- readBoolImageAttribute proxy (AttributeName "boolean_image")+ -- putStrLn $ "boolean_image is " <> show booleanImageResult++ enumResult :: TangoValue Int16 <- readEnumAttribute proxy (AttributeName "enum_scalar")+ putStrLn $ "enum_scalar is " <> show enumResult++ integralResult :: TangoValue Int <- readIntegralAttribute proxy (AttributeName "long_scalar")+ putStrLn $ "long_scalar as integral attribute is " <> show integralResult++ attributeList <- getConfigsForAttributes proxy [AttributeName "enum_scalar_ro"]+ putStrLn $ "attribute description for \"enum_scalar_ro\": " <> show attributeList++ (TangoValue enumResultRead' enumResultWrite') <- readEnumAttribute proxy (AttributeName "enum_scalar")+ putStrLn $ "enum_scalar (as Haskell enum) is " <> show (enumResultRead' :: ScalarEnum)++ stringScalar <- readStringAttribute proxy (AttributeName "string_scalar")+ TIO.putStrLn $ "string scalar: " <> tangoValueRead stringScalar++ floatResultAsReal <- readRealAttribute proxy (AttributeName "float_scalar")+ doubleResultAsReal <- readRealAttribute proxy (AttributeName "double_scalar")++ putStrLn $ "float result " <> show floatResultAsReal <> ", double result: " <> show doubleResultAsReal++ writeLong64Attribute proxy (AttributeName "long64_scalar") 1337++ result <- commandInOutGeneric proxy (CommandName "DevVoid") CommandVoid+ putStrLn $ "result of DevVoid command: " <> show result++ result' <- commandInOutGeneric proxy (CommandName "DevBoolean") (CommandBool True)+ putStrLn $ "result of DevBoolean True command: " <> show result'++ result'' <- commandInOutGeneric proxy (CommandName "DevDouble") (CommandDouble 3.5)+ putStrLn $ "result of DevDouble 3.5 command: " <> show result''++ result''' <- commandInOutGeneric proxy (CommandName "DevVarDoubleArray") (CommandListDouble [3.5, 4.0])+ putStrLn $ "result of DevVarDoubleArray [3.5, 4.0] command: " <> show result'''++ putDeviceProperties proxy [(PropertyName "testproperty", ["x", "y"])]++ prop <- getDeviceProperties proxy [PropertyName "testproperty"]+ putStrLn $ "properties " <> show prop++ commandList <- commandListQuery proxy++ putStrLn "got the following commands:"+ forM_ commandList \commandInfo ->+ print commandInfo++ singleCommand <- commandQuery proxy (CommandName "DevString")++ attributeNames <- getAttributeNames proxy+ putStrLn "got the following attribute names:"+ forM_ attributeNames \attributeName ->+ print attributeName++ print singleCommand++ withDatabaseProxy \dbProxy -> do+ byName <- databaseSearchByDeviceName dbProxy "*"+ putStrLn $ "device sys/tg_test/1: " <> show byName++ byClass <- databaseSearchByClass dbProxy "TangoTest"+ putStrLn $ "device TangoTest: " <> show byClass++ objectsByName <- databaseSearchObjectsByName dbProxy "*"+ putStrLn $ "objects *: " <> show objectsByName
+ c_tango/src/c_tango.h view
@@ -0,0 +1,547 @@+/******************************************************************************+ *+ * File: c_tango.h+ * Project: C client interface to Tango+ * Description: Definitions necessay to write Tango clients in C+ * Original: November 2007+ * Author: jensmeyer+ *+ * Adapted for tango-rs by Georg Brandl, 2015.+ *+ ******************************************************************************/++#ifndef C_TANGO_H+#define C_TANGO_H++#include <stdint.h>+#include <sys/time.h>+#ifndef __cplusplus+#include <stdbool.h>+#endif++#ifdef CABAL_BINDGEN+typedef int32_t TangoDevLong;+typedef uint32_t TangoDevULong;+typedef int64_t TangoDevLong64;+typedef uint64_t TangoDevULong64;+#else+#include <tango/tango.h>+typedef Tango::DevLong TangoDevLong;+typedef Tango::DevULong TangoDevULong;+typedef Tango::DevLong64 TangoDevLong64;+typedef Tango::DevULong64 TangoDevULong64;+#endif++#define INIT_SEQ(seq, type, size) \+ (seq).length = size; \+ (seq).sequence = new type[size]++typedef enum+{+ CHANGE_EVENT = 0, ///< Change event+ QUALITY_EVENT, ///< Quality change event (deprecated - do not use)+ PERIODIC_EVENT, ///< Periodic event+ ARCHIVE_EVENT, ///< Archive event+ USER_EVENT, ///< User event+ ATTR_CONF_EVENT, ///< Attribute configuration change event+ DATA_READY_EVENT, ///< Data ready event+ INTERFACE_CHANGE_EVENT, ///< Device interface change event+ PIPE_EVENT, ///< Device pipe event+ numEventType+} TangoEventType;++typedef enum+{+ DEV_VOID = 0,+ DEV_BOOLEAN,+ DEV_SHORT,+ DEV_LONG,+ DEV_FLOAT,+ DEV_DOUBLE,+ DEV_USHORT,+ DEV_ULONG,+ DEV_STRING,+ DEVVAR_CHARARRAY,+ DEVVAR_SHORTARRAY,+ DEVVAR_LONGARRAY,+ DEVVAR_FLOATARRAY,+ DEVVAR_DOUBLEARRAY,+ DEVVAR_USHORTARRAY,+ DEVVAR_ULONGARRAY,+ DEVVAR_STRINGARRAY,+ DEVVAR_LONGSTRINGARRAY,+ DEVVAR_DOUBLESTRINGARRAY,+ DEV_STATE,+ CONST_DEV_STRING,+ DEVVAR_BOOLEANARRAY,+ DEV_UCHAR,+ DEV_LONG64,+ DEV_ULONG64,+ DEVVAR_LONG64ARRAY,+ DEVVAR_ULONG64ARRAY,+ DEV_INT,+ DEV_ENCODED,+ DEV_ENUM,+ DEVVAR_STATEARRAY = 31,+ DEVVAR_ENCODEDARRAY = 32+} TangoDataType;++typedef enum+{+ NOT_KNOWN,+ NONE,+ MEMORIZED,+ MEMORIZED_WRITE_INIT+} TangoAttrMemorizedType;++typedef enum+{+ ON,+ OFF,+ CLOSE,+ OPEN,+ INSERT,+ EXTRACT,+ MOVING,+ STANDBY,+ FAULT,+ INIT,+ RUNNING,+ ALARM,+ DISABLE,+ UNKNOWN+} TangoDevState;++typedef enum+{+ ATTR_VALID,+ ATTR_INVALID,+ ATTR_ALARM,+ ATTR_CHANGING,+ ATTR_WARNING+} AttrQuality;++typedef enum+{+ READ,+ READ_WITH_WRITE,+ WRITE,+ READ_WRITE+} AttrWriteType;++typedef enum+{+ SCALAR,+ SPECTRUM,+ IMAGE+} AttrDataFormat;++typedef enum+{+ OPERATOR,+ EXPERT+} DispLevel;++typedef enum+{+ WARN,+ ERR,+ PANIC+} ErrSeverity;++typedef enum+{+ DEV,+ CACHE,+ CACHE_DEV+} DevSource;++typedef struct+{+ char *encoded_format;+ uint32_t encoded_length;+ uint8_t *encoded_data;+} TangoDevEncoded;++typedef struct+{+ uint32_t length;+ bool *sequence;+} VarBoolArray;++typedef struct+{+ uint32_t length;+ uint8_t *sequence;+} VarCharArray;++typedef struct+{+ uint32_t length;+ int16_t *sequence;+} VarShortArray;++typedef struct+{+ uint32_t length;+ uint16_t *sequence;+} VarUShortArray;++typedef struct+{+ uint32_t length;+ TangoDevLong *sequence;+} VarLongArray;++typedef struct+{+ uint32_t length;+ TangoDevULong *sequence;+} VarULongArray;++typedef struct+{+ uint32_t length;+ TangoDevLong64 *sequence;+} VarLong64Array;++typedef struct+{+ uint32_t length;+ TangoDevULong64 *sequence;+} VarULong64Array;++typedef struct+{+ uint32_t length;+ float *sequence;+} VarFloatArray;++typedef struct+{+ uint32_t length;+ double *sequence;+} VarDoubleArray;++typedef struct+{+ uint32_t length;+ char **sequence;+} VarStringArray;++typedef struct+{+ uint32_t length;+ TangoDevState *sequence;+} VarStateArray;++typedef struct+{+ uint32_t length;+ TangoDevEncoded *sequence;+} VarEncodedArray;++typedef struct+{+ uint32_t long_length;+ TangoDevLong *long_sequence;+ uint32_t string_length;+ char **string_sequence;+} VarLongStringArray;++typedef struct+{+ uint32_t double_length;+ double *double_sequence;+ uint32_t string_length;+ char **string_sequence;+} VarDoubleStringArray;++typedef union+{+ VarBoolArray bool_arr;+ VarCharArray char_arr;+ VarShortArray short_arr;+ VarUShortArray ushort_arr;+ VarLongArray long_arr;+ VarULongArray ulong_arr;+ VarLong64Array long64_arr;+ VarULong64Array ulong64_arr;+ VarFloatArray float_arr;+ VarDoubleArray double_arr;+ VarStringArray string_arr;+ VarStateArray state_arr;+ VarEncodedArray encoded_arr;+} TangoAttributeData;++typedef union+{+ bool bool_val;+ int16_t short_val;+ uint16_t ushort_val;+ int32_t long_val;+ uint32_t ulong_val;+ float float_val;+ double double_val;+ char *string_val;+ TangoDevState state_val;+ TangoDevLong64 long64_val;+ TangoDevULong64 ulong64_val;+ VarBoolArray bool_arr;+ VarCharArray char_arr;+ VarShortArray short_arr;+ VarUShortArray ushort_arr;+ VarLongArray long_arr;+ VarULongArray ulong_arr;+ VarLong64Array long64_arr;+ VarULong64Array ulong64_arr;+ VarFloatArray float_arr;+ VarDoubleArray double_arr;+ VarStringArray string_arr;+ VarStateArray state_arr;+ TangoDevEncoded encoded_val;+ VarLongStringArray long_string_arr;+ VarDoubleStringArray double_string_arr;+} TangoCommandData;++typedef union+{+ bool bool_val;+ uint8_t char_val;+ int16_t short_val;+ uint16_t ushort_val;+ int32_t long_val;+ uint32_t ulong_val;+ float float_val;+ double double_val;+ char *string_val;+ TangoDevLong64 long64_val;+ TangoDevULong64 ulong64_val;++ VarShortArray short_arr;+ VarUShortArray ushort_arr;+ VarLongArray long_arr;+ VarULongArray ulong_arr;+ VarLong64Array long64_arr;+ VarULong64Array ulong64_arr;+ VarFloatArray float_arr;+ VarDoubleArray double_arr;+ VarStringArray string_arr;+} TangoPropertyData;++typedef struct+{+ TangoDataType arg_type;+ TangoCommandData cmd_data;+} CommandData;++typedef struct+{+ TangoDataType data_type;+ TangoAttributeData attr_data;+ AttrDataFormat data_format;+ AttrQuality quality;+ long nb_read;+ char *name;+ int32_t dim_x;+ int32_t dim_y;+ struct timeval time_stamp;+} AttributeData;++typedef struct+{+ uint32_t length;+ AttributeData *sequence;+} AttributeDataList;++typedef struct+{+ char *desc;+ char *reason;+ char *origin;+ ErrSeverity severity;+} DevFailed;++typedef struct+{+ uint32_t length;+ DevFailed *sequence;+} ErrorStack;++typedef struct+{+ char *cmd_name;+ int32_t cmd_tag;+ int32_t in_type;+ int32_t out_type;+ char *in_type_desc;+ char *out_type_desc;+ DispLevel disp_level;+} CommandInfo;++typedef struct+{+ uint32_t length;+ CommandInfo *sequence;+} CommandInfoList;++typedef struct+{+ char *name;+ AttrWriteType writable;+ AttrDataFormat data_format;+ TangoDataType data_type;+ int32_t max_dim_x;+ int32_t max_dim_y;+ char *description;+ char *label;+ char *unit;+ char *standard_unit;+ char *display_unit;+ char *format;+ char *min_value;+ char *max_value;+ char *min_alarm;+ char *max_alarm;+ char *writable_attr_name;+ DispLevel disp_level;+ char **enum_labels;+ uint16_t enum_labels_count;+ char *root_attr_name;+ TangoAttrMemorizedType memorized;+} AttributeInfo;++typedef struct+{+ uint32_t length;+ AttributeInfo *sequence;+} AttributeInfoList;++typedef struct+{+ char *property_name;+ TangoDataType data_type;+ TangoPropertyData prop_data;+ bool is_empty;+ bool wrong_data_type;+} DbDatum;++typedef struct+{+ uint32_t length;+ DbDatum *sequence;+} DbData;++#ifdef __cplusplus+extern "C"+{+#endif++ ErrorStack *tango_create_device_proxy(char *dev_name, void **proxy);+ ErrorStack *tango_delete_device_proxy(void *proxy);+ ErrorStack *tango_set_timeout_millis(void *proxy, int millis);+ ErrorStack *tango_get_timeout_millis(void *proxy, int *millis);+ ErrorStack *tango_set_source(void *proxy, DevSource source);+ ErrorStack *tango_get_source(void *proxy, DevSource *source);+ ErrorStack *tango_lock(void *proxy);+ ErrorStack *tango_unlock(void *proxy);+ ErrorStack *tango_is_locked(void *proxy, bool *is_locked);+ ErrorStack *tango_is_locked_by_me(void *proxy, bool *is_locked_by_me);+ ErrorStack *tango_locking_status(void *proxy, char **lock_status);++ ErrorStack *tango_command_query(void *proxy, char *cmd_name, CommandInfo *cmd_info);+ ErrorStack *tango_command_list_query(void *proxy, CommandInfoList *cmd_info_list);+ ErrorStack *+ tango_command_inout(void *proxy, char *cmd_name, CommandData *argin, CommandData *argout);+ void tango_free_CommandData(CommandData *command_data);+ void tango_free_CommandInfo(CommandInfo *command_info);+ void tango_free_CommandInfoList(CommandInfoList *command_info_list);++ ErrorStack *tango_get_attribute_list(void *proxy, VarStringArray *attr_names);+ ErrorStack *tango_get_attribute_config(+ void *proxy, VarStringArray *attr_names, AttributeInfoList *attr_info_list);+ ErrorStack *tango_attribute_list_query(void *proxy, AttributeInfoList *attr_info_list);+ ErrorStack *tango_read_attribute(void *proxy, char *attr_name, AttributeData *argout);+ ErrorStack *tango_write_attribute(void *proxy, AttributeData *argin);+ ErrorStack *+ tango_read_attributes(void *proxy, VarStringArray *attr_names, AttributeDataList *argout);+ ErrorStack *tango_write_attributes(void *proxy, AttributeDataList *argin);+ void tango_free_AttributeData(AttributeData *attribute_data);+ void tango_free_AttributeDataList(AttributeDataList *attribute_data_list);+ void tango_free_VarStringArray(VarStringArray *string_arr);+ void tango_free_AttributeInfoList(AttributeInfoList *attribute_info_list);++ void tango_free_ErrorStack(ErrorStack *error_stack);++ ErrorStack *tango_create_database_proxy(void **db_proxy);+ ErrorStack *tango_delete_database_proxy(void *db_proxy);+ ErrorStack *tango_get_device_exported(void *db_proxy, char *name_filter, DbDatum *dev_list);+ ErrorStack *+ tango_get_device_exported_for_class(void *db_proxy, char *class_name, DbDatum *dev_list);+ ErrorStack *tango_get_object_list(void *db_proxy, char *name_filter, DbDatum *obj_list);+ ErrorStack *tango_get_object_property_list(+ void *db_proxy, char *obj_name, char *name_filter, DbDatum *prop_list);+ ErrorStack *tango_get_property(void *db_proxy, char *obj_name, DbData *prop_list);+ ErrorStack *tango_put_property(void *db_proxy, char *obj_name, DbData *prop_list);+ ErrorStack *tango_delete_property(void *db_proxy, char *obj_name, DbData *prop_list);+ ErrorStack *tango_get_device_property(void *dev_proxy, DbData *prop_list);+ ErrorStack *tango_put_device_property(void *dev_proxy, DbData *prop_list);+ ErrorStack *tango_delete_device_property(void *dev_proxy, DbData *prop_list);+ void tango_free_DbDatum(DbDatum *db_datum);+ void tango_free_DbData(DbData *db_data);+ ErrorStack *tango_poll_command(void *db_proxy, char const *cmd_name, int polling_period);+ ErrorStack *tango_poll_attribute(void *db_proxy, char const *att_name, int polling_period);+ ErrorStack *tango_stop_poll_command(void *db_proxy, char const *cmd_name);+ ErrorStack *tango_stop_poll_attribute(void *db_proxy, char const *cmd_name);++ // Deliberately left out the value here, it's too complicated to implement for now+ void *tango_create_event_callback(void (*)(void *, char const *, bool));+ void tango_free_event_callback(void *);+ int tango_subscribe_event(+ void *dev_proxy, char const *attribute, TangoEventType, void *event_callback, bool);+ void tango_unsubscribe_event(void *dev_proxy, int event_id);++ typedef void *device_instance_ptr;++ typedef struct+ {+ char const *attribute_name;+ TangoDataType data_type;+ AttrWriteType write_type;+ void (*set_callback)(device_instance_ptr, void *);+ void (*get_callback)(device_instance_ptr, void *);+ } AttributeDefinition;++ typedef struct+ {+ char const *command_name;+ TangoDataType in_type;+ TangoDataType out_type;+ void *(*execute_callback)(device_instance_ptr, void *);+ } CommandDefinition;++ void tango_server_add_attribute_definition(AttributeDefinition *);+ void tango_server_add_command_definition(CommandDefinition *);+ int tango_server_init(+ int argc,+ char *argv[],+ void (*global_finalizer_callback)(void *),+ char *initial_status,+ int initial_state,+ void (*device_init_callback)(device_instance_ptr));+ void tango_server_set_status(device_instance_ptr, char *);+ void tango_server_set_state(device_instance_ptr, int);+ void tango_server_start();+ void tango_server_store_user_data(device_instance_ptr, void *);+ void *tango_server_get_user_data(device_instance_ptr);++ void tango_server_add_property(char *);+ char const *tango_server_read_property(device_instance_ptr, char *);++ void tango_throw_exception(char *);++#ifdef __cplusplus+} /* extern "C" */+#endif++#endif /* C_TANGO_H */
+ c_tango/src/c_tango_attribute.cpp view
@@ -0,0 +1,600 @@+/******************************************************************************+ *+ * File: c_tango_attribute.c+ * Project: C/Rust client interface to Tango+ * Description: Interface functions to access Tango attributes+ * Original: November 2007+ * Author: jensmeyer+ *+ * Adapted for tango-rs by Georg Brandl, 2015.+ *+ ******************************************************************************/++#include "c_tango.h"+#include <iostream>++ErrorStack *tango_translate_exception(Tango::DevFailed &tango_exception);+static void convert_attribute_reading(Tango::DeviceAttribute &devattr, AttributeData *argout);+static void convert_attribute_writing(AttributeData *argin, Tango::DeviceAttribute &devattr);+static void convert_attr_query(Tango::AttributeInfoEx &tango_attr_info, AttributeInfo *attr_info);++ErrorStack *+tango_read_attributes(void *proxy, VarStringArray *attr_names, AttributeDataList *argout)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;+ std::vector<Tango::DeviceAttribute> *devattr_list = 0;++ // copy the attribute names to a vector of string+ std::vector<std::string> names;+ for (uint32_t i = 0; i < attr_names->length; i++)+ {+ names.push_back(attr_names->sequence[i]);+ }++ try+ {+ devattr_list = dev->read_attributes(names);++ // allocate the AttributeDataList for the number of attributes returned+ INIT_SEQ(*argout, AttributeData, devattr_list->size());++ // loop over all returned attributes and convert the data+ for (uint32_t i = 0; i < devattr_list->size(); i++)+ {+ if ((*devattr_list)[i].has_failed())+ throw Tango::DevFailed((*devattr_list)[i].get_err_stack());+ convert_attribute_reading((*devattr_list)[i], &argout->sequence[i]);+ }++ // the memory is copied, we can now free the returned data+ delete devattr_list;+ }+ catch (Tango::DevFailed &tango_exception)+ {+ if (devattr_list)+ delete devattr_list;+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_read_attribute(void *proxy, char *attr_name, AttributeData *argout)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;+ Tango::DeviceAttribute devattr;++ try+ {+ devattr = dev->read_attribute(attr_name);+ if (devattr.has_failed())+ throw Tango::DevFailed(devattr.get_err_stack());+ convert_attribute_reading(devattr, argout);+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_write_attributes(void *proxy, AttributeDataList *argin)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;+ std::vector<Tango::DeviceAttribute> devattr_list(argin->length);++ try+ {+ for (uint32_t i = 0; i < argin->length; i++)+ {+ convert_attribute_writing(&argin->sequence[i], devattr_list[i]);+ }+ dev->write_attributes(devattr_list);+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_write_attribute(void *proxy, AttributeData *argin)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;+ Tango::DeviceAttribute devattr;++ try+ {+ convert_attribute_writing(argin, devattr);+ dev->write_attribute(devattr);+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++void tango_free_AttributeData(AttributeData *attribute_data)+{+ free(attribute_data->name); // from strdup++#define DELETE_SEQ(member) \+ if (attribute_data->attr_data.member.sequence) \+ delete[] attribute_data->attr_data.member.sequence; \+ break++ switch (attribute_data->data_type)+ {+ case DEV_BOOLEAN:+ DELETE_SEQ(bool_arr);+ case DEV_UCHAR:+ DELETE_SEQ(char_arr);+ case DEV_SHORT:+ DELETE_SEQ(short_arr);+ case DEV_USHORT:+ DELETE_SEQ(ushort_arr);+ case DEV_LONG:+ DELETE_SEQ(long_arr);+ case DEV_ULONG:+ DELETE_SEQ(ulong_arr);+ case DEV_LONG64:+ DELETE_SEQ(long64_arr);+ case DEV_ULONG64:+ DELETE_SEQ(ulong64_arr);+ case DEV_FLOAT:+ DELETE_SEQ(float_arr);+ case DEV_DOUBLE:+ DELETE_SEQ(double_arr);+ case DEV_STATE:+ DELETE_SEQ(state_arr);++ case DEV_STRING:+ for (uint32_t i = 0; i < attribute_data->attr_data.string_arr.length; i++)+ {+ free(attribute_data->attr_data.string_arr.sequence[i]); // from strdup+ }+ DELETE_SEQ(string_arr);++ case DEV_ENCODED:+ for (uint32_t i = 0; i < attribute_data->attr_data.encoded_arr.length; i++)+ {+ free(attribute_data->attr_data.encoded_arr.sequence[i].encoded_format); // from strdup+ delete[] attribute_data->attr_data.encoded_arr.sequence[i].encoded_data;+ }+ DELETE_SEQ(encoded_arr);++ default:+ break;+ }+}++void tango_free_AttributeDataList(AttributeDataList *attribute_data_list)+{+ for (uint32_t i = 0; i < attribute_data_list->length; i++)+ {+ tango_free_AttributeData(&attribute_data_list->sequence[i]);+ }+ delete[] attribute_data_list->sequence;+}++ErrorStack *tango_get_attribute_list(void *proxy, VarStringArray *attr_names)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;+ std::vector<std::string> *attr_list = 0;++ try+ {+ attr_list = dev->get_attribute_list();+ int nb_data = attr_list->size();++ // allocate sequence+ INIT_SEQ(*attr_names, char *, nb_data);++ // allocate strings and copy data+ for (int i = 0; i < nb_data; i++)+ {+ attr_names->sequence[i] = strdup((*attr_list)[i].c_str());+ }+ delete attr_list;+ }+ catch (Tango::DevFailed &tango_exception)+ {+ if (attr_list)+ delete attr_list;+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_get_attribute_config(+ void *proxy, VarStringArray *attr_names, AttributeInfoList *attr_info_list)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;+ std::vector<Tango::AttributeInfoEx> *tango_attr_info_list = 0;++ // copy the attribute names to a vector of string+ std::vector<std::string> names;+ for (uint32_t i = 0; i < attr_names->length; i++)+ {+ names.push_back(attr_names->sequence[i]);+ }++ try+ {+ tango_attr_info_list = dev->get_attribute_config_ex(names);++ // allocate the AttributeInfoList for the number of attributes returned+ INIT_SEQ(*attr_info_list, AttributeInfo, tango_attr_info_list->size());++ // loop over all returned attributes and convert the data+ for (uint32_t i = 0; i < tango_attr_info_list->size(); i++)+ {+ convert_attr_query((*tango_attr_info_list)[i], &attr_info_list->sequence[i]);+ }+ delete tango_attr_info_list;+ }+ catch (Tango::DevFailed &tango_exception)+ {+ if (tango_attr_info_list)+ delete tango_attr_info_list;+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_attribute_list_query(void *proxy, AttributeInfoList *attr_info_list)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;+ std::vector<Tango::AttributeInfoEx> *tango_attr_info_list = 0;++ try+ {+ tango_attr_info_list = dev->attribute_list_query_ex();++ // allocate the AttributeInfoList for the number of attributes returned+ INIT_SEQ(*attr_info_list, AttributeInfo, tango_attr_info_list->size());++ // loop over all returned attributes and convert the data+ for (uint32_t i = 0; i < tango_attr_info_list->size(); i++)+ {+ convert_attr_query((*tango_attr_info_list)[i], &attr_info_list->sequence[i]);+ }+ delete tango_attr_info_list;+ }+ catch (Tango::DevFailed &tango_exception)+ {+ if (tango_attr_info_list)+ delete tango_attr_info_list;+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++void tango_free_VarStringArray(VarStringArray *string_arr)+{+ for (uint32_t i = 0; i < string_arr->length; i++)+ {+ free(string_arr->sequence[i]); // from strdup+ }+ delete[] string_arr->sequence;+}++void tango_free_AttributeInfoList(AttributeInfoList *attribute_info_list)+{+ for (uint32_t i = 0; i < attribute_info_list->length; i++)+ {+ free(attribute_info_list->sequence[i].name); // from strdup+ free(attribute_info_list->sequence[i].description);+ free(attribute_info_list->sequence[i].label);+ free(attribute_info_list->sequence[i].unit);+ free(attribute_info_list->sequence[i].standard_unit);+ free(attribute_info_list->sequence[i].display_unit);+ free(attribute_info_list->sequence[i].format);+ free(attribute_info_list->sequence[i].min_value);+ free(attribute_info_list->sequence[i].max_value);+ free(attribute_info_list->sequence[i].min_alarm);+ free(attribute_info_list->sequence[i].max_alarm);+ free(attribute_info_list->sequence[i].writable_attr_name);+ free(attribute_info_list->sequence[i].root_attr_name);+ for (uint16_t j = 0; j < attribute_info_list->sequence[i].enum_labels_count; ++j)+ free(attribute_info_list->sequence[i].enum_labels[j]);+ if (attribute_info_list->sequence[i].enum_labels_count > 0)+ delete[] attribute_info_list->sequence[i].enum_labels;+ }+ delete[] attribute_info_list->sequence;+}++void convert_attribute_reading(Tango::DeviceAttribute &devattr, AttributeData *argout)+{+ // treat INVALID data quality+ if (devattr.get_quality() == Tango::ATTR_INVALID)+ {+ // just initialise the first datatype - this should be valid for+ // all data types in the union!+ argout->attr_data.bool_arr.length = 0;+ argout->attr_data.bool_arr.sequence = NULL;+ }+ else+ {+ int nb_data;++ // get data type+ argout->data_type = (TangoDataType)devattr.get_type();+ argout->data_format = (AttrDataFormat)devattr.data_format;+ argout->nb_read = devattr.get_nb_read();++#define EXTRACT_ARRAY(member, tgtype, type) \+ { \+ Tango::tgtype *seq; \+ devattr >> seq; \+ nb_data = seq->length(); \+ argout->attr_data.member.length = seq->length(); \+ argout->attr_data.member.sequence = seq->get_buffer(true); \+ delete seq; \+ break; \+ }++ switch (argout->data_type)+ {+ case DEV_BOOLEAN:+ EXTRACT_ARRAY(bool_arr, DevVarBooleanArray, bool);+ case DEV_UCHAR:+ EXTRACT_ARRAY(char_arr, DevVarCharArray, uint8_t);+ case DEV_SHORT:+ EXTRACT_ARRAY(short_arr, DevVarShortArray, int16_t);+ case DEV_ENUM:+ EXTRACT_ARRAY(short_arr, DevVarShortArray, int16_t);+ case DEV_USHORT:+ EXTRACT_ARRAY(ushort_arr, DevVarUShortArray, uint16_t);+ case DEV_LONG:+ EXTRACT_ARRAY(long_arr, DevVarLongArray, Tango::DevLong);+ case DEV_ULONG:+ EXTRACT_ARRAY(ulong_arr, DevVarULongArray, Tango::DevULong);+ case DEV_LONG64:+ EXTRACT_ARRAY(long64_arr, DevVarLong64Array, Tango::DevLong64);+ case DEV_ULONG64:+ EXTRACT_ARRAY(ulong64_arr, DevVarULong64Array, Tango::DevULong64);+ case DEV_FLOAT:+ EXTRACT_ARRAY(float_arr, DevVarFloatArray, float);+ case DEV_DOUBLE:+ EXTRACT_ARRAY(double_arr, DevVarDoubleArray, double);++ case DEV_STRING:+ {+ std::vector<std::string> string_vect;+ devattr >> string_vect;+ nb_data = string_vect.size();+ INIT_SEQ(argout->attr_data.string_arr, char *, nb_data);+ for (int i = 0; i < nb_data; i++)+ {+ argout->attr_data.string_arr.sequence[i] = strdup(string_vect[i].c_str());+ }+ break;+ }++ case DEV_STATE:+ {+ std::vector<Tango::DevState> state_vect;++ // the State attribute is not returning a sequence -+ // check whether the attribute name is State!+ if (devattr.name == "State")+ {+ state_vect.resize(1);+ devattr >> state_vect[0];+ }+ else+ {+ devattr >> state_vect;+ }+ nb_data = state_vect.size();+ INIT_SEQ(argout->attr_data.state_arr, TangoDevState, nb_data);+ for (int i = 0; i < nb_data; i++)+ {+ argout->attr_data.state_arr.sequence[i] = (TangoDevState)state_vect[i];+ }+ break;+ }++ case DEV_ENCODED:+ {+ Tango::DevVarEncodedArray *encoded_vect;+ uint32_t nb_data;++ devattr >> encoded_vect;+ nb_data = encoded_vect->length();+ INIT_SEQ(argout->attr_data.encoded_arr, TangoDevEncoded, nb_data);++ // allocate the encoded structues and copy data+ for (uint32_t i = 0; i < nb_data; i++)+ {+ argout->attr_data.encoded_arr.sequence[i].encoded_format =+ strdup((*encoded_vect)[i].encoded_format);+ argout->attr_data.encoded_arr.sequence[i].encoded_length =+ (*encoded_vect)[i].encoded_data.length();+ // get the pointer to the buffer and take over the memory ("true" param)+ argout->attr_data.encoded_arr.sequence[i].encoded_data =+ (uint8_t *)(*encoded_vect)[i].encoded_data.get_buffer(true);+ }+ break;+ }++ default:+ Tango::Except::throw_exception(+ "Data type error",+ "The requested data type is not implemented for attribute reading!",+ "c_tango_attribute.c::convert_attribute_reading()");+ break;+ }+ }++ // get quality factor+ argout->quality = (AttrQuality)devattr.get_quality();++ // copy timestamp+ argout->time_stamp.tv_sec = devattr.time.tv_sec;+ argout->time_stamp.tv_usec = devattr.time.tv_usec;++ // allocate attribute name+ argout->name = strdup(devattr.name.c_str());++ // get data dimension+ argout->dim_x = devattr.dim_x;+ argout->dim_y = devattr.dim_y;+}++void convert_attribute_writing(AttributeData *argin, Tango::DeviceAttribute &devattr)+{+ // allocate a vector and copy the data++#define INSERT_ARRAY(member, type) \+ { \+ std::vector<type> arr(argin->attr_data.member.length); \+ memcpy( \+ arr.data(), \+ argin->attr_data.member.sequence, \+ sizeof(type) * argin->attr_data.member.length); \+ devattr.insert(arr, argin->dim_x, argin->dim_y); \+ break; \+ }++ switch (argin->data_type)+ {+ case DEV_BOOLEAN:+ {+ std::vector<bool> arr(argin->attr_data.bool_arr.length);+ for (uint32_t i = 0; i < argin->attr_data.bool_arr.length; i++)+ {+ arr[i] = argin->attr_data.bool_arr.sequence[i];+ }+ devattr.insert(arr, argin->dim_x, argin->dim_y);+ break;+ }++ case DEV_UCHAR:+ INSERT_ARRAY(char_arr, uint8_t);+ case DEV_SHORT:+ INSERT_ARRAY(short_arr, int16_t);+ case DEV_USHORT:+ INSERT_ARRAY(ushort_arr, uint16_t);+ case DEV_LONG:+ INSERT_ARRAY(long_arr, Tango::DevLong);+ case DEV_ULONG:+ INSERT_ARRAY(ulong_arr, Tango::DevULong);+ case DEV_LONG64:+ INSERT_ARRAY(long64_arr, Tango::DevLong64);+ case DEV_ULONG64:+ INSERT_ARRAY(ulong64_arr, Tango::DevULong64);+ case DEV_FLOAT:+ INSERT_ARRAY(float_arr, float);+ case DEV_DOUBLE:+ INSERT_ARRAY(double_arr, double);++ case DEV_STRING:+ {+ std::vector<std::string> string_arr(argin->attr_data.string_arr.length);+ for (uint32_t i = 0; i < argin->attr_data.string_arr.length; i++)+ {+ string_arr[i] = argin->attr_data.string_arr.sequence[i];+ }+ devattr.insert(string_arr, argin->dim_x, argin->dim_y);+ break;+ }++ case DEV_STATE:+ {+ std::vector<Tango::DevState> state_arr(argin->attr_data.state_arr.length);+ for (uint32_t i = 0; i < argin->attr_data.state_arr.length; i++)+ {+ state_arr[i] = (Tango::DevState)argin->attr_data.state_arr.sequence[i];+ }+ devattr.insert(state_arr, argin->dim_x, argin->dim_y);+ break;+ }++ case DEV_ENCODED:+ {+ // today encoded type is only available as SCALAR data type+ devattr.insert(+ argin->attr_data.encoded_arr.sequence[0].encoded_format,+ argin->attr_data.encoded_arr.sequence[0].encoded_data,+ argin->attr_data.encoded_arr.sequence[0].encoded_length);+ break;+ }++ default:+ Tango::Except::throw_exception(+ "Data type error",+ "The requested data type is not implemented for attribute writing!",+ "c_tango_attribute.c::convert_attribute_writing()");+ break;+ }++ // set attribute name+ devattr.set_name(argin->name);+}++static void convert_attr_query(Tango::AttributeInfoEx &tango_attr_info, AttributeInfo *attr_info)+{+ attr_info->name = strdup(tango_attr_info.name.c_str());+ attr_info->description = strdup(tango_attr_info.description.c_str());+ attr_info->label = strdup(tango_attr_info.label.c_str());+ attr_info->unit = strdup(tango_attr_info.unit.c_str());+ attr_info->standard_unit = strdup(tango_attr_info.standard_unit.c_str());+ attr_info->display_unit = strdup(tango_attr_info.display_unit.c_str());+ attr_info->format = strdup(tango_attr_info.format.c_str());+ attr_info->min_value = strdup(tango_attr_info.min_value.c_str());+ attr_info->max_value = strdup(tango_attr_info.max_value.c_str());+ attr_info->min_alarm = strdup(tango_attr_info.min_alarm.c_str());+ attr_info->max_alarm = strdup(tango_attr_info.max_alarm.c_str());+ attr_info->writable_attr_name = strdup(tango_attr_info.writable_attr_name.c_str());++ attr_info->writable = (AttrWriteType)tango_attr_info.writable;+ attr_info->data_format = (AttrDataFormat)tango_attr_info.data_format;+ attr_info->data_type = (TangoDataType)tango_attr_info.data_type;+ attr_info->max_dim_x = tango_attr_info.max_dim_x;+ attr_info->max_dim_y = tango_attr_info.max_dim_y;+ attr_info->disp_level = (DispLevel)tango_attr_info.disp_level;+ std::size_t const enum_label_count = tango_attr_info.enum_labels.size();+ if (enum_label_count > 0)+ {+ char **enum_labels = new char *[enum_label_count];+ for (std::size_t i = 0; i < enum_label_count; ++i)+ enum_labels[i] = strdup(tango_attr_info.enum_labels[i].c_str());+ attr_info->enum_labels = enum_labels;+ }+ else+ {+ attr_info->enum_labels = nullptr;+ }+ attr_info->enum_labels_count = static_cast<uint16_t>(enum_label_count);++ attr_info->root_attr_name = strdup(tango_attr_info.root_attr_name.c_str());+ attr_info->memorized = (TangoAttrMemorizedType)tango_attr_info.memorized;+}++ErrorStack *tango_poll_attribute(void *db_proxy, char const *cmd_name, int polling_period)+{+ try+ {+ static_cast<Tango::DeviceProxy *>(db_proxy)->poll_attribute(cmd_name, polling_period);+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_stop_poll_attribute(void *db_proxy, char const *cmd_name)+{+ try+ {+ static_cast<Tango::DeviceProxy *>(db_proxy)->stop_poll_attribute(cmd_name);+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}
+ c_tango/src/c_tango_command.cpp view
@@ -0,0 +1,569 @@+/******************************************************************************+ *+ * File: c_tango_command.c+ * Project: C client interface to Tango+ * Description: Interface functions to access Tango commands+ * Original: November 2007+ * Author: jensmeyer+ *+ * Adapted for tango-rs by Georg Brandl, 2015.+ *+ ******************************************************************************/++#include "c_tango.h"++ErrorStack *tango_translate_exception(Tango::DevFailed &tango_exception);+static void convert_cmd_query(Tango::CommandInfo &tango_cmd_info, CommandInfo *cmd_info);++ErrorStack *+tango_command_inout(void *proxy, char *cmd_name, CommandData *argin, CommandData *argout)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;+ Tango::DeviceData cmd_in;+ Tango::DeviceData cmd_out;++ try+ {+ // convert the input argument+ switch (argin->arg_type)+ {+ case DEV_VOID:+ break;++ case DEV_BOOLEAN:+ cmd_in << argin->cmd_data.bool_val;+ break;++ case DEV_SHORT:+ cmd_in << argin->cmd_data.short_val;+ break;++ case DEV_USHORT:+ cmd_in << argin->cmd_data.ushort_val;+ break;++ case DEV_LONG:+ cmd_in << (Tango::DevLong)argin->cmd_data.long_val;+ break;++ case DEV_ULONG:+ cmd_in << (Tango::DevULong)argin->cmd_data.ulong_val;+ break;++ case DEV_LONG64:+ cmd_in << (Tango::DevLong64)argin->cmd_data.long64_val;+ break;++ case DEV_ULONG64:+ cmd_in << (Tango::DevULong64)argin->cmd_data.ulong64_val;+ break;++ case DEV_FLOAT:+ cmd_in << argin->cmd_data.float_val;+ break;++ case DEV_DOUBLE:+ cmd_in << argin->cmd_data.double_val;+ break;++ case DEV_STRING:+ case CONST_DEV_STRING:+ cmd_in << argin->cmd_data.string_val;+ break;++ case DEV_ENCODED:+ {+ Tango::DevVarCharArray tmp(+ argin->cmd_data.encoded_val.encoded_length,+ argin->cmd_data.encoded_val.encoded_length,+ argin->cmd_data.encoded_val.encoded_data);+ cmd_in.insert(argin->cmd_data.encoded_val.encoded_format, &tmp);+ break;+ }++#define INSERT_ARRAY(member, type) \+ { \+ std::vector<type> arr(argin->cmd_data.member.length); \+ memcpy( \+ arr.data(), \+ argin->cmd_data.char_arr.sequence, \+ sizeof(type) * argin->cmd_data.char_arr.length); \+ cmd_in << arr; \+ break; \+ }++ case DEVVAR_CHARARRAY:+ INSERT_ARRAY(char_arr, uint8_t);+ case DEVVAR_SHORTARRAY:+ INSERT_ARRAY(short_arr, int16_t);+ case DEVVAR_USHORTARRAY:+ INSERT_ARRAY(ushort_arr, uint16_t);+ case DEVVAR_LONGARRAY:+ INSERT_ARRAY(long_arr, Tango::DevLong);+ case DEVVAR_ULONGARRAY:+ INSERT_ARRAY(ulong_arr, Tango::DevULong);+ case DEVVAR_LONG64ARRAY:+ INSERT_ARRAY(long64_arr, Tango::DevLong64);+ case DEVVAR_ULONG64ARRAY:+ INSERT_ARRAY(ulong64_arr, Tango::DevULong64);+ case DEVVAR_FLOATARRAY:+ INSERT_ARRAY(float_arr, float);+ case DEVVAR_DOUBLEARRAY:+ INSERT_ARRAY(double_arr, double);++ case DEVVAR_STRINGARRAY:+ {+ std::vector<std::string> string_arr(argin->cmd_data.string_arr.length);++ for (uint32_t i = 0; i < argin->cmd_data.string_arr.length; i++)+ {+ string_arr[i] = argin->cmd_data.string_arr.sequence[i];+ }++ cmd_in << string_arr;+ break;+ }++ case DEVVAR_LONGSTRINGARRAY:+ {+ std::vector<Tango::DevLong> long_arr(argin->cmd_data.long_string_arr.long_length);+ std::vector<std::string> string_arr(argin->cmd_data.long_string_arr.string_length);++ for (uint32_t i = 0; i < argin->cmd_data.long_string_arr.long_length; i++)+ {+ long_arr[i] = argin->cmd_data.long_string_arr.long_sequence[i];+ }+ for (uint32_t i = 0; i < argin->cmd_data.long_string_arr.string_length; i++)+ {+ string_arr[i] = argin->cmd_data.long_string_arr.string_sequence[i];+ }++ cmd_in.insert(long_arr, string_arr);+ break;+ }++ case DEVVAR_DOUBLESTRINGARRAY:+ {+ std::vector<double> double_arr(argin->cmd_data.double_string_arr.double_length);+ std::vector<std::string> string_arr(argin->cmd_data.double_string_arr.string_length);++ for (uint32_t i = 0; i < argin->cmd_data.double_string_arr.double_length; i++)+ {+ double_arr[i] = argin->cmd_data.double_string_arr.double_sequence[i];+ }+ for (uint32_t i = 0; i < argin->cmd_data.double_string_arr.string_length; i++)+ {+ string_arr[i] = argin->cmd_data.double_string_arr.string_sequence[i];+ }++ cmd_in.insert(double_arr, string_arr);+ break;+ }++ default:+ Tango::Except::throw_exception(+ "Data type error",+ "The requested data type is not implemented for command writing!",+ "c_tango_command.c::tango_command_inout()");+ break;+ }++ // treat the void case!+ if (argin->arg_type == DEV_VOID)+ {+ cmd_out = dev->command_inout(cmd_name);+ }+ else+ {+ cmd_out = dev->command_inout(cmd_name, cmd_in);+ }+ try+ {+ cmd_out.is_empty();+ argout->arg_type = (TangoDataType)cmd_out.get_type();+ }+ catch (Tango::DevFailed &e)+ {+ argout->arg_type = DEV_VOID;+ }++ // convert the output argument+ switch (argout->arg_type)+ {+ case DEV_VOID:+ break;++ case DEV_BOOLEAN:+ cmd_out >> argout->cmd_data.bool_val;+ break;++ case DEV_SHORT:+ cmd_out >> argout->cmd_data.short_val;+ break;++ case DEV_USHORT:+ cmd_out >> argout->cmd_data.ushort_val;+ break;++ case DEV_LONG:+ {+ Tango::DevLong long_val;+ cmd_out >> long_val;+ argout->cmd_data.long_val = long_val;+ break;+ }++ case DEV_ULONG:+ {+ Tango::DevULong ulong_val;+ cmd_out >> ulong_val;+ argout->cmd_data.ulong_val = ulong_val;+ break;+ }++ case DEV_LONG64:+ {+ Tango::DevLong64 long64_val;+ cmd_out >> long64_val;+ argout->cmd_data.long64_val = long64_val;+ break;+ }++ case DEV_ULONG64:+ {+ Tango::DevULong64 ulong64_val;+ cmd_out >> ulong64_val;+ argout->cmd_data.ulong64_val = ulong64_val;+ break;+ }++ case DEV_FLOAT:+ cmd_out >> argout->cmd_data.float_val;+ break;++ case DEV_DOUBLE:+ cmd_out >> argout->cmd_data.double_val;+ break;++ case DEV_STATE:+ {+ Tango::DevState state_val;+ cmd_out >> state_val;+ argout->cmd_data.state_val = (TangoDevState)state_val;+ break;+ }++ case DEV_STRING:+ case CONST_DEV_STRING:+ {+ std::string string_val;+ cmd_out >> string_val;+ argout->cmd_data.string_val = strdup(string_val.c_str());+ break;+ }++ case DEV_ENCODED:+ {+ Tango::DevEncoded encoded_val;+ cmd_out >> encoded_val;++ std::string format(encoded_val.encoded_format);+ argout->cmd_data.encoded_val.encoded_format = strdup(format.c_str());++ // get the pointer to the buffer and take over the memory ("true")+ argout->cmd_data.encoded_val.encoded_length = encoded_val.encoded_data.length();+ argout->cmd_data.encoded_val.encoded_data =+ (unsigned char *)encoded_val.encoded_data.get_buffer(true);+ break;+ }++#define EXTRACT_ARRAY(member, tgtype) \+ { \+ const Tango::tgtype *seq; \+ cmd_out >> seq; \+ argout->cmd_data.member.length = seq->length(); \+ argout->cmd_data.member.sequence = ((Tango::tgtype *)seq)->get_buffer(true); \+ break; \+ }++ case DEVVAR_CHARARRAY:+ EXTRACT_ARRAY(char_arr, DevVarCharArray);+ case DEVVAR_SHORTARRAY:+ EXTRACT_ARRAY(short_arr, DevVarShortArray);+ case DEVVAR_USHORTARRAY:+ EXTRACT_ARRAY(ushort_arr, DevVarUShortArray);+ case DEVVAR_LONGARRAY:+ EXTRACT_ARRAY(long_arr, DevVarLongArray);+ case DEVVAR_ULONGARRAY:+ EXTRACT_ARRAY(ulong_arr, DevVarULongArray);+ case DEVVAR_LONG64ARRAY:+ EXTRACT_ARRAY(long64_arr, DevVarLong64Array);+ case DEVVAR_ULONG64ARRAY:+ EXTRACT_ARRAY(ulong64_arr, DevVarULong64Array);+ case DEVVAR_FLOATARRAY:+ EXTRACT_ARRAY(float_arr, DevVarFloatArray);+ case DEVVAR_DOUBLEARRAY:+ EXTRACT_ARRAY(double_arr, DevVarDoubleArray);++ case DEVVAR_STRINGARRAY:+ {+ std::vector<std::string> string_vect;+ int nb_data;++ cmd_out >> string_vect;+ nb_data = string_vect.size();++ argout->cmd_data.string_arr.sequence = new char *[nb_data];+ argout->cmd_data.string_arr.length = nb_data;++ for (int i = 0; i < nb_data; i++)+ {+ argout->cmd_data.string_arr.sequence[i] = strdup(string_vect[i].c_str());+ }+ break;+ }++ case DEVVAR_LONGSTRINGARRAY:+ {+ std::vector<Tango::DevLong> long_vect;+ std::vector<std::string> string_vect;+ int nb_data;++ cmd_out.extract(long_vect, string_vect);++ nb_data = long_vect.size();+ argout->cmd_data.long_string_arr.long_sequence = new Tango::DevLong[nb_data];+ argout->cmd_data.long_string_arr.long_length = nb_data;+ for (int i = 0; i < nb_data; i++)+ {+ argout->cmd_data.long_string_arr.long_sequence[i] = long_vect[i];+ }++ nb_data = string_vect.size();+ argout->cmd_data.long_string_arr.string_sequence = new char *[nb_data];+ argout->cmd_data.long_string_arr.string_length = nb_data;+ for (int i = 0; i < nb_data; i++)+ {+ argout->cmd_data.long_string_arr.string_sequence[i] = strdup(string_vect[i].c_str());+ }+ break;+ }++ case DEVVAR_DOUBLESTRINGARRAY:+ {+ std::vector<double> double_vect;+ std::vector<std::string> string_vect;+ int nb_data;++ cmd_out.extract(double_vect, string_vect);++ nb_data = double_vect.size();+ argout->cmd_data.double_string_arr.double_sequence = new double[nb_data];+ argout->cmd_data.double_string_arr.double_length = nb_data;+ for (int i = 0; i < nb_data; i++)+ {+ argout->cmd_data.double_string_arr.double_sequence[i] = double_vect[i];+ }++ nb_data = string_vect.size();+ argout->cmd_data.double_string_arr.string_sequence = new char *[nb_data];+ argout->cmd_data.double_string_arr.string_length = nb_data;+ for (int i = 0; i < nb_data; i++)+ {+ argout->cmd_data.double_string_arr.string_sequence[i] = strdup(string_vect[i].c_str());+ }+ break;+ }++ default:+ Tango::Except::throw_exception(+ "Data type error",+ "The requested data type is not implemented for command reading!",+ "c_tango_command.c::tango_command_inout()");+ break;+ }+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++void tango_free_CommandData(CommandData *command_data)+{+ switch (command_data->arg_type)+ {+ case DEV_STRING:+ free(command_data->cmd_data.string_val); // from strdup+ break;++ case DEV_ENCODED:+ free(command_data->cmd_data.encoded_val.encoded_format); // from strdup+ delete[] command_data->cmd_data.encoded_val.encoded_data;+ break;++ case DEVVAR_CHARARRAY:+ delete[] command_data->cmd_data.char_arr.sequence;+ break;++ case DEVVAR_SHORTARRAY:+ delete[] command_data->cmd_data.short_arr.sequence;+ break;++ case DEVVAR_USHORTARRAY:+ delete[] command_data->cmd_data.ushort_arr.sequence;+ break;++ case DEVVAR_LONGARRAY:+ delete[] command_data->cmd_data.long_arr.sequence;+ break;++ case DEVVAR_ULONGARRAY:+ delete[] command_data->cmd_data.ulong_arr.sequence;+ break;++ case DEVVAR_LONG64ARRAY:+ delete[] command_data->cmd_data.long64_arr.sequence;+ break;++ case DEVVAR_ULONG64ARRAY:+ delete[] command_data->cmd_data.ulong64_arr.sequence;+ break;++ case DEVVAR_FLOATARRAY:+ delete[] command_data->cmd_data.float_arr.sequence;+ break;++ case DEVVAR_DOUBLEARRAY:+ delete[] command_data->cmd_data.double_arr.sequence;+ break;++ case DEVVAR_STRINGARRAY:+ for (uint32_t i = 0; i < command_data->cmd_data.string_arr.length; i++)+ {+ free(command_data->cmd_data.string_arr.sequence[i]); // from strdup+ }+ delete[] command_data->cmd_data.string_arr.sequence;+ break;++ case DEVVAR_LONGSTRINGARRAY:+ delete[] command_data->cmd_data.long_string_arr.long_sequence;+ for (uint32_t i = 0; i < command_data->cmd_data.long_string_arr.string_length; i++)+ {+ free(command_data->cmd_data.long_string_arr.string_sequence[i]); // from strdup+ }+ delete[] command_data->cmd_data.long_string_arr.string_sequence;+ break;++ case DEVVAR_DOUBLESTRINGARRAY:+ delete[] command_data->cmd_data.double_string_arr.double_sequence;+ for (uint32_t i = 0; i < command_data->cmd_data.double_string_arr.string_length; i++)+ {+ free(command_data->cmd_data.double_string_arr.string_sequence[i]); // from strdup+ }+ delete[] command_data->cmd_data.double_string_arr.string_sequence;+ break;++ default:+ break;+ }+}++ErrorStack *tango_command_query(void *proxy, char *cmd_name, CommandInfo *cmd_info)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;+ Tango::CommandInfo tango_cmd_info;++ try+ {+ tango_cmd_info = dev->command_query(cmd_name);+ convert_cmd_query(tango_cmd_info, cmd_info);+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_command_list_query(void *proxy, CommandInfoList *cmd_info_list)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;+ std::vector<Tango::CommandInfo> *tango_cmd_info_list = 0;++ try+ {+ tango_cmd_info_list = dev->command_list_query();++ INIT_SEQ(*cmd_info_list, CommandInfo, tango_cmd_info_list->size());++ for (uint32_t i = 0; i < tango_cmd_info_list->size(); i++)+ {+ convert_cmd_query((*tango_cmd_info_list)[i], &cmd_info_list->sequence[i]);+ }+ delete tango_cmd_info_list;+ }+ catch (Tango::DevFailed &tango_exception)+ {+ if (tango_cmd_info_list)+ delete tango_cmd_info_list;+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++void tango_free_CommandInfo(CommandInfo *command_info)+{+ free(command_info->cmd_name); // from strdup+ free(command_info->in_type_desc);+ free(command_info->out_type_desc);+}++void tango_free_CommandInfoList(CommandInfoList *command_info_list)+{+ for (uint32_t i = 0; i < command_info_list->length; i++)+ {+ tango_free_CommandInfo(&(command_info_list->sequence[i]));+ }++ delete[] command_info_list->sequence;+}++static void convert_cmd_query(Tango::CommandInfo &tango_cmd_info, CommandInfo *cmd_info)+{+ cmd_info->cmd_name = strdup(tango_cmd_info.cmd_name.c_str());+ cmd_info->in_type_desc = strdup(tango_cmd_info.in_type_desc.c_str());+ cmd_info->out_type_desc = strdup(tango_cmd_info.out_type_desc.c_str());++ cmd_info->cmd_tag = tango_cmd_info.cmd_tag;+ cmd_info->in_type = tango_cmd_info.in_type;+ cmd_info->out_type = tango_cmd_info.out_type;+ cmd_info->disp_level = (DispLevel)tango_cmd_info.disp_level;+}++ErrorStack *tango_poll_command(void *db_proxy, char const *cmd_name, int polling_period)+{+ try+ {+ static_cast<Tango::DeviceProxy *>(db_proxy)->poll_command(cmd_name, polling_period);+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_stop_poll_command(void *db_proxy, char const *cmd_name)+{+ try+ {+ static_cast<Tango::DeviceProxy *>(db_proxy)->stop_poll_command(cmd_name);+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}
+ c_tango/src/c_tango_dbase.cpp view
@@ -0,0 +1,678 @@+/******************************************************************************+ *+ * File: c_tango_dbase.c+ * Project: C client interface to Tango+ * Description: Interface functions to access Tango properties+ * Original: November 2007+ * Author: jensmeyer+ *+ * Adapted for tango-rs by Georg Brandl, 2015.+ *+ ******************************************************************************/++#include "c_tango.h"++ErrorStack *tango_translate_exception(Tango::DevFailed &tango_exception);+static void convert_property_reading(Tango::DbDatum &tango_prop, DbDatum *prop);+static void convert_property_writing(DbDatum *prop, Tango::DbDatum &tango_prop);++ErrorStack *tango_create_database_proxy(void **db_proxy)+{+ try+ {+ Tango::Database *dbase = new Tango::Database();+ *db_proxy = (void *)dbase;+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_delete_database_proxy(void *db_proxy)+{+ Tango::Database *dbase = (Tango::Database *)db_proxy;++ try+ {+ delete dbase;+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_get_device_exported(void *db_proxy, char *name_filter, DbDatum *dev_list)+{+ Tango::Database *dbase = (Tango::Database *)db_proxy;+ Tango::DbDatum tango_dev_list;++ try+ {+ std::string filter = name_filter;+ tango_dev_list = dbase->get_device_exported(filter);++ // the result is a string array, set the data type for the conversion+ dev_list->data_type = DEVVAR_STRINGARRAY;+ convert_property_reading(tango_dev_list, dev_list);+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_get_device_exported_for_class(void *db_proxy, char *class_name, DbDatum *dev_list)+{+ Tango::Database *dbase = (Tango::Database *)db_proxy;+ Tango::DbDatum tango_dev_list;++ try+ {+ std::string name = class_name;+ tango_dev_list = dbase->get_device_exported_for_class(name);++ // the result is a string array, set the data type for the conversion+ dev_list->data_type = DEVVAR_STRINGARRAY;+ convert_property_reading(tango_dev_list, dev_list);+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_get_object_list(void *db_proxy, char *name_filter, DbDatum *obj_list)+{+ Tango::Database *dbase = (Tango::Database *)db_proxy;+ Tango::DbDatum tango_obj_list;++ try+ {+ std::string filter = name_filter;+ tango_obj_list = dbase->get_object_list(filter);++ // the result is a string array, set the data type for the conversion+ obj_list->data_type = DEVVAR_STRINGARRAY;+ convert_property_reading(tango_obj_list, obj_list);+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_get_object_property_list(+ void *db_proxy, char *obj_name, char *name_filter, DbDatum *prop_list)+{+ Tango::Database *dbase = (Tango::Database *)db_proxy;+ Tango::DbDatum tango_prop_list;++ try+ {+ std::string name = obj_name;+ std::string filter = name_filter;+ tango_prop_list = dbase->get_object_property_list(name, filter);++ // the result is a string array, set the data type for the conversion+ prop_list->data_type = DEVVAR_STRINGARRAY;+ convert_property_reading(tango_prop_list, prop_list);+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_get_property(void *db_proxy, char *obj_name, DbData *prop_list)+{+ Tango::Database *dbase = (Tango::Database *)db_proxy;+ Tango::DbData tango_prop_list;++ try+ {+ std::string name = obj_name;++ // copy the property names into the Tango object+ for (uint32_t i = 0; i < prop_list->length; i++)+ {+ tango_prop_list.push_back(Tango::DbDatum(prop_list->sequence[i].property_name));+ }++ // read the properties+ dbase->get_property(name, tango_prop_list);++ for (uint32_t i = 0; i < prop_list->length; i++)+ {+ // copy the property data into the C structure+ convert_property_reading(tango_prop_list[i], &prop_list->sequence[i]);+ }+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_put_property(void *db_proxy, char *obj_name, DbData *prop_list)+{+ Tango::Database *dbase = (Tango::Database *)db_proxy;+ Tango::DbData tango_prop_list;++ try+ {+ std::string name = obj_name;++ // copy the property names and data into the Tango object+ tango_prop_list.resize(prop_list->length);+ for (uint32_t i = 0; i < prop_list->length; i++)+ {+ convert_property_writing(&prop_list->sequence[i], tango_prop_list[i]);+ }++ // write the properties+ dbase->put_property(name, tango_prop_list);+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_delete_property(void *db_proxy, char *obj_name, DbData *prop_list)+{+ Tango::Database *dbase = (Tango::Database *)db_proxy;+ Tango::DbData tango_prop_list;++ try+ {+ std::string name = obj_name;++ // copy the property names into the Tango object+ for (uint32_t i = 0; i < prop_list->length; i++)+ {+ tango_prop_list.push_back(Tango::DbDatum(prop_list->sequence[i].property_name));+ }++ // read the properties+ dbase->delete_property(name, tango_prop_list);+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_get_device_property(void *proxy, DbData *prop_list)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;+ Tango::DbData tango_prop_list;++ try+ {+ // copy the property names into the Tango object+ for (uint32_t i = 0; i < prop_list->length; i++)+ {+ tango_prop_list.push_back(Tango::DbDatum(prop_list->sequence[i].property_name));+ }++ // read the properties+ dev->get_property(tango_prop_list);++ for (uint32_t i = 0; i < prop_list->length; i++)+ {+ // copy the property data into the C structure+ convert_property_reading(tango_prop_list[i], &prop_list->sequence[i]);+ }+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_put_device_property(void *proxy, DbData *prop_list)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;+ Tango::DbData tango_prop_list;++ try+ {+ // copy the property names into the Tango object+ tango_prop_list.resize(prop_list->length);++ for (uint32_t i = 0; i < prop_list->length; i++)+ {+ convert_property_writing(&prop_list->sequence[i], tango_prop_list[i]);+ }++ // write the properties+ dev->put_property(tango_prop_list);+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_delete_device_property(void *proxy, DbData *prop_list)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;+ Tango::DbData tango_prop_list;++ try+ {+ // copy the property names into the Tango object+ for (uint32_t i = 0; i < prop_list->length; i++)+ {+ tango_prop_list.push_back(Tango::DbDatum(prop_list->sequence[i].property_name));+ }++ // read the properties+ dev->delete_property(tango_prop_list);+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++void tango_free_DbDatum(DbDatum *db_datum)+{+ free(db_datum->property_name); // from strdup++ switch (db_datum->data_type)+ {+ case DEV_STRING:+ free(db_datum->prop_data.string_val);+ break;++ case DEVVAR_SHORTARRAY:+ delete[] db_datum->prop_data.short_arr.sequence;+ break;++ case DEVVAR_USHORTARRAY:+ delete[] db_datum->prop_data.ushort_arr.sequence;+ break;++ case DEVVAR_LONGARRAY:+ delete[] db_datum->prop_data.long_arr.sequence;+ break;++ case DEVVAR_ULONGARRAY:+ delete[] db_datum->prop_data.ulong_arr.sequence;+ break;++ case DEVVAR_LONG64ARRAY:+ delete[] db_datum->prop_data.long64_arr.sequence;+ break;++ case DEVVAR_ULONG64ARRAY:+ delete[] db_datum->prop_data.ulong64_arr.sequence;+ break;++ case DEVVAR_FLOATARRAY:+ delete[] db_datum->prop_data.float_arr.sequence;+ break;++ case DEVVAR_DOUBLEARRAY:+ delete[] db_datum->prop_data.double_arr.sequence;+ break;++ case DEVVAR_STRINGARRAY:+ for (uint32_t i = 0; i < db_datum->prop_data.string_arr.length; i++)+ {+ free(db_datum->prop_data.string_arr.sequence[i]); // from strdup+ }++ delete[] db_datum->prop_data.string_arr.sequence;+ break;++ default:+ break;+ }+}++void tango_free_DbData(DbData *db_data)+{+ for (uint32_t i = 0; i < db_data->length; i++)+ {+ tango_free_DbDatum(&db_data->sequence[i]);+ }+}++class HaskellCallBack : public Tango::CallBack+{+public:+ HaskellCallBack(void (*callback_fn)(void *, char const *, bool)) : callback_fn{callback_fn} {}++ void push_event(Tango::EventData *ed)+ {+ this->callback_fn(ed->device, ed->event.c_str(), ed->err);+ }++private:+ void (*callback_fn)(void *, char const *, bool);+};++void *tango_create_event_callback(void (*callback_fn)(void *, char const *, bool))+{+ return new HaskellCallBack(callback_fn);+}++void tango_free_event_callback(void *cb) { delete static_cast<HaskellCallBack *>(cb); }++int tango_subscribe_event(+ void *dev_proxy,+ char const *attribute,+ TangoEventType event_type,+ void *event_callback,+ bool stateless)+{+ try+ {+ return static_cast<Tango::DeviceProxy *>(dev_proxy)->subscribe_event(+ attribute,+ static_cast<Tango::EventType>(event_type),+ static_cast<HaskellCallBack *>(event_callback),+ stateless);+ }+ catch (Tango::DevFailed const &e)+ {+ std::cerr << "caught exception in subscribe_event: " << e.errors[0].reason << "\n";+ throw e;+ }+}++void tango_unsubscribe_event(void *dev_proxy, int event_id)+{+ static_cast<Tango::DeviceProxy *>(dev_proxy)->unsubscribe_event(event_id);+}++static void convert_property_reading(Tango::DbDatum &tango_prop, DbDatum *prop)+{+ // allocate property name+ prop->property_name = strdup(tango_prop.name.c_str());++ // copy the property data into the C structure+ if (!tango_prop.is_empty())+ {+ // set the flags+ prop->is_empty = false;+ prop->wrong_data_type = false;++ // convert the data+ switch (prop->data_type)+ {+ case DEV_BOOLEAN:+ if (!(tango_prop >> prop->prop_data.bool_val))+ prop->wrong_data_type = true;+ break;++ case DEV_UCHAR:+ if (!(tango_prop >> prop->prop_data.char_val))+ prop->wrong_data_type = true;+ break;++ case DEV_SHORT:+ if (!(tango_prop >> prop->prop_data.short_val))+ prop->wrong_data_type = true;+ break;++ case DEV_USHORT:+ if (!(tango_prop >> prop->prop_data.ushort_val))+ prop->wrong_data_type = true;+ break;++ case DEV_LONG:+ {+ Tango::DevLong long_val;+ if (!(tango_prop >> long_val))+ prop->wrong_data_type = true;+ else+ prop->prop_data.long_val = long_val;+ break;+ }++ case DEV_ULONG:+ {+ Tango::DevULong ulong_val;+ if (!(tango_prop >> ulong_val))+ prop->wrong_data_type = true;+ else+ prop->prop_data.ulong_val = ulong_val;+ break;+ }++ case DEV_LONG64:+ {+ Tango::DevLong64 long64_val;+ if (!(tango_prop >> long64_val))+ prop->wrong_data_type = true;+ else+ prop->prop_data.long64_val = long64_val;+ break;+ }++ case DEV_ULONG64:+ {+ Tango::DevULong64 ulong64_val;+ if (!(tango_prop >> ulong64_val))+ prop->wrong_data_type = true;+ else+ prop->prop_data.ulong64_val = ulong64_val;+ break;+ }++ case DEV_FLOAT:+ if (!(tango_prop >> prop->prop_data.float_val))+ prop->wrong_data_type = true;+ break;++ case DEV_DOUBLE:+ if (!(tango_prop >> prop->prop_data.double_val))+ prop->wrong_data_type = true;+ break;++ case DEV_STRING:+ {+ std::string string_val;+ if (tango_prop >> string_val)+ {+ prop->prop_data.string_val = strdup(string_val.c_str());+ }+ else+ {+ prop->wrong_data_type = true;+ }+ break;+ }++#define EXTRACT_ARRAY(member, type) \+ { \+ std::vector<type> vect; \+ uint32_t nb_data; \+ if (tango_prop >> vect) \+ { \+ nb_data = vect.size(); \+ prop->prop_data.member.length = nb_data; \+ prop->prop_data.member.sequence = new type[nb_data]; \+ memcpy(prop->prop_data.member.sequence, vect.data(), sizeof(type) * nb_data); \+ } \+ else \+ { \+ prop->wrong_data_type = true; \+ } \+ break; \+ }++ case DEVVAR_SHORTARRAY:+ EXTRACT_ARRAY(short_arr, int16_t);+ case DEVVAR_USHORTARRAY:+ EXTRACT_ARRAY(ushort_arr, uint16_t);+ case DEVVAR_LONGARRAY:+ EXTRACT_ARRAY(long_arr, Tango::DevLong);+ case DEVVAR_ULONGARRAY:+ EXTRACT_ARRAY(ulong_arr, Tango::DevULong);+ case DEVVAR_LONG64ARRAY:+ EXTRACT_ARRAY(long64_arr, Tango::DevLong64);+ case DEVVAR_ULONG64ARRAY:+ EXTRACT_ARRAY(ulong64_arr, Tango::DevULong64);+ case DEVVAR_FLOATARRAY:+ EXTRACT_ARRAY(float_arr, float);+ case DEVVAR_DOUBLEARRAY:+ EXTRACT_ARRAY(double_arr, double);++ case DEVVAR_STRINGARRAY:+ {+ std::vector<std::string> string_vect;+ uint32_t nb_data;++ if (tango_prop >> string_vect)+ {+ nb_data = string_vect.size();++ prop->prop_data.string_arr.sequence = new char *[nb_data];+ prop->prop_data.string_arr.length = nb_data;++ for (uint32_t i = 0; i < nb_data; i++)+ {+ prop->prop_data.string_arr.sequence[i] = strdup(string_vect[i].c_str());+ }+ }+ else+ {+ prop->wrong_data_type = true;+ }+ break;+ }++ default:+ Tango::Except::throw_exception(+ "Data type error",+ "The requested data type is not implemented for property reading!",+ "c_tango_dbase.c::convert_property_reading()");+ break;+ }+ }+ else+ {+ // no property value found, set the is_empty flag+ prop->is_empty = true;+ prop->wrong_data_type = false;+ }+}++static void convert_property_writing(DbDatum *prop, Tango::DbDatum &tango_prop)+{+ tango_prop.name = prop->property_name;++ switch (prop->data_type)+ {+ case DEV_BOOLEAN:+ tango_prop << prop->prop_data.bool_val;+ break;++ case DEV_UCHAR:+ tango_prop << prop->prop_data.char_val;+ break;++ case DEV_SHORT:+ tango_prop << prop->prop_data.short_val;+ break;++ case DEV_USHORT:+ tango_prop << prop->prop_data.ushort_val;+ break;++ case DEV_LONG:+ tango_prop << (Tango::DevLong)prop->prop_data.long_val;+ break;++ case DEV_ULONG:+ tango_prop << (Tango::DevULong)prop->prop_data.ulong_val;+ break;++ case DEV_LONG64:+ tango_prop << (Tango::DevLong64)prop->prop_data.long64_val;+ break;++ case DEV_ULONG64:+ tango_prop << (Tango::DevULong64)prop->prop_data.ulong64_val;+ break;++ case DEV_FLOAT:+ tango_prop << prop->prop_data.float_val;+ break;++ case DEV_DOUBLE:+ tango_prop << prop->prop_data.double_val;+ break;++ case DEV_STRING:+ case CONST_DEV_STRING:+ tango_prop << prop->prop_data.string_val;+ break;++#define INSERT_ARRAY(member, type) \+ { \+ std::vector<type> arr(prop->prop_data.member.length); \+ memcpy( \+ arr.data(), \+ prop->prop_data.member.sequence, \+ sizeof(type) * prop->prop_data.member.length); \+ tango_prop << arr; \+ break; \+ }++ case DEVVAR_SHORTARRAY:+ INSERT_ARRAY(short_arr, int16_t);+ case DEVVAR_USHORTARRAY:+ INSERT_ARRAY(ushort_arr, uint16_t);+ case DEVVAR_LONGARRAY:+ INSERT_ARRAY(long_arr, Tango::DevLong);+ case DEVVAR_ULONGARRAY:+ INSERT_ARRAY(ulong_arr, Tango::DevULong);+ case DEVVAR_LONG64ARRAY:+ INSERT_ARRAY(long64_arr, Tango::DevLong64);+ case DEVVAR_ULONG64ARRAY:+ INSERT_ARRAY(ulong64_arr, Tango::DevULong64);+ case DEVVAR_FLOATARRAY:+ INSERT_ARRAY(float_arr, float);+ case DEVVAR_DOUBLEARRAY:+ INSERT_ARRAY(double_arr, double);++ case DEVVAR_STRINGARRAY:+ {+ std::vector<std::string> string_arr(prop->prop_data.string_arr.length);++ for (uint32_t i = 0; i < prop->prop_data.string_arr.length; i++)+ {+ string_arr[i] = prop->prop_data.string_arr.sequence[i];+ }++ tango_prop << string_arr;+ break;+ }++ default:+ Tango::Except::throw_exception(+ "Data type error",+ "The requested data type is not implemented for property writing!",+ "c_tango_dbase.c::convert_property_writing()");+ break;+ }+}
+ c_tango/src/c_tango_proxy.cpp view
@@ -0,0 +1,208 @@+/******************************************************************************+ *+ * File: c_tango_proxy.c+ * Project: C/Rust client interface to Tango+ * Description: Interface functions to access Tango devices+ * Original: November 2007+ * Author: jensmeyer+ *+ * Adapted for tango-rs by Georg Brandl, 2015.+ *+ ******************************************************************************/++#include "c_tango.h"++ErrorStack *tango_translate_exception(Tango::DevFailed &tango_exception);++ErrorStack *tango_create_device_proxy(char *dev_name, void **proxy)+{+ try+ {+ Tango::DeviceProxy *dev = new Tango::DeviceProxy(dev_name);+ *proxy = (void *)dev;+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_delete_device_proxy(void *proxy)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;++ try+ {+ delete dev;+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_set_timeout_millis(void *proxy, int millis)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;++ try+ {+ dev->set_timeout_millis(millis);+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_get_timeout_millis(void *proxy, int *millis)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;++ try+ {+ *millis = dev->get_timeout_millis();+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_set_source(void *proxy, DevSource source)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;++ try+ {+ dev->set_source((Tango::DevSource)source);+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_get_source(void *proxy, DevSource *source)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;++ try+ {+ *source = (DevSource)dev->get_source();+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_lock(void *proxy)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;++ try+ {+ dev->lock();+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_unlock(void *proxy)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;++ try+ {+ dev->unlock();+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_is_locked(void *proxy, bool *is_locked)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;++ try+ {+ *is_locked = dev->is_locked();+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_is_locked_by_me(void *proxy, bool *is_locked_by_me)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;++ try+ {+ *is_locked_by_me = dev->is_locked_by_me();+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++ErrorStack *tango_locking_status(void *proxy, char **locking_status)+{+ Tango::DeviceProxy *dev = (Tango::DeviceProxy *)proxy;++ try+ {+ std::string st = dev->locking_status();+ *locking_status = strdup(st.c_str());+ }+ catch (Tango::DevFailed &tango_exception)+ {+ return tango_translate_exception(tango_exception);+ }+ return 0;+}++void tango_free_ErrorStack(ErrorStack *error)+{+ for (uint32_t i = 0; i < error->length; i++)+ {+ free(error->sequence[i].desc); // from strdup+ free(error->sequence[i].reason);+ free(error->sequence[i].origin);+ }+ delete[] error->sequence;+ delete error;+}++ErrorStack *tango_translate_exception(Tango::DevFailed &tango_exception)+{+ ErrorStack *error = new ErrorStack;+ INIT_SEQ(*error, DevFailed, tango_exception.errors.length());++ for (uint32_t i = 0; i < tango_exception.errors.length(); i++)+ {+ error->sequence[i].desc = strdup(tango_exception.errors[i].desc);+ error->sequence[i].reason = strdup(tango_exception.errors[i].reason);+ error->sequence[i].origin = strdup(tango_exception.errors[i].origin);+ error->sequence[i].severity = (ErrSeverity)tango_exception.errors[i].severity;+ }++ return error;+}
+ hs-tango.cabal view
@@ -0,0 +1,79 @@+cabal-version: 3.6+name: hs-tango+version: 1.0.0+synopsis: Bindings to the Tango Controls system+description:+ Haskell bindings for Tango, part of the Tango Distributed Control System toolkit. Some general notes about this project:++ * There are raw C bindings inside the 'Tango.Raw' package. You shouldn't have to use these, but they might be a fallback if you need something very specific.+ * C types are mapped to sized Haskell types. For example, an attribute of type "Short" will be mapped to the @Int16@ type. The names of the value constructors will be called ...Short, still, to have some symmetry with the Tango user interfaces.+ * The implementation regarding some obscure types is lackluster: "encoded", "long string array" and "double string array" for example. Patches welcome!++ If you want to connect to some Tango devices, head over to 'Tango.Client', where you'll also find some examples.+homepage: https://github.com/pmiddend/hs-tango+bug-reports: https://github.com/pmiddend/hs-tango/issues+license: MIT+license-file: LICENSE+author: DESY+maintainer: philipp.middendorf@desy.de+copyright: 2024 Philipp Middendorf+category: Bindings, Client, Distributed Systems, FFI, Foreign, Hardware, Science+build-type: Simple+extra-doc-files: Changelog+ , README.org+extra-source-files: c_tango/src/c_tango_attribute.cpp+ , c_tango/src/c_tango_command.cpp+ , c_tango/src/c_tango_dbase.cpp+ , c_tango/src/c_tango_proxy.cpp+ , c_tango/src/c_tango.h++common warnings+ ghc-options: -Weverything -Wno-missing-safe-haskell-mode -Wno-unsafe -Wno-missing-deriving-strategies -Wno-all-missed-specialisations -Wno-monomorphism-restriction -Wno-safe -Wno-missing-local-signatures -Wno-prepositive-qualified-module -Wno-missing-kind-signatures -Wno-missed-specializations++source-repository head+ type: git+ location: https://github.com/pmiddend/hs-tango++ +library+ import: warnings+ exposed-modules: Tango.Raw.Common+ , Tango.Client+ build-depends: base >= 4.17.0 && < 5,+ derive-storable >= 0.3.1 && < 0.4,+ text >= 2.0.2 && < 3,+ unliftio >= 0.2.25 && < 0.3+ hs-source-dirs: lib+ ghc-options: -threaded+ include-dirs: c_tango/src+ hsc2hs-options: -k --define=CABAL_BINDGEN=1+ pkgconfig-depends: tango+ default-language: Haskell2010+ cxx-sources: c_tango/src/c_tango_attribute.cpp+ , c_tango/src/c_tango_command.cpp+ , c_tango/src/c_tango_dbase.cpp+ , c_tango/src/c_tango_proxy.cpp+ -- copied blindly from https://github.com/joe-warren/opencascade-hs/blob/5c087f893712585703eb8bb0ce017b6fa2a4b984/opencascade-hs/opencascade-hs.cabal+ other-modules: Paths_hs_tango+ -- This one seems to be giving problems for hackage: Hackage does not yet allow uploads of packages with autogenerated module PackageInfo_*+ -- , PackageInfo_hs_tango+ -- copied blindly from https://github.com/joe-warren/opencascade-hs/blob/5c087f893712585703eb8bb0ce017b6fa2a4b984/opencascade-hs/opencascade-hs.cabal+ autogen-modules: Paths_hs_tango+ -- This one seems to be giving problems for hackage: Hackage does not yet allow uploads of packages with autogenerated module PackageInfo_*+ -- , PackageInfo_hs_tango+ -- copied from https://github.com/joe-warren/opencascade-hs/blob/5c087f893712585703eb8bb0ce017b6fa2a4b984/opencascade-hs/opencascade-hs.cabal+ -- otherwise: undefined reference to operator new+ extra-libraries: stdc++++benchmark tango-read-test-device+ type: exitcode-stdio-1.0+ main-is: ReadTestDevice.hs+ + ghc-options: -threaded -rtsopts -with-rtsopts=-N+ hs-source-dirs:+ app+ build-depends:+ base >=4.7 && <5+ , hs-tango+ , text+
+ lib/Tango/Client.hs view
@@ -0,0 +1,1800 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}++-- |+-- Description : High-level interface to all client-related functions (mostly functions using a Device Proxy)+--+-- = General Notes+-- == Strictness+--+-- Record values are generally /strict/.+--+-- == Haskell Types+--+-- We're not using and C types when it would be user-facing. Texts are+-- encoded/decoded as 'Data.Text'. Numeric types are converted to+-- 'Int', unless it's about actual payload data (attributes and+-- commands), where the appropriately sized types are used.+--+-- Generally speaking, we convert /spectrum/ types to /Haskell lists/+-- (a vector would have been an option, and maybe we add that+-- possibility, too, if the need arises) and /image/ types to the+-- 'Image' type which, again, uses lists intenally.+--+-- == IO+--+-- The higher-level functions in this module are in 'MonadIO' instead+-- of just 'IO' so you can easily use them in your monad transformer+-- stacks.+--+-- == Errors+--+-- Errors are thrown as exceptions of type 'TangoException'. User errors (such as reading a string attribute with a "read int" function) are thrown via 'error' instead.+--+-- == Properties+--+-- The property retrieval API for Tango is elaborate, supporting different data types. We condensed this down to+-- retrieving lists of strings. Conversion needs to happen on the Haskell side for now.+--+-- = Examples+--+-- == Reading and writing a scalar, boolean attribute+--+-- >{-# LANGUAGE BlockArguments #-}+-- >{-# LANGUAGE OverloadedStrings #-}+-- >+-- >module Main where+-- >+-- >import Tango.Client+-- >+-- >main =+-- > case parseTangoUrl "sys/tg_test/1" of+-- > Left e -> error "couldn't resolve tango URL"+-- > Right deviceAddress -> withDeviceProxy deviceAddress \proxy -> do+-- > booleanResult <- readBoolAttribute proxy (AttributeName "boolean_scalar")+-- > putStrLn $ "boolean_scalar is " <> show (tangoValueRead booleanResult)+-- >+-- > writeBoolAttribute proxy (AttributeName "boolean_scalar") True+--+-- == Reading a spectrum string attribute+--+-- >{-# LANGUAGE BlockArguments #-}+-- >{-# LANGUAGE OverloadedStrings #-}+-- >+-- >module Main where+-- >+-- >import Tango.Client+-- >import qualified Data.Text.IO as TIO+-- >+-- >main =+-- > case parseTangoUrl "sys/tg_test/1" of+-- > Left e -> error "couldn't resolve tango URL"+-- > Right deviceAddress -> withDeviceProxy deviceAddress \proxy -> do+-- > result <- readBoolSpectrumAttribute proxy (AttributeName "string_spectrum_ro")+-- > mapM_ TIO.putStrLn result+module Tango.Client+ ( -- * Basics and initialization++ --++ -- | To ensure proper cleanup, you should prefer the 'withDeviceProxy' function to initialize a proxy to a device, and then do something with it.+ DeviceProxy,+ TangoUrl,+ Milliseconds (Milliseconds),+ parseTangoUrl,+ withDeviceProxy,+ newDeviceProxy,+ deleteDeviceProxy,+ TangoException (TangoException),+ RawCommon.ErrSeverity (..),+ DevFailed (DevFailed),+ devFailedDesc,+ devFailedReason,+ devFailedOrigin,+ devFailedSeverity,++ -- * Attributes+ AttributeName (AttributeName),+ AttributeInfo (AttributeInfo),+ getConfigsForAttributes,+ getConfigForAttribute,+ TangoValue (TangoValue, tangoValueRead, tangoValueWrite),+ Image (Image, imageContent, imageDimX, imageDimY),+ TangoAttrMemorizedType (NotKnown, None, Memorized, MemorizedWriteInit),++ -- ** More general types++ -- *** Reading+ readIntegralAttribute,+ readIntegralImageAttribute,+ readIntegralSpectrumAttribute,+ readRealAttribute,+ readRealImageAttribute,+ readRealSpectrumAttribute,++ -- *** Writing+ writeIntegralAttribute,+ writeIntegralImageAttribute,+ writeIntegralSpectrumAttribute,+ writeRealAttribute,+ writeRealImageAttribute,+ writeRealSpectrumAttribute,++ -- ** Specific types++ -- *** Reading+ readBoolAttribute,+ readBoolImageAttribute,+ readBoolSpectrumAttribute,+ readDoubleAttribute,+ readDoubleImageAttribute,+ readDoubleSpectrumAttribute,+ readEnumAttribute,+ readEnumImageAttribute,+ readEnumSpectrumAttribute,+ readFloatAttribute,+ readFloatImageAttribute,+ readFloatSpectrumAttribute,+ readLong64Attribute,+ readLong64ImageAttribute,+ readLong64SpectrumAttribute,+ readLongAttribute,+ readLongImageAttribute,+ readLongSpectrumAttribute,+ readShortAttribute,+ readShortImageAttribute,+ readShortSpectrumAttribute,+ readStateAttribute,+ readStateImageAttribute,+ readStateSpectrumAttribute,+ readStringAttribute,+ readStringImageAttribute,+ readStringSpectrumAttribute,+ readULong64Attribute,+ readULong64ImageAttribute,+ readULong64SpectrumAttribute,+ readULongAttribute,+ readULongImageAttribute,+ readULongSpectrumAttribute,+ readUShortAttribute,+ readUShortImageAttribute,+ readUShortSpectrumAttribute,++ -- *** Writing+ writeBoolAttribute,+ writeBoolImageAttribute,+ writeBoolSpectrumAttribute,+ writeDoubleAttribute,+ writeDoubleImageAttribute,+ writeDoubleSpectrumAttribute,+ writeEnumAttribute,+ writeEnumImageAttribute,+ writeEnumSpectrumAttribute,+ writeFloatAttribute,+ writeFloatImageAttribute,+ writeFloatSpectrumAttribute,+ writeLong64Attribute,+ writeLong64ImageAttribute,+ writeLong64SpectrumAttribute,+ writeLongAttribute,+ writeLongImageAttribute,+ writeLongSpectrumAttribute,+ writeShortAttribute,+ writeShortImageAttribute,+ writeShortSpectrumAttribute,+ writeStateAttribute,+ writeStateImageAttribute,+ writeStateSpectrumAttribute,+ writeStringAttribute,+ writeStringImageAttribute,+ writeStringSpectrumAttribute,+ writeULong64Attribute,+ writeULong64ImageAttribute,+ writeULong64SpectrumAttribute,+ writeULongAttribute,+ writeULongImageAttribute,+ writeULongSpectrumAttribute,+ writeUShortAttribute,+ writeUShortImageAttribute,+ writeUShortSpectrumAttribute,++ -- * Commands+ CommandName (CommandName),+ DisplayLevel (..),+ commandInVoidOutVoid,+ CommandData (..),+ commandInOutGeneric,+ commandInEnumOutGeneric,+ commandInGenericOutEnum,+ commandInEnumOutEnum,+ commandListQuery,+ commandQuery,+ CommandInfo (..),++ -- * Properties+ Property (..),+ PropertyName (..),+ getDeviceProperties,+ putDeviceProperties,+ deleteDeviceProperties,+ HaskellTangoDevState (Alarm, Close, Disable, Extract, Fault, Init, Insert, Moving, Off, On, Open, Running, Standby, Unknown),++ -- * Events+ subscribeEvent,+ unsubscribeEvent,+ withSubscribedEvent,+ SubscribedEvent,+ EventType (..),++ -- * Database proxy+ DatabaseProxy,+ createDatabaseProxy,+ deleteDatabaseProxy,+ withDatabaseProxy,+ databaseSearchByDeviceName,+ databaseSearchByClass,+ databaseSearchObjectsByName,+ databaseSearchObjectPropertiesByName,++ -- * Various other device-related functions+ lockDevice,+ unlockDevice,+ getAttributeNames,+ withLocked,+ setTimeout,+ getTimeout,+ pollCommand,+ stopPollCommand,+ pollAttribute,+ stopPollAttribute,+ )+where++import Control.Applicative (Applicative, pure, (<*>))+import Control.Exception (Exception, throw)+import Control.Monad (void, when, (>>=))+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Bool (Bool (False, True), otherwise, (||))+import Data.Either (Either (Left, Right))+import Data.Eq (Eq, (/=))+import Data.Foldable (any)+import Data.Function (const, id, ($), (.))+import Data.Functor (Functor, (<$>))+import Data.Int (Int, Int16, Int32, Int64)+import Data.List (drop, head, length, splitAt)+import Data.Maybe (Maybe (Just, Nothing))+import Data.Ord ((>))+import Data.Semigroup ((<>))+import Data.Text (Text, intercalate, isPrefixOf, null, pack, splitOn, unpack)+import Data.Traversable (traverse)+import Data.Word (Word16, Word64)+import Foreign (Storable)+import Foreign.C.String (CString)+import Foreign.C.Types (CInt)+import Foreign.Ptr (Ptr, nullPtr)+import System.IO (IO)+import Tango.Raw.Common+ ( DatabaseProxyPtr,+ DevFailed (DevFailed, devFailedDesc, devFailedOrigin, devFailedReason, devFailedSeverity),+ DeviceProxyPtr,+ EventType,+ HaskellAttrWriteType,+ HaskellAttributeData (HaskellAttributeData, dataFormat, dataQuality, dataType, dimX, dimY, name, nbRead, tangoAttributeData, timeStamp),+ HaskellAttributeInfoList (HaskellAttributeInfoList, attributeInfoListLength, attributeInfoListSequence),+ HaskellCommandData (HaskellCommandData, tangoCommandData),+ HaskellCommandInfo (HaskellCommandInfo, cmdDisplayLevel, cmdInType, cmdInTypeDesc, cmdName, cmdOutType, cmdOutTypeDesc, cmdTag),+ HaskellCommandInfoList (HaskellCommandInfoList, commandInfoLength, commandInfoSequence),+ HaskellDataFormat (HaskellImage, HaskellScalar, HaskellSpectrum),+ HaskellDataQuality (HaskellValid),+ HaskellDbData (HaskellDbData, dbDataLength, dbDataSequence),+ HaskellDbDatum (HaskellDbDatum, dbDatumIsEmpty, dbDatumPropData, dbDatumPropertyName, dbDatumWrongDataType),+ HaskellDispLevel,+ HaskellErrorStack (errorStackLength, errorStackSequence),+ HaskellTangoAttributeData+ ( HaskellAttributeDataBoolArray,+ HaskellAttributeDataDoubleArray,+ HaskellAttributeDataFloatArray,+ HaskellAttributeDataLong64Array,+ HaskellAttributeDataLongArray,+ HaskellAttributeDataShortArray,+ HaskellAttributeDataStateArray,+ HaskellAttributeDataStringArray,+ HaskellAttributeDataULong64Array,+ HaskellAttributeDataULongArray,+ HaskellAttributeDataUShortArray+ ),+ HaskellTangoCommandData (HaskellCommandBool, HaskellCommandCString, HaskellCommandDevEnum, HaskellCommandDevState, HaskellCommandDouble, HaskellCommandFloat, HaskellCommandInt32, HaskellCommandLong64, HaskellCommandShort, HaskellCommandULong64, HaskellCommandUShort, HaskellCommandVarBool, HaskellCommandVarCString, HaskellCommandVarDevState, HaskellCommandVarDouble, HaskellCommandVarFloat, HaskellCommandVarLong, HaskellCommandVarLong64, HaskellCommandVarShort, HaskellCommandVarULong, HaskellCommandVarULong64, HaskellCommandVarUShort, HaskellCommandVoid),+ HaskellTangoDataType (HaskellDevBoolean, HaskellDevDouble, HaskellDevEnum, HaskellDevFloat, HaskellDevInt, HaskellDevLong, HaskellDevLong64, HaskellDevShort, HaskellDevState, HaskellDevString, HaskellDevULong, HaskellDevULong64, HaskellDevUShort, HaskellDevVarBooleanArray, HaskellDevVarDoubleArray, HaskellDevVarFloatArray, HaskellDevVarLong64Array, HaskellDevVarLongArray, HaskellDevVarShortArray, HaskellDevVarStateArray, HaskellDevVarStringArray, HaskellDevVarULong64Array, HaskellDevVarULongArray, HaskellDevVarUShortArray, HaskellDevVoid),+ HaskellTangoDevState (Alarm, Close, Disable, Extract, Fault, Init, Insert, Moving, Off, On, Open, Running, Standby, Unknown),+ HaskellTangoPropertyData (HaskellPropStringArray),+ HaskellTangoVarArray (HaskellTangoVarArray, varArrayLength, varArrayValues),+ TangoAttrMemorizedType (Memorized, MemorizedWriteInit, None, NotKnown),+ Timeval (Timeval),+ createEventCallbackWrapper,+ tango_command_inout,+ tango_command_list_query,+ tango_command_query,+ tango_create_database_proxy,+ tango_create_device_proxy,+ tango_create_event_callback,+ tango_delete_database_proxy,+ tango_delete_device_property,+ tango_delete_device_proxy,+ tango_free_AttributeData,+ tango_free_AttributeInfoList,+ tango_free_CommandInfo,+ tango_free_CommandInfoList,+ tango_free_DbDatum,+ tango_free_VarStringArray,+ tango_free_event_callback,+ tango_get_attribute_config,+ tango_get_attribute_list,+ tango_get_device_exported,+ tango_get_device_exported_for_class,+ tango_get_device_property,+ tango_get_object_list,+ tango_get_object_property_list,+ tango_get_timeout_millis,+ tango_lock,+ tango_poll_attribute,+ tango_poll_command,+ tango_put_device_property,+ tango_read_attribute,+ tango_set_timeout_millis,+ tango_stop_poll_attribute,+ tango_stop_poll_command,+ tango_subscribe_event,+ tango_unlock,+ tango_unsubscribe_event,+ tango_write_attribute,+ )+import qualified Tango.Raw.Common as RawCommon+import Text.Show (Show, show)+import UnliftIO (MonadUnliftIO, bracket, finally, withRunInIO)+import UnliftIO.Foreign (CBool, CDouble, CFloat, CLong, CShort, CULong, CUShort, alloca, free, new, newArray, newCString, peek, peekArray, peekCString, with, withArray, withCString)+import Prelude (Bounded, Double, Enum (fromEnum, toEnum), Float, Fractional, Integral, Num ((*)), Real, error, fromIntegral, realToFrac)++-- | This wraps the Tango exception trace in Haskell+newtype TangoException = TangoException [DevFailed Text] deriving (Show)++instance Exception TangoException++withCStringText :: (MonadUnliftIO m) => Text -> (CString -> m a) -> m a+withCStringText t = withCString (unpack t)++peekCStringText :: (MonadUnliftIO m) => CString -> m Text+peekCStringText x = do+ result <- liftIO (peekCString x)+ pure (pack result)++peekCStringArrayText :: (MonadUnliftIO m, Integral i) => i -> Ptr CString -> m [Text]+peekCStringArrayText len x = do+ ptrList <- liftIO $ peekArray (fromIntegral len) x+ traverse peekCStringText ptrList++-- | Execute a Tango action that potentially returns an error; convert this error into 'TangoException'+checkResult :: (MonadUnliftIO m) => m (Ptr HaskellErrorStack) -> m ()+checkResult action = do+ es <- action+ when (es /= nullPtr) $ do+ errorStack <- liftIO $ peek es+ stackItems <- peekArray (fromIntegral (errorStackLength errorStack)) (errorStackSequence errorStack)+ formattedStackItems :: [DevFailed Text] <- traverse (traverse peekCStringText) stackItems+ throw (TangoException formattedStackItems)++-- | Newtype wrapper around a Tango URL like @tango:\/\/host:port\/foo\/bar\/baz@. Retrieve via 'parseTangoUrl'+newtype TangoUrl = TangoUrl Text++-- | Try to parse a Tango URL like @tango:\/\/host:port\/foo\/bar\/baz@ (the left side of the @Either@ will be an error message)+parseTangoUrl :: Text -> Either Text TangoUrl+parseTangoUrl url =+ let tangoUrlFromText' url' =+ let urlComponents = splitOn "/" url'+ in if length urlComponents /= 3 || any null urlComponents+ then Left $ "\"" <> url <> "\" is not a valid tango URL: has to be of the form \"[tango://host:port/]domain/family/member\""+ else Right (TangoUrl url)+ in tangoUrlFromText' $+ if "tango://" `isPrefixOf` url+ then intercalate "/" $ drop 3 (splitOn "/" url)+ else url++-- | Wraps a pointer to a device proxy+newtype DeviceProxy = DeviceProxy DeviceProxyPtr++-- | This just looks nicer because not a pointer+type DatabaseProxy = DatabaseProxyPtr++boolToCBool :: Bool -> CBool+boolToCBool True = 1+boolToCBool False = 0++cboolToBool :: CBool -> Bool+cboolToBool x+ | x > 0 = True+ | otherwise = False++-- | Create a new device proxy (check 'deleteDeviceProxy' and 'withDeviceProxy', too)+newDeviceProxy :: forall m. (MonadUnliftIO m) => TangoUrl -> m DeviceProxy+newDeviceProxy (TangoUrl url) = liftIO $+ alloca $ \proxyPtrPtr -> do+ withCString (unpack url) $ \proxyName -> do+ checkResult (tango_create_device_proxy proxyName proxyPtrPtr)+ DeviceProxy <$> peek proxyPtrPtr++-- | Delete a device proxy (check 'newDeviceProxy' and 'withDeviceProxy', too)+deleteDeviceProxy :: forall m. (MonadUnliftIO m) => DeviceProxy -> m ()+deleteDeviceProxy (DeviceProxy proxyPtr) = liftIO $ checkResult (tango_delete_device_proxy proxyPtr)++-- | Safely initialize and clean up a device proxy for a given tango URL+withDeviceProxy :: forall m a. (MonadUnliftIO m) => TangoUrl -> (DeviceProxy -> m a) -> m a+withDeviceProxy (TangoUrl proxyAddress) =+ let initialize :: m DeviceProxy+ initialize =+ liftIO $ alloca \proxyPtrPtr -> do+ withCStringText proxyAddress \proxyAddressPtr -> do+ checkResult (tango_create_device_proxy proxyAddressPtr proxyPtrPtr)+ DeviceProxy <$> peek proxyPtrPtr+ deinitialize :: DeviceProxy -> m ()+ deinitialize (DeviceProxy proxyPtrPtr) =+ liftIO $ checkResult (tango_delete_device_proxy proxyPtrPtr)+ in bracket initialize deinitialize++writeScalarAttribute ::+ (MonadUnliftIO m, Storable tangoType) =>+ DeviceProxy ->+ AttributeName ->+ tangoType ->+ HaskellTangoDataType ->+ (HaskellTangoVarArray tangoType -> HaskellTangoAttributeData) ->+ m ()+writeScalarAttribute (DeviceProxy proxyPtr) (AttributeName attributeName) newValue tangoType intract = do+ withCStringText attributeName $ \attributeNamePtr ->+ with newValue $ \newValuePtr ->+ with+ ( HaskellAttributeData+ { dataFormat = HaskellScalar,+ dataQuality = HaskellValid,+ nbRead = 0,+ name = attributeNamePtr,+ dimX = 1,+ dimY = 1,+ timeStamp = Timeval 0 0,+ dataType = tangoType,+ tangoAttributeData = intract (HaskellTangoVarArray 1 newValuePtr)+ }+ )+ (liftIO . void . tango_write_attribute proxyPtr)++writeSpectrumAttribute ::+ (MonadUnliftIO m, Storable tangoType) =>+ DeviceProxy ->+ AttributeName ->+ [tangoType] ->+ HaskellTangoDataType ->+ (HaskellTangoVarArray tangoType -> HaskellTangoAttributeData) ->+ m ()+writeSpectrumAttribute (DeviceProxy proxyPtr) (AttributeName attributeName) newValues tangoType intract =+ withCStringText attributeName $ \attributeNamePtr ->+ withArray newValues \newValuesPtr ->+ with+ ( HaskellAttributeData+ { dataFormat = HaskellSpectrum,+ dataQuality = HaskellValid,+ nbRead = 0,+ name = attributeNamePtr,+ dimX = fromIntegral (length newValues),+ dimY = 1,+ timeStamp = Timeval 0 0,+ dataType = tangoType,+ tangoAttributeData = intract (HaskellTangoVarArray (fromIntegral (length newValues)) newValuesPtr)+ }+ )+ (liftIO . void . tango_write_attribute proxyPtr)++writeImageAttribute ::+ (MonadUnliftIO m, Storable tangoType) =>+ DeviceProxy ->+ AttributeName ->+ Image tangoType ->+ HaskellTangoDataType ->+ (HaskellTangoVarArray tangoType -> HaskellTangoAttributeData) ->+ m ()+writeImageAttribute (DeviceProxy proxyPtr) (AttributeName attributeName) newImage tangoType intract =+ withCStringText attributeName $ \attributeNamePtr ->+ withArray (imageContent newImage) \newValuesPtr ->+ with+ ( HaskellAttributeData+ { dataFormat = HaskellImage,+ dataQuality = HaskellValid,+ nbRead = 0,+ name = attributeNamePtr,+ dimX = fromIntegral (imageDimX newImage),+ dimY = fromIntegral (imageDimY newImage),+ timeStamp = Timeval 0 0,+ dataType = tangoType,+ tangoAttributeData = intract (HaskellTangoVarArray (fromIntegral (length (imageContent newImage))) newValuesPtr)+ }+ )+ (liftIO . void . tango_write_attribute proxyPtr)++-- | Read an attribute irrespective of the concrete integral type. This just uses 'fromIntegral' internally to convert from any integral type. However, we do query the attribute type beforehand, making this two calls instead of just one. If you're really concerned about performance, try to find out the real type of the attribute.+writeIntegralAttribute :: (MonadUnliftIO m, Integral i) => DeviceProxy -> AttributeName -> i -> m ()+writeIntegralAttribute proxy attributeName newValue = do+ config <- getConfigForAttribute proxy attributeName+ case attributeInfoDataType config of+ HaskellDevShort ->+ writeShortAttribute proxy attributeName (fromIntegral newValue)+ HaskellDevUShort ->+ writeUShortAttribute proxy attributeName (fromIntegral newValue)+ HaskellDevLong ->+ writeLongAttribute proxy attributeName (fromIntegral newValue)+ HaskellDevULong ->+ writeULongAttribute proxy attributeName (fromIntegral newValue)+ HaskellDevLong64 ->+ writeLong64Attribute proxy attributeName (fromIntegral newValue)+ HaskellDevULong64 ->+ writeULong64Attribute proxy attributeName (fromIntegral newValue)+ _ -> error $ "tried to write integral attribute " <> show attributeName <> " but the attribute is not an integral type"++-- | Read a spectrum attribute irrespective of the concrete integral type. This just uses 'fromIntegral' internally to convert from any integral type. However, we do query the attribute type beforehand, making this two calls instead of just one. If you're really concerned about performance, try to find out the real type of the attribute.+writeIntegralSpectrumAttribute :: (MonadUnliftIO m, Integral i) => DeviceProxy -> AttributeName -> [i] -> m ()+writeIntegralSpectrumAttribute proxy attributeName newValues = do+ config <- getConfigForAttribute proxy attributeName+ case attributeInfoDataType config of+ HaskellDevVarShortArray ->+ writeShortSpectrumAttribute proxy attributeName (fromIntegral <$> newValues)+ HaskellDevVarUShortArray ->+ writeUShortSpectrumAttribute proxy attributeName (fromIntegral <$> newValues)+ HaskellDevVarLongArray ->+ writeLongSpectrumAttribute proxy attributeName (fromIntegral <$> newValues)+ HaskellDevVarULongArray ->+ writeULongSpectrumAttribute proxy attributeName (fromIntegral <$> newValues)+ HaskellDevVarLong64Array ->+ writeLong64SpectrumAttribute proxy attributeName (fromIntegral <$> newValues)+ HaskellDevVarULong64Array ->+ writeULong64SpectrumAttribute proxy attributeName (fromIntegral <$> newValues)+ _ -> error $ "tried to write integral attribute " <> show attributeName <> " but the attribute is not an integral type"++-- | Read a spectrum attribute irrespective of the concrete integral type. This just uses 'fromIntegral' internally to convert from any integral type. However, we do query the attribute type beforehand, making this two calls instead of just one. If you're really concerned about performance, try to find out the real type of the attribute.+writeIntegralImageAttribute :: (MonadUnliftIO m, Integral i) => DeviceProxy -> AttributeName -> Image i -> m ()+writeIntegralImageAttribute proxy attributeName newValues = do+ config <- getConfigForAttribute proxy attributeName+ case attributeInfoDataType config of+ HaskellDevVarShortArray ->+ writeShortImageAttribute proxy attributeName (fromIntegral <$> newValues)+ HaskellDevVarUShortArray ->+ writeUShortImageAttribute proxy attributeName (fromIntegral <$> newValues)+ HaskellDevVarLongArray ->+ writeLongImageAttribute proxy attributeName (fromIntegral <$> newValues)+ HaskellDevVarULongArray ->+ writeULongImageAttribute proxy attributeName (fromIntegral <$> newValues)+ HaskellDevVarLong64Array ->+ writeLong64ImageAttribute proxy attributeName (fromIntegral <$> newValues)+ HaskellDevVarULong64Array ->+ writeULong64ImageAttribute proxy attributeName (fromIntegral <$> newValues)+ _ -> error $ "tried to write integral attribute " <> show attributeName <> " but the attribute is not an integral type"++-- | Read a spectrum attribute irrespective of the concrete integral type. This just uses 'fromIntegral' internally to convert from any integral type. However, we do query the attribute type beforehand, making this two calls instead of just one. If you're really concerned about performance, try to find out the real type of the attribute.+writeRealImageAttribute :: (MonadUnliftIO m, Real i) => DeviceProxy -> AttributeName -> Image i -> m ()+writeRealImageAttribute proxy attributeName newValues = do+ config <- getConfigForAttribute proxy attributeName+ case attributeInfoDataType config of+ HaskellDevFloat ->+ writeFloatImageAttribute proxy attributeName (realToFrac <$> newValues)+ HaskellDevDouble ->+ writeDoubleImageAttribute proxy attributeName (realToFrac <$> newValues)+ _ -> error $ "tried to write real attribute " <> show attributeName <> " but the attribute is not a real type"++-- | Read an attribute irrespective of the concrete integral type. This just uses 'fromIntegral' internally to convert from any integral type. However, we do query the attribute type beforehand, making this two calls instead of just one. If you're really concerned about performance, try to find out the real type of the attribute.+writeRealAttribute :: (MonadUnliftIO m, Real i) => DeviceProxy -> AttributeName -> i -> m ()+writeRealAttribute proxy attributeName newValue = do+ config <- getConfigForAttribute proxy attributeName+ case attributeInfoDataType config of+ HaskellDevFloat ->+ writeFloatAttribute proxy attributeName (realToFrac newValue)+ HaskellDevDouble ->+ writeDoubleAttribute proxy attributeName (realToFrac newValue)+ _ -> error $ "tried to write real attribute " <> show attributeName <> " but the attribute is not a real type"++-- | Read a spectrum attribute irrespective of the concrete real type. This just uses 'realToFrac' internally to convert from any integral type. However, we do query the attribute type beforehand, making this two calls instead of just one. If you're really concerned about performance, try to find out the real type of the attribute.+writeRealSpectrumAttribute :: (MonadUnliftIO m, Real i) => DeviceProxy -> AttributeName -> [i] -> m ()+writeRealSpectrumAttribute proxy attributeName newValues = do+ config <- getConfigForAttribute proxy attributeName+ case attributeInfoDataType config of+ HaskellDevVarFloatArray ->+ writeFloatSpectrumAttribute proxy attributeName (realToFrac <$> newValues)+ HaskellDevVarDoubleArray ->+ writeDoubleSpectrumAttribute proxy attributeName (realToFrac <$> newValues)+ _ -> error $ "tried to write real attribute " <> show attributeName <> " but the attribute is not a real type"++-- | Write a boolean scalar attribute+writeBoolAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Bool -> m ()+writeBoolAttribute proxy attributeName newValue =+ writeScalarAttribute proxy attributeName (boolToCBool newValue) HaskellDevBoolean HaskellAttributeDataBoolArray++-- | Write a boolean spectrum attribute+writeBoolSpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> [Bool] -> m ()+writeBoolSpectrumAttribute proxy attributeName newValues =+ writeSpectrumAttribute proxy attributeName (boolToCBool <$> newValues) HaskellDevBoolean HaskellAttributeDataBoolArray++-- | Write a boolean image attribute+writeBoolImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Image Bool -> m ()+writeBoolImageAttribute proxy attributeName newImage =+ writeImageAttribute proxy attributeName (boolToCBool <$> newImage) HaskellDevBoolean HaskellAttributeDataBoolArray++-- | Write a short scalar attribute+writeShortAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Int16 -> m ()+writeShortAttribute proxy attributeName newValue =+ writeScalarAttribute proxy attributeName (fromIntegral newValue) HaskellDevShort HaskellAttributeDataShortArray++-- | Write a short spectrum attribute+writeShortSpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> [Int16] -> m ()+writeShortSpectrumAttribute proxy attributeName newValues =+ writeSpectrumAttribute proxy attributeName (fromIntegral <$> newValues) HaskellDevShort HaskellAttributeDataShortArray++-- | Write a short image attribute+writeShortImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Image Int16 -> m ()+writeShortImageAttribute proxy attributeName newImage =+ writeImageAttribute proxy attributeName (fromIntegral <$> newImage) HaskellDevShort HaskellAttributeDataShortArray++-- | Write an unsigned short scalar attribute+writeUShortAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Word16 -> m ()+writeUShortAttribute proxy attributeName newValue =+ writeScalarAttribute proxy attributeName (fromIntegral newValue) HaskellDevUShort HaskellAttributeDataUShortArray++-- | Write an unsigned short spectrum attribute+writeUShortSpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> [Word16] -> m ()+writeUShortSpectrumAttribute proxy attributeName newValues =+ writeSpectrumAttribute proxy attributeName (fromIntegral <$> newValues) HaskellDevUShort HaskellAttributeDataUShortArray++-- | Write an unsigned short image attribute+writeUShortImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Image Word16 -> m ()+writeUShortImageAttribute proxy attributeName newImage =+ writeImageAttribute proxy attributeName (fromIntegral <$> newImage) HaskellDevUShort HaskellAttributeDataUShortArray++-- | Write a long scalar attribute+writeLongAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Int64 -> m ()+writeLongAttribute proxy attributeName newValue =+ writeScalarAttribute proxy attributeName (fromIntegral newValue) HaskellDevLong HaskellAttributeDataLongArray++-- | Write a long spectrum attribute+writeLongSpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> [Int64] -> m ()+writeLongSpectrumAttribute proxy attributeName newValues =+ writeSpectrumAttribute proxy attributeName (fromIntegral <$> newValues) HaskellDevLong HaskellAttributeDataLongArray++-- | Write a long image attribute+writeLongImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Image Int64 -> m ()+writeLongImageAttribute proxy attributeName newImage =+ writeImageAttribute proxy attributeName (fromIntegral <$> newImage) HaskellDevLong HaskellAttributeDataLongArray++-- | Write an unsigned long scalar attribute+writeULongAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Word64 -> m ()+writeULongAttribute proxy attributeName newValue =+ writeScalarAttribute proxy attributeName (fromIntegral newValue) HaskellDevULong HaskellAttributeDataULongArray++-- | Write an unsigned long spectrum attribute+writeULongSpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> [Word64] -> m ()+writeULongSpectrumAttribute proxy attributeName newValues =+ writeSpectrumAttribute proxy attributeName (fromIntegral <$> newValues) HaskellDevULong HaskellAttributeDataULongArray++-- | Write an unsigned long image attribute+writeULongImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Image Word64 -> m ()+writeULongImageAttribute proxy attributeName newImage =+ writeImageAttribute proxy attributeName (fromIntegral <$> newImage) HaskellDevULong HaskellAttributeDataULongArray++-- | Write an unsigned long64 scalar attribute+writeULong64Attribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Word64 -> m ()+writeULong64Attribute proxy attributeName newValue =+ writeScalarAttribute proxy attributeName (fromIntegral newValue) HaskellDevULong64 HaskellAttributeDataULong64Array++-- | Write an unsigned long64 spectrum attribute+writeULong64SpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> [Word64] -> m ()+writeULong64SpectrumAttribute proxy attributeName newValues =+ writeSpectrumAttribute proxy attributeName (fromIntegral <$> newValues) HaskellDevULong64 HaskellAttributeDataULong64Array++-- | Write an unsigned long64 image attribute+writeULong64ImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Image Word64 -> m ()+writeULong64ImageAttribute proxy attributeName newImage =+ writeImageAttribute proxy attributeName (fromIntegral <$> newImage) HaskellDevULong64 HaskellAttributeDataULong64Array++-- | Write a float scalar attribute+writeFloatAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Double -> m ()+writeFloatAttribute proxy attributeName newValue =+ writeScalarAttribute proxy attributeName (realToFrac newValue) HaskellDevFloat HaskellAttributeDataFloatArray++-- | Write a float spectrum attribute+writeFloatSpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> [Double] -> m ()+writeFloatSpectrumAttribute proxy attributeName newValues =+ writeSpectrumAttribute proxy attributeName (realToFrac <$> newValues) HaskellDevFloat HaskellAttributeDataFloatArray++-- | Write a float image attribute+writeFloatImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Image Double -> m ()+writeFloatImageAttribute proxy attributeName newImage =+ writeImageAttribute proxy attributeName (realToFrac <$> newImage) HaskellDevFloat HaskellAttributeDataFloatArray++-- | Write a double scalar attribute+writeDoubleAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Double -> m ()+writeDoubleAttribute proxy attributeName newValue =+ writeScalarAttribute proxy attributeName (realToFrac newValue) HaskellDevDouble HaskellAttributeDataDoubleArray++-- | Write a double spectrum attribute+writeDoubleSpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> [Double] -> m ()+writeDoubleSpectrumAttribute proxy attributeName newValues =+ writeSpectrumAttribute proxy attributeName (realToFrac <$> newValues) HaskellDevDouble HaskellAttributeDataDoubleArray++-- | Write a double image attribute+writeDoubleImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Image Double -> m ()+writeDoubleImageAttribute proxy attributeName newImage =+ writeImageAttribute proxy attributeName (realToFrac <$> newImage) HaskellDevDouble HaskellAttributeDataDoubleArray++-- | Write a state scalar attribute+writeStateAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> HaskellTangoDevState -> m ()+writeStateAttribute proxy attributeName newValue =+ writeScalarAttribute proxy attributeName newValue HaskellDevState HaskellAttributeDataStateArray++-- | Write a state spectrum attribute+writeStateSpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> [HaskellTangoDevState] -> m ()+writeStateSpectrumAttribute proxy attributeName newValues =+ writeSpectrumAttribute proxy attributeName newValues HaskellDevState HaskellAttributeDataStateArray++-- | Write a state image attribute+writeStateImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Image HaskellTangoDevState -> m ()+writeStateImageAttribute proxy attributeName newImage =+ writeImageAttribute proxy attributeName newImage HaskellDevState HaskellAttributeDataStateArray++-- | Write an enum scalar attribute+writeEnumAttribute :: (MonadUnliftIO m, Enum t) => DeviceProxy -> AttributeName -> t -> m ()+writeEnumAttribute proxy attributeName newValue =+ writeScalarAttribute proxy attributeName (fromIntegral (fromEnum newValue)) HaskellDevEnum HaskellAttributeDataShortArray++-- | Write an enum spectrum attribute+writeEnumSpectrumAttribute :: (MonadUnliftIO m, Enum t) => DeviceProxy -> AttributeName -> [t] -> m ()+writeEnumSpectrumAttribute proxy attributeName newValues =+ writeSpectrumAttribute proxy attributeName (fromIntegral . fromEnum <$> newValues) HaskellDevEnum HaskellAttributeDataShortArray++-- | Write an enum image attribute+writeEnumImageAttribute :: (MonadUnliftIO m, Enum t) => DeviceProxy -> AttributeName -> Image t -> m ()+writeEnumImageAttribute proxy attributeName newImage =+ writeImageAttribute proxy attributeName (fromIntegral . fromEnum <$> newImage) HaskellDevEnum HaskellAttributeDataShortArray++-- | Write a string scalar attribute+writeStringAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Text -> m ()+writeStringAttribute (DeviceProxy proxyPtr) (AttributeName attributeName) newValue =+ withCStringText attributeName \attributeNameC -> do+ withCStringText newValue \newValuePtr ->+ with newValuePtr \newValuePtrPtr ->+ with+ ( HaskellAttributeData+ { dataFormat = HaskellScalar,+ dataQuality = HaskellValid,+ nbRead = 0,+ name = attributeNameC,+ dimX = 1,+ dimY = 1,+ timeStamp = Timeval 0 0,+ dataType = HaskellDevString,+ tangoAttributeData = HaskellAttributeDataStringArray (HaskellTangoVarArray 1 newValuePtrPtr)+ }+ )+ (liftIO . void . tango_write_attribute proxyPtr)++-- | Write a string spectrum attribute+writeStringSpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> [Text] -> m ()+writeStringSpectrumAttribute (DeviceProxy proxyPtr) (AttributeName attributeName) newValues =+ withCStringText attributeName \attributeNameC ->+ bracket (traverse (newCString . unpack) newValues) (traverse free) \stringPointerList ->+ withArray stringPointerList \stringPointerPtr ->+ with+ ( HaskellAttributeData+ { dataFormat = HaskellSpectrum,+ dataQuality = HaskellValid,+ nbRead = 0,+ name = attributeNameC,+ dimX = fromIntegral (length newValues),+ dimY = 1,+ timeStamp = Timeval 0 0,+ dataType = HaskellDevString,+ tangoAttributeData = HaskellAttributeDataStringArray (HaskellTangoVarArray (fromIntegral (length newValues)) stringPointerPtr)+ }+ )+ (liftIO . void . tango_write_attribute proxyPtr)++-- | Write a string image attribute+writeStringImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Image Text -> m ()+writeStringImageAttribute (DeviceProxy proxyPtr) (AttributeName attributeName) (Image newImage imageX imageY) =+ withCStringText attributeName \attributeNameC ->+ bracket (traverse (newCString . unpack) newImage) (traverse free) \stringPointerList ->+ withArray stringPointerList \stringPointerPtr ->+ with+ ( HaskellAttributeData+ { dataFormat = HaskellSpectrum,+ dataQuality = HaskellValid,+ nbRead = 0,+ name = attributeNameC,+ dimX = fromIntegral imageX,+ dimY = fromIntegral imageY,+ timeStamp = Timeval 0 0,+ dataType = HaskellDevString,+ tangoAttributeData = HaskellAttributeDataStringArray (HaskellTangoVarArray (fromIntegral (imageX * imageY)) stringPointerPtr)+ }+ )+ (liftIO . void . tango_write_attribute proxyPtr)++-- | Write a long64 scalar attribute+writeLong64Attribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Int64 -> m ()+writeLong64Attribute proxy attributeName newValue =+ writeScalarAttribute proxy attributeName (fromIntegral newValue) HaskellDevLong64 HaskellAttributeDataLong64Array++-- | Write a long64 spectrum attribute+writeLong64SpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> [Int64] -> m ()+writeLong64SpectrumAttribute proxy attributeName newValues =+ writeSpectrumAttribute proxy attributeName (fromIntegral <$> newValues) HaskellDevLong64 HaskellAttributeDataLong64Array++-- | Write a long64 image attribute+writeLong64ImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Image Int64 -> m ()+writeLong64ImageAttribute proxy attributeName newImage =+ writeImageAttribute proxy attributeName (fromIntegral <$> newImage) HaskellDevLong64 HaskellAttributeDataLong64Array++-- | Newtype wrapper to wrap an attribute name+newtype AttributeName = AttributeName Text deriving (Show)++-- | Read an attribute's value, call a function on it, and free it up again+withReadAttribute :: (MonadUnliftIO m) => DeviceProxyPtr -> CString -> (HaskellAttributeData -> m a) -> m a+withReadAttribute proxyPtr attributeNameC f = alloca \haskellAttributeDataPtr -> do+ liftIO $ checkResult (tango_read_attribute proxyPtr attributeNameC haskellAttributeDataPtr)+ haskellAttributeData <- liftIO $ peek haskellAttributeDataPtr+ finally (f haskellAttributeData) (liftIO $ tango_free_AttributeData haskellAttributeDataPtr)++-- | Read an attribute's value, maybe extract something useful from it, convert that, and free the Tango data up again.+withExtractedAttributeValue :: (MonadUnliftIO m) => (HaskellAttributeData -> m (Maybe a)) -> DeviceProxy -> AttributeName -> (a -> m b) -> m b+withExtractedAttributeValue extractValue (DeviceProxy proxyPtr) (AttributeName attributeNameHaskell) f =+ withCStringText attributeNameHaskell $ \attributeNameC -> withReadAttribute proxyPtr attributeNameC \haskellAttributeData -> do+ extractedValue <- extractValue haskellAttributeData+ case extractedValue of+ Nothing -> error ("invalid type for attribute \"" <> unpack attributeNameHaskell <> "\"")+ Just v -> f v++readAttributeGeneral :: (MonadIO m) => (HaskellAttributeData -> IO (Maybe a)) -> DeviceProxy -> AttributeName -> m a+readAttributeGeneral extractValue (DeviceProxy proxyPtr) (AttributeName attributeNameHaskell) =+ liftIO $ withCStringText attributeNameHaskell $ \attributeName -> do+ alloca $ \haskellAttributeDataPtr -> do+ checkResult (tango_read_attribute proxyPtr attributeName haskellAttributeDataPtr)+ haskellAttributeData <- peek haskellAttributeDataPtr+ extractedValue <- extractValue haskellAttributeData+ case extractedValue of+ Nothing -> error ("invalid type for attribute \"" <> unpack attributeNameHaskell <> "\"")+ Just v ->+ pure v++data AtLeastTwo a = AtLeastTwo a a [a]++-- | Call 'withExtractedAttributeValue' to read an attribute's value (safely), extract the array within, and call a function that makes the parsed contents into something more useful.+readAttributeSimple ::+ (Storable a, Show a, MonadUnliftIO m) =>+ -- | Extract a specific type of data array (usually extracting a single data type like bool, long, ...)+ (HaskellTangoAttributeData -> Maybe (HaskellTangoVarArray a)) ->+ -- | After taking at least two elements from the array given by the previous function, call this function and turn the whole thing into something useful+ (HaskellAttributeData -> AtLeastTwo a -> m b) ->+ DeviceProxy ->+ AttributeName ->+ m b+readAttributeSimple extractValue convertValue proxy attributeName = withExtractedAttributeValue (\d -> pure ((d,) <$> extractValue (tangoAttributeData d))) proxy attributeName \(attributeData, tangoArray) -> do+ arrayElements <- peekArray (fromIntegral (varArrayLength tangoArray)) (varArrayValues tangoArray)+ case arrayElements of+ (first : second : rest) -> convertValue attributeData (AtLeastTwo first second rest)+ _ -> error $ "couldn't read attribute " <> show attributeName <> ": expected a value array of length at least two, but got " <> show arrayElements++readAttributeSimple' ::+ (MonadIO m, Show a) =>+ (HaskellTangoAttributeData -> IO (Maybe [a])) ->+ (HaskellAttributeData -> AtLeastTwo a -> m b) ->+ DeviceProxy ->+ AttributeName ->+ m b+readAttributeSimple' extractValue convertValue proxy attributeName = do+ (attributeData, tangoArray) <- readAttributeGeneral (\d -> ((d,) <$>) <$> extractValue (tangoAttributeData d)) proxy attributeName+ case tangoArray of+ (first : second : rest) -> convertValue attributeData (AtLeastTwo first second rest)+ _ -> error $ "couldn't read attribute " <> show attributeName <> ": expected a value array of length at least two, but got " <> show tangoArray++convertGenericScalar :: (Applicative f) => (a -> b) -> HaskellAttributeData -> AtLeastTwo a -> f (TangoValue b)+convertGenericScalar f _ (AtLeastTwo first second _) = pure (TangoValue (f first) (f second))++convertGenericSpectrum :: (Applicative f) => (a -> b) -> HaskellAttributeData -> AtLeastTwo a -> f (TangoValue [b])+convertGenericSpectrum f (HaskellAttributeData {dimX}) (AtLeastTwo first second remainder) =+ let wholeList = f <$> (first : second : remainder)+ (readValue, writeValue) = splitAt (fromIntegral dimX) wholeList+ in pure (TangoValue readValue writeValue)++convertGenericSpectrum' :: (Applicative f) => HaskellAttributeData -> AtLeastTwo a -> f (TangoValue [a])+convertGenericSpectrum' (HaskellAttributeData {dimX}) (AtLeastTwo first second remainder) =+ let wholeList = first : second : remainder+ (readValue, writeValue) = splitAt (fromIntegral dimX) wholeList+ in pure (TangoValue readValue writeValue)++convertGenericImage :: (Applicative f) => (a1 -> a2) -> HaskellAttributeData -> AtLeastTwo a1 -> f (TangoValue (Image a2))+convertGenericImage f (HaskellAttributeData {dimX, dimY}) (AtLeastTwo first second remainder) =+ let wholeList = f <$> (first : second : remainder)+ (readValue, writeValue) = splitAt (fromIntegral (dimX * dimY)) wholeList+ in pure+ ( TangoValue+ (Image readValue (fromIntegral dimX) (fromIntegral dimY))+ (Image writeValue (fromIntegral dimX) (fromIntegral dimY))+ )++convertGenericImage' :: (Applicative f) => HaskellAttributeData -> AtLeastTwo a1 -> f (TangoValue (Image a1))+convertGenericImage' (HaskellAttributeData {dimX, dimY}) (AtLeastTwo first second remainder) =+ let wholeList = first : second : remainder+ (readValue, writeValue) = splitAt (fromIntegral (dimX * dimY)) wholeList+ in pure+ ( TangoValue+ (Image readValue (fromIntegral dimX) (fromIntegral dimY))+ (Image writeValue (fromIntegral dimX) (fromIntegral dimY))+ )++-- | Represents an attribute's value, with read and write part, for different data types. Fields for quality etc. are currently missing+data TangoValue a = TangoValue+ { -- | Read part of the attribute's value+ tangoValueRead :: a,+ -- | Write part of the attribute's value+ tangoValueWrite :: a+ }+ deriving (Show)++-- | Represents an image attribute's value+data Image a = Image+ { -- | Image pixels+ imageContent :: ![a],+ -- | X dimension of the image+ imageDimX :: !Int,+ -- | Y dimension of the image+ imageDimY :: !Int+ }+ deriving (Show, Functor)++-- | Read an attribute irrespective of the concrete integral type. This just uses 'fromIntegral' internally.+readIntegralAttribute :: forall m i. (MonadUnliftIO m, Integral i, Show i) => DeviceProxy -> AttributeName -> m (TangoValue i)+readIntegralAttribute = readAttributeSimple' extractIntegral (convertGenericScalar id)++extractIntegral :: (Integral i, MonadUnliftIO m) => HaskellTangoAttributeData -> m (Maybe [i])+extractIntegral (HaskellAttributeDataLongArray a) = do+ arrayElements <- peekArray (fromIntegral (varArrayLength a)) (varArrayValues a)+ pure $ Just (fromIntegral <$> arrayElements)+extractIntegral _ = pure Nothing++-- | Read a spectrum attribute irrespective of the concrete integral element type. This just uses 'fromIntegral' internally.+readIntegralSpectrumAttribute :: (MonadUnliftIO m, Integral i, Show i) => DeviceProxy -> AttributeName -> m (TangoValue [i])+readIntegralSpectrumAttribute = readAttributeSimple' extractIntegral convertGenericSpectrum'++-- | Read a spectrum image attribute irrespective of the concrete integral element type. This just uses 'fromIntegral' internally.+readIntegralImageAttribute :: (MonadUnliftIO m, Integral i, Show i) => DeviceProxy -> AttributeName -> m (TangoValue (Image i))+readIntegralImageAttribute = readAttributeSimple' extractIntegral convertGenericImage'++extractReal :: (Fractional i, MonadUnliftIO m) => HaskellTangoAttributeData -> m (Maybe [i])+extractReal (HaskellAttributeDataDoubleArray a) = do+ arrayElements <- peekArray (fromIntegral (varArrayLength a)) (varArrayValues a)+ pure $ Just (realToFrac <$> arrayElements)+extractReal (HaskellAttributeDataFloatArray a) = do+ arrayElements <- peekArray (fromIntegral (varArrayLength a)) (varArrayValues a)+ pure $ Just (realToFrac <$> arrayElements)+extractReal _ = pure Nothing++-- | Read an attribute irrespective of the concrete real type. This just uses 'realToFrac' internally.+readRealAttribute :: forall m i. (MonadUnliftIO m, Fractional i, Show i) => DeviceProxy -> AttributeName -> m (TangoValue i)+readRealAttribute = readAttributeSimple' extractReal (convertGenericScalar id)++-- | Read a spectrum attribute irrespective of the concrete real element type. This just uses 'realToFrac' internally.+readRealSpectrumAttribute :: (MonadUnliftIO m, Fractional i, Show i) => DeviceProxy -> AttributeName -> m (TangoValue [i])+readRealSpectrumAttribute = readAttributeSimple' extractReal convertGenericSpectrum'++-- | Read a spectrum image attribute irrespective of the concrete integral element type. This just uses 'realToFrac' internally.+readRealImageAttribute :: (MonadUnliftIO m, Fractional i, Show i) => DeviceProxy -> AttributeName -> m (TangoValue (Image i))+readRealImageAttribute = readAttributeSimple' extractReal convertGenericImage'++extractBool :: HaskellTangoAttributeData -> Maybe (HaskellTangoVarArray CBool)+extractBool (HaskellAttributeDataBoolArray a) = Just a+extractBool _ = Nothing++-- | Read a boolean-type scalar attribute, fail hard if it's not really a bool+readBoolAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue Bool)+readBoolAttribute = readAttributeSimple extractBool (convertGenericScalar cboolToBool)++-- | Read a boolean-type spectrum (list) attribute, fail hard if it's not really a bool+readBoolSpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue [Bool])+readBoolSpectrumAttribute = readAttributeSimple extractBool (convertGenericSpectrum cboolToBool)++-- | Read a boolean-type image attribute, fail hard if it's not really a bool+readBoolImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue (Image Bool))+readBoolImageAttribute = readAttributeSimple extractBool (convertGenericImage cboolToBool)++-- | Read a string attribute and decode it into a text, fail hard if it's not really a string.+readStringAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue Text)+readStringAttribute = readAttributeSimple extract convert+ where+ extract (HaskellAttributeDataStringArray a) = Just a+ extract _ = Nothing+ convert _ (AtLeastTwo read write []) = TangoValue <$> peekCStringText read <*> peekCStringText write+ convert _ _ = error "expected a read and a write value for attribute, got more elements"++-- | Read a string spectrum (array/list) attribute and decode it into a text+readStringSpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue [Text])+readStringSpectrumAttribute = readAttributeSimple extract convert+ where+ extract (HaskellAttributeDataStringArray a) = Just a+ extract _ = Nothing+ convert (HaskellAttributeData {dimX}) (AtLeastTwo first second remainder) = do+ wholeList <- traverse peekCStringText (first : second : remainder)+ let (readValue, writeValue) = splitAt (fromIntegral dimX) wholeList+ pure (TangoValue readValue writeValue)++-- | Read a string image attribute and decode it into a text+readStringImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue (Image Text))+readStringImageAttribute = readAttributeSimple extract convert+ where+ extract (HaskellAttributeDataStringArray a) = Just a+ extract _ = Nothing+ convert (HaskellAttributeData {dimX, dimY}) (AtLeastTwo first second remainder) = do+ wholeList <- traverse peekCStringText (first : second : remainder)+ let (readValue, writeValue) = splitAt (fromIntegral (dimX * dimY)) wholeList+ pure+ ( TangoValue+ (Image readValue (fromIntegral dimX) (fromIntegral dimY))+ (Image writeValue (fromIntegral dimX) (fromIntegral dimY))+ )++extractShort :: HaskellTangoAttributeData -> Maybe (HaskellTangoVarArray CShort)+extractShort (HaskellAttributeDataShortArray a) = Just a+extractShort _ = Nothing++-- | Read a short-type scalar attribute, fail hard if it's not really a short+readShortAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue Int16)+readShortAttribute = readAttributeSimple extractShort (convertGenericScalar fromIntegral)++-- | Read a short-type spectrum (list) attribute, fail hard if it's not really a short+readShortSpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue [Int16])+readShortSpectrumAttribute = readAttributeSimple extractShort (convertGenericSpectrum fromIntegral)++-- | Read a short-type image attribute, fail hard if it's not really a short+readShortImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue (Image Int16))+readShortImageAttribute = readAttributeSimple extractShort (convertGenericImage fromIntegral)++extractUShort :: HaskellTangoAttributeData -> Maybe (HaskellTangoVarArray CUShort)+extractUShort (HaskellAttributeDataUShortArray a) = Just a+extractUShort _ = Nothing++-- | Read an unsigned short-type scalar attribute, fail hard if it's not really an unsigned short+readUShortAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue Word16)+readUShortAttribute = readAttributeSimple extractUShort (convertGenericScalar fromIntegral)++-- | Read an unsigned short-type spectrum (list) attribute, fail hard if it's not really an unsigned short+readUShortSpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue [Word16])+readUShortSpectrumAttribute = readAttributeSimple extractUShort (convertGenericSpectrum fromIntegral)++-- | Read an unsigned short-type image attribute, fail hard if it's not really an unsigned short+readUShortImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue (Image Word16))+readUShortImageAttribute = readAttributeSimple extractUShort (convertGenericImage fromIntegral)++extractLong :: HaskellTangoAttributeData -> Maybe (HaskellTangoVarArray CLong)+extractLong (HaskellAttributeDataLongArray a) = Just a+extractLong _ = Nothing++-- | Read a long-type scalar attribute, fail hard if it's not really a long+readLongAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue Int64)+readLongAttribute = readAttributeSimple extractLong (convertGenericScalar fromIntegral)++-- | Read a long-type spectrum (list) attribute, fail hard if it's not really a long+readLongSpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue [Int64])+readLongSpectrumAttribute = readAttributeSimple extractLong (convertGenericSpectrum fromIntegral)++-- | Read a long-type image attribute, fail hard if it's not really a long+readLongImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue (Image Int64))+readLongImageAttribute = readAttributeSimple extractLong (convertGenericImage fromIntegral)++extractULong :: HaskellTangoAttributeData -> Maybe (HaskellTangoVarArray CULong)+extractULong (HaskellAttributeDataULongArray a) = Just a+extractULong _ = Nothing++-- | Read an unsigned long-type scalar attribute, fail hard if it's not really an unsigned long+readULongAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue Word64)+readULongAttribute = readAttributeSimple extractULong (convertGenericScalar fromIntegral)++-- | Read an unsigned long-type spectrum (list) attribute, fail hard if it's not really an unsigned long+readULongSpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue [Word64])+readULongSpectrumAttribute = readAttributeSimple extractULong (convertGenericSpectrum fromIntegral)++-- | Read an unsigned long-type image attribute, fail hard if it's not really an unsigned long+readULongImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue (Image Word64))+readULongImageAttribute = readAttributeSimple extractULong (convertGenericImage fromIntegral)++extractLong64 :: HaskellTangoAttributeData -> Maybe (HaskellTangoVarArray CLong)+extractLong64 (HaskellAttributeDataLong64Array a) = Just a+extractLong64 _ = Nothing++-- | Read a long64-type scalar attribute, fail hard if it's not really a long64+readLong64Attribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue Int64)+readLong64Attribute = readAttributeSimple extractLong64 (convertGenericScalar fromIntegral)++-- | Read a long64-type spectrum (list) attribute, fail hard if it's not really a long64+readLong64SpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue [Int64])+readLong64SpectrumAttribute = readAttributeSimple extractLong64 (convertGenericSpectrum fromIntegral)++-- | Read a long64-type image attribute, fail hard if it's not really a long64+readLong64ImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue (Image Int64))+readLong64ImageAttribute = readAttributeSimple extractLong64 (convertGenericImage fromIntegral)++extractULong64 :: HaskellTangoAttributeData -> Maybe (HaskellTangoVarArray CULong)+extractULong64 (HaskellAttributeDataULong64Array a) = Just a+extractULong64 _ = Nothing++-- | Read an unsigned long64-type scalar attribute, fail hard if it's not really an unsigned long64+readULong64Attribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue Word64)+readULong64Attribute = readAttributeSimple extractULong64 (convertGenericScalar fromIntegral)++-- | Read an unsigned long64-type spectrum (list) attribute, fail hard if it's not really an unsigned long64+readULong64SpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue [Word64])+readULong64SpectrumAttribute = readAttributeSimple extractULong64 (convertGenericSpectrum fromIntegral)++-- | Read an unsigned long64-type image attribute, fail hard if it's not really an unsigned long64+readULong64ImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue (Image Word64))+readULong64ImageAttribute = readAttributeSimple extractULong64 (convertGenericImage fromIntegral)++extractFloat :: HaskellTangoAttributeData -> Maybe (HaskellTangoVarArray CFloat)+extractFloat (HaskellAttributeDataFloatArray a) = Just a+extractFloat _ = Nothing++-- | Read a float-type scalar attribute, fail hard if it's not really a float+readFloatAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue Double)+readFloatAttribute = readAttributeSimple extractFloat (convertGenericScalar realToFrac)++-- | Read a float-type spectrum (list) attribute, fail hard if it's not really a float+readFloatSpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue [Double])+readFloatSpectrumAttribute = readAttributeSimple extractFloat (convertGenericSpectrum realToFrac)++-- | Read a float-type image attribute, fail hard if it's not really a float+readFloatImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue (Image Double))+readFloatImageAttribute = readAttributeSimple extractFloat (convertGenericImage realToFrac)++extractDouble :: HaskellTangoAttributeData -> Maybe (HaskellTangoVarArray CDouble)+extractDouble (HaskellAttributeDataDoubleArray a) = Just a+extractDouble _ = Nothing++-- | Read a double-type scalar attribute, fail hard if it's not really a double+readDoubleAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue Double)+readDoubleAttribute = readAttributeSimple extractDouble (convertGenericScalar realToFrac)++-- | Read a double-type spectrum (list) attribute, fail hard if it's not really a double+readDoubleSpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue [Double])+readDoubleSpectrumAttribute = readAttributeSimple extractDouble (convertGenericSpectrum realToFrac)++-- | Read a double-type image attribute, fail hard if it's not really a double+readDoubleImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue (Image Double))+readDoubleImageAttribute = readAttributeSimple extractDouble (convertGenericImage realToFrac)++extractState :: HaskellTangoAttributeData -> Maybe (HaskellTangoVarArray HaskellTangoDevState)+extractState (HaskellAttributeDataStateArray a) = Just a+extractState _ = Nothing++-- | Read a state-type scalar attribute, fail hard if it's not really a state+readStateAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue HaskellTangoDevState)+readStateAttribute = readAttributeSimple extractState (convertGenericScalar id)++-- | Read a state-type spectrum (list) attribute, fail hard if it's not really a state type+readStateSpectrumAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue [HaskellTangoDevState])+readStateSpectrumAttribute = readAttributeSimple extractState (convertGenericSpectrum id)++-- | Read a state-type image attribute, fail hard if it's not really a state+readStateImageAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m (TangoValue (Image HaskellTangoDevState))+readStateImageAttribute = readAttributeSimple extractState (convertGenericImage id)++extractEnum :: HaskellTangoAttributeData -> Maybe (HaskellTangoVarArray CShort)+extractEnum (HaskellAttributeDataShortArray a) = Just a+extractEnum _ = Nothing++-- | Read an enum-type scalar attribute, fail hard if it's not really an enum (internally, enums are shorts)+readEnumAttribute :: (MonadUnliftIO m, Enum t) => DeviceProxy -> AttributeName -> m (TangoValue t)+readEnumAttribute = readAttributeSimple extractEnum (convertGenericScalar (toEnum . fromIntegral))++-- | Read an enum-type spectrum attribute, fail hard if it's not really an enum (internally, enums are shorts)+readEnumSpectrumAttribute :: (MonadUnliftIO m, Enum t) => DeviceProxy -> AttributeName -> m (TangoValue [t])+readEnumSpectrumAttribute = readAttributeSimple extractEnum (convertGenericSpectrum (toEnum . fromIntegral))++-- | Read an enum-type image attribute, fail hard if it's not really an enum (internally, enums are shorts)+readEnumImageAttribute :: (MonadUnliftIO m, Enum t) => DeviceProxy -> AttributeName -> m (TangoValue (Image t))+readEnumImageAttribute = readAttributeSimple extractEnum (convertGenericImage (toEnum . fromIntegral))++-- | Newtype wrapper around a command name+newtype CommandName = CommandName Text++instance Show CommandName where+ show (CommandName n) = show (unpack n)++-- | Input and output data for a command+data CommandData+ = CommandVoid+ | CommandBool !Bool+ | CommandShort !Int16+ | CommandUShort !Word16+ | CommandInt32 !Int32+ | CommandInt64 !Int64+ | CommandWord64 !Word64+ | CommandFloat !Float+ | CommandDouble !Double+ | CommandString !Text+ | CommandState !HaskellTangoDevState+ | CommandEnum !Int16+ | CommandListBool ![Bool]+ | CommandListShort ![Int16]+ | CommandListUShort ![Word16]+ | CommandListInt64 ![Int64]+ | CommandListWord64 ![Word64]+ | CommandListLong64 ![Int64]+ | CommandListULong64 ![Word64]+ | CommandListFloat ![Float]+ | CommandListDouble ![Double]+ | CommandListString ![Text]+ | CommandListState ![HaskellTangoDevState]+ deriving (Show)++-- | Execute command with no input and no output+commandInVoidOutVoid :: (MonadUnliftIO m) => DeviceProxy -> CommandName -> m ()+commandInVoidOutVoid (DeviceProxy proxyPtr) (CommandName commandName) =+ liftIO $+ withCStringText+ commandName+ \commandNamePtr ->+ with (HaskellCommandData HaskellDevVoid HaskellCommandVoid) $ \commandDataInPtr -> with (HaskellCommandData HaskellDevVoid HaskellCommandVoid) $ \commandDataOutPtr ->+ checkResult $ tango_command_inout proxyPtr commandNamePtr commandDataInPtr commandDataOutPtr++withVarArray :: (MonadUnliftIO m, Storable a) => [a] -> (HaskellTangoVarArray a -> m b) -> m b+withVarArray b f = withArray b (f . HaskellTangoVarArray (fromIntegral (length b)))++newCStringText :: (MonadUnliftIO m) => Text -> m CString+newCStringText = newCString . unpack++withRawCommandData :: (MonadUnliftIO m) => CommandData -> (Ptr HaskellCommandData -> m a) -> m a+withRawCommandData CommandVoid f = with (HaskellCommandData HaskellDevVoid HaskellCommandVoid) f+withRawCommandData (CommandBool b) f = with (HaskellCommandData HaskellDevBoolean (HaskellCommandBool (boolToCBool b))) f+withRawCommandData (CommandShort b) f = with (HaskellCommandData HaskellDevShort (HaskellCommandShort (fromIntegral b))) f+withRawCommandData (CommandUShort b) f = with (HaskellCommandData HaskellDevUShort (HaskellCommandUShort (fromIntegral b))) f+withRawCommandData (CommandInt32 b) f = with (HaskellCommandData HaskellDevInt (HaskellCommandInt32 (fromIntegral b))) f+withRawCommandData (CommandInt64 b) f = with (HaskellCommandData HaskellDevShort (HaskellCommandULong64 (fromIntegral b))) f+withRawCommandData (CommandWord64 b) f = with (HaskellCommandData HaskellDevUShort (HaskellCommandLong64 (fromIntegral b))) f+withRawCommandData (CommandFloat b) f = with (HaskellCommandData HaskellDevFloat (HaskellCommandFloat (realToFrac b))) f+withRawCommandData (CommandDouble b) f = with (HaskellCommandData HaskellDevDouble (HaskellCommandDouble (realToFrac b))) f+withRawCommandData (CommandString t) f =+ bracket+ (newCString (unpack t))+ free+ (\s -> with (HaskellCommandData HaskellDevString (HaskellCommandCString s)) f)+withRawCommandData (CommandState b) f = with (HaskellCommandData HaskellDevState (HaskellCommandDevState b)) f+withRawCommandData (CommandEnum b) f = with (HaskellCommandData HaskellDevEnum (HaskellCommandDevEnum (fromIntegral (fromEnum b)))) f+withRawCommandData (CommandListBool b) f =+ withVarArray+ (boolToCBool <$> b)+ \varList ->+ with (HaskellCommandData HaskellDevVarBooleanArray (HaskellCommandVarBool varList)) f+withRawCommandData (CommandListShort b) f =+ withVarArray+ (fromIntegral <$> b)+ \varList ->+ with (HaskellCommandData HaskellDevVarShortArray (HaskellCommandVarShort varList)) f+withRawCommandData (CommandListUShort b) f =+ withVarArray+ (fromIntegral <$> b)+ \varList ->+ with (HaskellCommandData HaskellDevVarUShortArray (HaskellCommandVarUShort varList)) f+withRawCommandData (CommandListInt64 b) f =+ withVarArray+ (fromIntegral <$> b)+ \varList ->+ with (HaskellCommandData HaskellDevVarLongArray (HaskellCommandVarLong varList)) f+withRawCommandData (CommandListLong64 b) f =+ withVarArray+ (fromIntegral <$> b)+ \varList ->+ with (HaskellCommandData HaskellDevVarLong64Array (HaskellCommandVarLong64 varList)) f+withRawCommandData (CommandListWord64 b) f =+ withVarArray+ (fromIntegral <$> b)+ \varList ->+ with (HaskellCommandData HaskellDevVarULongArray (HaskellCommandVarULong varList)) f+withRawCommandData (CommandListULong64 b) f =+ withVarArray+ (fromIntegral <$> b)+ \varList ->+ with (HaskellCommandData HaskellDevVarULong64Array (HaskellCommandVarULong64 varList)) f+withRawCommandData (CommandListFloat b) f =+ withVarArray+ (realToFrac <$> b)+ \varList ->+ with (HaskellCommandData HaskellDevVarFloatArray (HaskellCommandVarFloat varList)) f+withRawCommandData (CommandListDouble b) f =+ withVarArray+ (realToFrac <$> b)+ \varList ->+ with (HaskellCommandData HaskellDevVarDoubleArray (HaskellCommandVarDouble varList)) f+withRawCommandData (CommandListString texts) f =+ UnliftIO.bracket+ (traverse newCStringText texts)+ (traverse free)+ ( \textPtrList -> withVarArray+ textPtrList+ \varList ->+ with (HaskellCommandData HaskellDevVarStringArray (HaskellCommandVarCString varList)) f+ )+withRawCommandData (CommandListState b) f =+ withVarArray+ b+ \varList ->+ with (HaskellCommandData HaskellDevVarStateArray (HaskellCommandVarDevState varList)) f++tangoVarArrayToList :: (MonadUnliftIO m, Storable a) => HaskellTangoVarArray a -> m [a]+tangoVarArrayToList (HaskellTangoVarArray {varArrayLength, varArrayValues}) =+ peekArray (fromIntegral varArrayLength) varArrayValues++fromRawCommandData :: (MonadUnliftIO m) => HaskellCommandData -> m (Maybe CommandData)+fromRawCommandData (HaskellCommandData {tangoCommandData}) =+ case tangoCommandData of+ HaskellCommandVoid -> pure $ Just CommandVoid+ HaskellCommandBool cbool -> pure $ Just $ CommandBool $ cboolToBool cbool+ HaskellCommandShort v -> pure $ Just $ CommandShort $ fromIntegral v+ HaskellCommandUShort v -> pure $ Just $ CommandUShort $ fromIntegral v+ HaskellCommandFloat v -> pure $ Just $ CommandFloat $ realToFrac v+ HaskellCommandDouble v -> pure $ Just $ CommandDouble $ realToFrac v+ HaskellCommandCString v -> Just . CommandString . pack <$> peekCString v+ HaskellCommandInt32 v -> pure $ Just $ CommandInt32 $ fromIntegral v+ HaskellCommandLong64 v -> pure $ Just $ CommandInt64 $ fromIntegral v+ HaskellCommandDevState v -> pure $ Just $ CommandState v+ HaskellCommandULong64 v -> pure $ Just $ CommandWord64 $ fromIntegral v+ HaskellCommandDevEnum v -> pure $ Just $ CommandEnum $ toEnum $ fromIntegral v+ HaskellCommandVarBool a -> Just . CommandListBool . (cboolToBool <$>) <$> tangoVarArrayToList a+ HaskellCommandVarShort a -> Just . CommandListShort . (fromIntegral <$>) <$> tangoVarArrayToList a+ HaskellCommandVarUShort a -> Just . CommandListUShort . (fromIntegral <$>) <$> tangoVarArrayToList a+ HaskellCommandVarLong a -> Just . CommandListInt64 . (fromIntegral <$>) <$> tangoVarArrayToList a+ HaskellCommandVarULong a -> Just . CommandListWord64 . (fromIntegral <$>) <$> tangoVarArrayToList a+ HaskellCommandVarLong64 a -> Just . CommandListLong64 . (fromIntegral <$>) <$> tangoVarArrayToList a+ HaskellCommandVarULong64 a -> Just . CommandListULong64 . (fromIntegral <$>) <$> tangoVarArrayToList a+ HaskellCommandVarFloat a -> Just . CommandListFloat . (realToFrac <$>) <$> tangoVarArrayToList a+ HaskellCommandVarDouble a -> Just . CommandListDouble . (realToFrac <$>) <$> tangoVarArrayToList a+ HaskellCommandVarCString strings -> do+ stringsAsList <- tangoVarArrayToList strings+ texts <- traverse peekCStringText stringsAsList+ pure (Just (CommandListString texts))+ HaskellCommandVarDevState a -> Just . CommandListState <$> tangoVarArrayToList a+ _ -> pure Nothing++-- | Execute command with generic input and generic output. If you have an @Enum@ on hand, use 'commandInEnumOutGeneric', 'commandInGenericOutEnum' and 'commandInEnumOutEnum'+commandInOutGeneric :: (MonadUnliftIO m) => DeviceProxy -> CommandName -> CommandData -> m CommandData+commandInOutGeneric (DeviceProxy proxyPtr) (CommandName commandName) in' =+ liftIO $+ withCStringText commandName $+ \commandNamePtr ->+ withRawCommandData in' \commandDataInPtr ->+ with (RawCommon.HaskellCommandData RawCommon.HaskellDevVoid RawCommon.HaskellCommandVoid) $ \commandDataOutPtr -> do+ checkResult $ tango_command_inout proxyPtr commandNamePtr commandDataInPtr commandDataOutPtr+ outValue <- peek commandDataOutPtr+ result <- fromRawCommandData outValue+ case result of+ Nothing -> error "couldn't convert the command out value"+ Just result' -> pure result'++-- | Execute command with /enum/ input and generic output (special case to handle arbitrary enums)+commandInEnumOutGeneric :: (MonadUnliftIO m, Enum t) => DeviceProxy -> CommandName -> t -> m CommandData+commandInEnumOutGeneric proxy commandName in' = commandInOutGeneric proxy commandName (CommandShort $ fromIntegral $ fromEnum in')++-- | Execute command with generic input and /enum/ output (special case to handle arbitrary enums)+commandInGenericOutEnum :: (MonadUnliftIO m, Enum t) => DeviceProxy -> CommandName -> CommandData -> m t+commandInGenericOutEnum proxy commandName in' = do+ result <- commandInOutGeneric proxy commandName in'+ case result of+ CommandShort s -> pure (toEnum (fromIntegral s))+ _ -> error ("command " <> show commandName <> " was supposed to return a short (for enums), but returned " <> show result)++-- | Execute command with /enum input and /enum/ output (special case to handle arbitrary enums)+commandInEnumOutEnum :: (MonadUnliftIO m, Enum t, Enum u) => DeviceProxy -> CommandName -> u -> m t+commandInEnumOutEnum proxy commandName in' = do+ result <- commandInOutGeneric proxy commandName (CommandShort $ fromIntegral $ fromEnum in')+ case result of+ CommandShort s -> pure (toEnum (fromIntegral s))+ _ -> error ("command " <> show commandName <> " was supposed to return a short (for enums), but returned " <> show result)++-- throwTangoException :: (MonadIO m) => Text -> m ()+-- throwTangoException desc = do+-- str <- newCString (unpack desc)+-- liftIO $ tango_throw_exception str++-- | Information for a single attribute (for spectrum and images as well, see the dimensions)+data AttributeInfo = AttributeInfo+ { attributeInfoWritable :: !HaskellAttrWriteType,+ attributeInfoDataFormat :: !HaskellDataFormat,+ attributeInfoDataType :: !HaskellTangoDataType,+ attributeInfoMaxDimX :: !Int,+ attributeInfoMaxDimY :: !Int,+ attributeInfoDescription :: !Text,+ attributeInfoLabel :: !Text,+ attributeInfoUnit :: !Text,+ attributeInfoStandardUnit :: !Text,+ attributeInfoDisplayUnit :: !Text,+ attributeInfoFormat :: !Text,+ attributeInfoMinValue :: !Text,+ attributeInfoMaxValue :: !Text,+ attributeInfoMinAlarm :: !Text,+ attributeInfoMaxAlarm :: !Text,+ attributeInfoWritableAttrName :: !Text,+ attributeInfoDispLevel :: !HaskellDispLevel,+ attributeInfoEnumLabels :: [Text],+ -- | Root attribute name (in case of forwarded attribute)+ attributeInfoRootAttrName :: Text,+ attributeInfoMemorized :: !TangoAttrMemorizedType+ }+ deriving (Show)++convertAttributeInfo :: forall m. (MonadUnliftIO m) => RawCommon.HaskellAttributeInfo -> m AttributeInfo+convertAttributeInfo ai = do+ description <- peekCStringText (RawCommon.attributeInfoDescription ai)+ label <- peekCStringText (RawCommon.attributeInfoLabel ai)+ unit <- peekCStringText (RawCommon.attributeInfoUnit ai)+ standardUnit <- peekCStringText (RawCommon.attributeInfoStandardUnit ai)+ displayUnit <- peekCStringText (RawCommon.attributeInfoDisplayUnit ai)+ format <- peekCStringText (RawCommon.attributeInfoFormat ai)+ minValue <- peekCStringText (RawCommon.attributeInfoMinValue ai)+ maxValue <- peekCStringText (RawCommon.attributeInfoMaxValue ai)+ minAlarm <- peekCStringText (RawCommon.attributeInfoMinAlarm ai)+ maxAlarm <- peekCStringText (RawCommon.attributeInfoMaxAlarm ai)+ writableAttrName <- peekCStringText (RawCommon.attributeInfoWritableAttrName ai)+ enumLabelsList <-+ peekCStringArrayText (RawCommon.attributeInfoEnumLabelsCount ai) (RawCommon.attributeInfoEnumLabels ai)+ rootAttrName <- peekCStringText (RawCommon.attributeInfoRootAttrName ai)+ pure $+ AttributeInfo+ (RawCommon.attributeInfoWritable ai)+ (RawCommon.attributeInfoDataFormat ai)+ (RawCommon.attributeInfoDataType ai)+ (fromIntegral (RawCommon.attributeInfoMaxDimX ai))+ (fromIntegral (RawCommon.attributeInfoMaxDimY ai))+ description+ label+ unit+ standardUnit+ displayUnit+ format+ minValue+ maxValue+ minAlarm+ maxAlarm+ writableAttrName+ (RawCommon.attributeInfoDispLevel ai)+ enumLabelsList+ rootAttrName+ (RawCommon.attributeInfoMemorized ai)++-- | Get information on a single attribute (this uses 'getConfigsForAttributes' internally)+getConfigForAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m AttributeInfo+getConfigForAttribute proxy attributeName =+ head <$> liftIO (getConfigsForAttributes proxy [attributeName])++-- | Get information for a set of attributes (see 'getConfigForAttribute' for a single attribute)+getConfigsForAttributes :: forall m. (MonadUnliftIO m) => DeviceProxy -> [AttributeName] -> m [AttributeInfo]+getConfigsForAttributes (DeviceProxy deviceProxyPtr) attributeNames = do+ let attributeNameToCString :: AttributeName -> m CString+ attributeNameToCString (AttributeName t) = newCString (unpack t)+ bracket (traverse attributeNameToCString attributeNames) (traverse free) \cstringList ->+ withArray cstringList \cstringPtr ->+ with (HaskellTangoVarArray (fromIntegral (length attributeNames)) cstringPtr) \varArrayPtr ->+ with (HaskellAttributeInfoList 0 nullPtr) \outputPtr ->+ bracket+ (checkResult (liftIO (tango_get_attribute_config deviceProxyPtr varArrayPtr outputPtr)))+ (\_ -> liftIO (tango_free_AttributeInfoList outputPtr))+ \_ -> do+ outputPeeked <- liftIO (peek outputPtr)+ elements <- peekArray (fromIntegral (attributeInfoListLength outputPeeked)) (attributeInfoListSequence outputPeeked)+ traverse convertAttributeInfo elements++-- | Newtype wrapper around a property name+newtype PropertyName = PropertyName Text++instance Show PropertyName where+ show (PropertyName x) = show (unpack x)++-- | All data stored for a property in Tango+data Property = Property+ { propertyName :: !Text,+ propertyIsEmpty :: !Bool,+ propertyWrongDataType :: !Bool,+ propertyData :: ![Text]+ }+ deriving (Show)++convertPropertyData :: (MonadUnliftIO m) => HaskellTangoPropertyData -> m [Text]+convertPropertyData (HaskellPropStringArray v) = tangoVarArrayToList v >>= traverse peekCStringText+convertPropertyData v = error $ "couldn't convert property data to Haskell: " <> show v++convertDbDatum :: (MonadUnliftIO m) => HaskellDbDatum -> m Property+convertDbDatum dbDatum = do+ propData <- convertPropertyData (dbDatumPropData dbDatum)+ nameConverted <- peekCStringText (dbDatumPropertyName dbDatum)+ pure $+ Property+ nameConverted+ (dbDatumIsEmpty dbDatum)+ (dbDatumWrongDataType dbDatum)+ propData++nameToDbDatum :: (MonadUnliftIO m) => PropertyName -> m HaskellDbDatum+nameToDbDatum (PropertyName name) = do+ nameCString <- newCString (unpack name)+ pure (HaskellDbDatum nameCString False False HaskellDevVarStringArray (HaskellPropStringArray (HaskellTangoVarArray 0 nullPtr)))++freeDbDatum :: (MonadUnliftIO m) => HaskellDbDatum -> m ()+freeDbDatum dbDatum = do+ dbDatumPtr <- new dbDatum+ -- free (dbDatumPropertyName dbDatum)+ liftIO (tango_free_DbDatum dbDatumPtr)++-- | Get a list of information for the given property names+getDeviceProperties :: forall m. (MonadUnliftIO m) => DeviceProxy -> [PropertyName] -> m [Property]+getDeviceProperties (DeviceProxy proxyPtr) names =+ let initialize :: m [HaskellDbDatum]+ initialize = traverse nameToDbDatum names+ destroy :: [HaskellDbDatum] -> m ()+ destroy = void . traverse freeDbDatum+ in UnliftIO.bracket+ initialize+ destroy+ \dbDatumPtrListIn ->+ withArray dbDatumPtrListIn \dbDatumPtrIn ->+ liftIO $ with+ (HaskellDbData (fromIntegral (length names)) dbDatumPtrIn)+ \dbDataPtr -> do+ checkResult (liftIO (tango_get_device_property proxyPtr dbDataPtr))+ dbData <- liftIO (peek dbDataPtr)+ dbDatumPtrListOut <- peekArray (fromIntegral (dbDataLength dbData)) (dbDataSequence dbData)+ traverse convertDbDatum dbDatumPtrListOut++textListToVarArray :: (MonadUnliftIO m) => [Text] -> m (HaskellTangoVarArray CString)+textListToVarArray texts = do+ cstringList :: [CString] <- traverse newCStringText texts+ cStringPtr :: Ptr CString <- newArray cstringList+ pure (HaskellTangoVarArray (fromIntegral (length texts)) cStringPtr)++nameAndValueToDbDatum :: (MonadUnliftIO m) => (PropertyName, [Text]) -> m HaskellDbDatum+nameAndValueToDbDatum (PropertyName name, texts) = do+ varArray <- textListToVarArray texts+ nameCString <- newCString (unpack name)+ pure (HaskellDbDatum nameCString False False HaskellDevVarStringArray (HaskellPropStringArray varArray))++-- | Change property values for the device (here with a crude pair)+putDeviceProperties :: forall m. (MonadUnliftIO m) => DeviceProxy -> [(PropertyName, [Text])] -> m ()+putDeviceProperties (DeviceProxy proxyPtr) namesAndValues =+ bracket+ (traverse nameAndValueToDbDatum namesAndValues)+ (void . traverse freeDbDatum)+ \dbDatumPtrListIn ->+ withArray dbDatumPtrListIn \dbDatumPtrIn ->+ liftIO $+ with+ (HaskellDbData (fromIntegral (length namesAndValues)) dbDatumPtrIn)+ (checkResult . liftIO . tango_put_device_property proxyPtr)++-- | Delete the given device properties+deleteDeviceProperties :: forall m. (MonadUnliftIO m) => DeviceProxy -> [PropertyName] -> m ()+deleteDeviceProperties (DeviceProxy proxyPtr) names =+ let initialize :: m [HaskellDbDatum]+ initialize = traverse nameToDbDatum names+ destroy :: [HaskellDbDatum] -> m ()+ destroy = void . traverse freeDbDatum+ in bracket+ initialize+ destroy+ \dbDatumPtrListIn ->+ withArray dbDatumPtrListIn \dbDatumPtrIn ->+ liftIO $+ with+ (HaskellDbData (fromIntegral (length names)) dbDatumPtrIn)+ (checkResult . liftIO . tango_delete_device_property proxyPtr)++-- | Lock the device (see 'withLocked' for an exception-safe version of this)+lockDevice :: (MonadUnliftIO m) => DeviceProxy -> m ()+lockDevice (DeviceProxy proxyPtr) = (checkResult . liftIO . tango_lock) proxyPtr++-- | Unlock the device (see 'withLocked' for an exception-safe version of this)+unlockDevice :: (MonadUnliftIO m) => DeviceProxy -> m ()+unlockDevice (DeviceProxy proxyPtr) = (checkResult . liftIO . tango_unlock) proxyPtr++-- | Execute the given action with a locked device (see 'lockDevice' and 'unlockDevice')+withLocked :: (MonadUnliftIO m) => DeviceProxy -> m () -> m ()+withLocked device f = bracket (lockDevice device) (\_ -> unlockDevice device) (const f)++-- | Newtype wrapper around milliseconds to make the raw numbers a bit more readable+newtype Milliseconds = Milliseconds Int++instance Show Milliseconds where+ show (Milliseconds ms) = show ms <> "ms"++-- | Set timeout for this device (relates to most operations: reading an attribute, executing a command)+setTimeout :: (MonadUnliftIO m) => DeviceProxy -> Milliseconds -> m ()+setTimeout (DeviceProxy proxy) (Milliseconds ms) = liftIO $ checkResult $ tango_set_timeout_millis proxy (fromIntegral ms)++-- | Get current timeout for this device+getTimeout :: (MonadUnliftIO m) => DeviceProxy -> m Milliseconds+getTimeout (DeviceProxy proxy) = liftIO $ with 0 \intPtr -> do+ checkResult (tango_get_timeout_millis proxy intPtr)+ intValue <- peek intPtr+ pure (Milliseconds (fromIntegral intValue))++-- | Enable polling for a command (see 'stopPollCommand' to stop it)+pollCommand :: (MonadUnliftIO m) => DeviceProxy -> CommandName -> Milliseconds -> m ()+pollCommand (DeviceProxy proxy) (CommandName commandName) (Milliseconds ms) = liftIO $ withCStringText commandName \commandNameC -> checkResult (tango_poll_command proxy commandNameC (fromIntegral ms))++-- | Disable polling for a command (see 'pollCommand')+stopPollCommand :: (MonadUnliftIO m) => DeviceProxy -> CommandName -> m ()+stopPollCommand (DeviceProxy proxy) (CommandName commandName) = liftIO $ withCStringText commandName (checkResult . tango_stop_poll_command proxy)++-- | Enable polling for an attribute (see 'stopPollAttribute' to stop it)+pollAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> Milliseconds -> m ()+pollAttribute (DeviceProxy proxy) (AttributeName attributeName) (Milliseconds ms) = liftIO $ withCStringText attributeName \attributeNameC -> checkResult (tango_poll_attribute proxy attributeNameC (fromIntegral ms))++-- | Disable polling for an attribute (see 'pollAttribute')+stopPollAttribute :: (MonadUnliftIO m) => DeviceProxy -> AttributeName -> m ()+stopPollAttribute (DeviceProxy proxy) (AttributeName attributeName) = liftIO $ withCStringText attributeName (checkResult . tango_stop_poll_attribute proxy)++-- | Where to display this command (in Jive, for example)+data DisplayLevel = Operator | Expert deriving (Show, Enum, Bounded, Eq)++-- | All information Tango has on a command+data CommandInfo = CommandInfo+ { commandInfoName :: !Text,+ commandInfoTag :: !Int,+ commandInfoInType :: !HaskellTangoDataType,+ commandInfoOutType :: !HaskellTangoDataType,+ commandInfoInTypeDesc :: !Text,+ commandInfoOutTypeDesc :: !Text,+ commandInfoDisplayLevel :: !DisplayLevel+ }+ deriving (Show)++convertCommandInfo :: HaskellCommandInfo -> IO CommandInfo+convertCommandInfo (HaskellCommandInfo {cmdName, cmdTag, cmdInType, cmdOutType, cmdInTypeDesc, cmdOutTypeDesc, cmdDisplayLevel}) =+ CommandInfo+ <$> peekCStringText cmdName+ <*> pure (fromIntegral cmdTag)+ <*> pure (toEnum (fromIntegral cmdInType))+ <*> pure (toEnum (fromIntegral cmdOutType))+ <*> peekCStringText cmdInTypeDesc+ <*> peekCStringText cmdOutTypeDesc+ <*> pure (toEnum (fromIntegral cmdDisplayLevel))++-- | Get a list of all commands for the device (see 'commandQuery' if you know the command name)+commandListQuery :: (MonadUnliftIO m) => DeviceProxy -> m [CommandInfo]+commandListQuery (DeviceProxy proxy) = liftIO $ with (HaskellCommandInfoList 0 nullPtr) \infoListPtr -> do+ checkResult (tango_command_list_query proxy infoListPtr)+ infoList <- peek infoListPtr+ converted <- peekArray (fromIntegral (commandInfoLength infoList)) (commandInfoSequence infoList)+ result <- traverse convertCommandInfo converted+ tango_free_CommandInfoList infoListPtr+ pure result++-- | Get info for a single command of the device (see 'commandListQuery' for all commands)+commandQuery :: (MonadUnliftIO m) => DeviceProxy -> CommandName -> m CommandInfo+commandQuery (DeviceProxy proxy) (CommandName commandName) = liftIO $ withCStringText commandName \commandNamePtr -> alloca \commandInfoPtr -> do+ checkResult (tango_command_query proxy commandNamePtr commandInfoPtr)+ commandInfoC <- peek commandInfoPtr+ result <- convertCommandInfo commandInfoC+ tango_free_CommandInfo commandInfoPtr+ pure result++-- | Get a list of all attributes inside the device+getAttributeNames :: (MonadUnliftIO m) => DeviceProxy -> m [AttributeName]+getAttributeNames (DeviceProxy proxy) = liftIO $ with (HaskellTangoVarArray 0 nullPtr) \nameListPtr -> do+ checkResult (tango_get_attribute_list proxy nameListPtr)+ nameList <- peek nameListPtr+ names <- peekArray (fromIntegral (varArrayLength nameList)) (varArrayValues nameList)+ result <- traverse ((AttributeName <$>) . peekCStringText) names+ tango_free_VarStringArray nameListPtr+ pure result++-- | Create a proxy for the Tango DB (not the same as a device proxy), see 'deleteDatabaseProxy' and 'withDatabaseProxy'+createDatabaseProxy :: (MonadUnliftIO m) => m DatabaseProxy+createDatabaseProxy = liftIO $ alloca \databaseProxyPtrPtr -> do+ checkResult (tango_create_database_proxy databaseProxyPtrPtr)+ peek databaseProxyPtrPtr++-- | Delete proxy for the Tango DB, see 'createDatabaseProxy' and 'withDatabaseProxy'+deleteDatabaseProxy :: (MonadUnliftIO m) => DatabaseProxy -> m ()+deleteDatabaseProxy proxy = liftIO (checkResult (tango_delete_database_proxy proxy))++-- | Execute an action safely, on a database proxy, see 'createDatabaseProxy' and 'deleteDatabaseProxy'+withDatabaseProxy :: (MonadUnliftIO m) => (DatabaseProxy -> m a) -> m a+withDatabaseProxy = bracket createDatabaseProxy deleteDatabaseProxy++-- | Search the database for devices with a certain name filter. Can include globs, such as @sys/*@ to search for all devices starting with @sys@.+databaseSearchByDeviceName :: (MonadUnliftIO m) => DatabaseProxy -> Text -> m [Text]+databaseSearchByDeviceName proxy nameFilter = liftIO $ withCStringText nameFilter \deviceNamePtr -> alloca \dbDatumPtr -> do+ checkResult (tango_get_device_exported proxy deviceNamePtr dbDatumPtr)+ dbDatum <- peek dbDatumPtr+ result <- convertDbDatum dbDatum+ tango_free_DbDatum dbDatumPtr+ pure (propertyData result)++-- | Search the database for devices with a certain class+databaseSearchByClass :: (MonadUnliftIO m) => DatabaseProxy -> Text -> m [Text]+databaseSearchByClass proxy classFilter = liftIO $ withCStringText classFilter \classNamePtr -> alloca \dbDatumPtr -> do+ checkResult (tango_get_device_exported_for_class proxy classNamePtr dbDatumPtr)+ dbDatum <- peek dbDatumPtr+ result <- convertDbDatum dbDatum+ tango_free_DbDatum dbDatumPtr+ pure (propertyData result)++-- | Search the database for objects with a certain name (don't know what this is)+databaseSearchObjectsByName :: (MonadUnliftIO m) => DatabaseProxy -> Text -> m [Text]+databaseSearchObjectsByName proxy nameFilter = liftIO $ withCStringText nameFilter \nameFilterPtr -> alloca \dbDatumPtr -> do+ checkResult (tango_get_object_list proxy nameFilterPtr dbDatumPtr)+ dbDatum <- peek dbDatumPtr+ result <- convertDbDatum dbDatum+ tango_free_DbDatum dbDatumPtr+ pure (propertyData result)++-- | I don't know what this is for+databaseSearchObjectPropertiesByName :: (MonadUnliftIO m) => DatabaseProxy -> Text -> Text -> m [Text]+databaseSearchObjectPropertiesByName proxy objectName nameFilter = liftIO $ withCStringText objectName \objectNamePtr -> withCStringText nameFilter \nameFilterPtr -> alloca \dbDatumPtr -> do+ checkResult (tango_get_object_property_list proxy objectNamePtr nameFilterPtr dbDatumPtr)+ dbDatum <- peek dbDatumPtr+ result <- convertDbDatum dbDatum+ tango_free_DbDatum dbDatumPtr+ pure (propertyData result)++-- | Structure holding information on how to unsubscribe from an event again. Feed to 'unsubscribeEvent'+data SubscribedEvent = SubscribedEvent (Ptr ()) CInt++-- | Callback for an event+type EventCallback m =+ AttributeName ->+ -- | @True@ if an error occurred+ Bool ->+ m ()++-- | Subscribe to an event. See 'unsubscribeEvent'+subscribeEvent ::+ forall m.+ (MonadUnliftIO m) =>+ DeviceProxy ->+ AttributeName ->+ EventType ->+ -- | The stateless flag = false indicates that the event subscription will only succeed when the given attribute is known and available in the Tango system. Setting stateless = true will make the subscription succeed, even if an attribute of this name was never known. The real event subscription will happen when the given attribute will be available in the Tango system.+ Bool ->+ EventCallback m ->+ m SubscribedEvent+subscribeEvent (DeviceProxy proxyPtr) attributeName@(AttributeName attributeNameText) eventType stateless eventCallback = withRunInIO \run -> do+ let realCallback :: Ptr () -> CString -> Bool -> IO ()+ realCallback _ _ bool = run (eventCallback attributeName bool)+ convertedCallback <- createEventCallbackWrapper realCallback+ callbackInTango <- tango_create_event_callback convertedCallback+ withCStringText attributeNameText \attributeNameC -> do+ eventId <- tango_subscribe_event proxyPtr attributeNameC (fromIntegral (fromEnum eventType)) callbackInTango (if stateless then 1 else 0)+ pure (SubscribedEvent callbackInTango eventId)++-- | Unsubscribe from the event, see 'subscribeEvent'+unsubscribeEvent :: (MonadUnliftIO m) => DeviceProxy -> SubscribedEvent -> m ()+unsubscribeEvent (DeviceProxy proxyPtr) (SubscribedEvent callbackPtr eventId) = do+ liftIO (tango_unsubscribe_event proxyPtr eventId)+ liftIO (tango_free_event_callback callbackPtr)++-- | Execute an action while being subscribed to the event+withSubscribedEvent ::+ (MonadUnliftIO m) =>+ DeviceProxy ->+ AttributeName ->+ EventType ->+ -- | The stateless flag = false indicates that the event subscription will only succeed when the given attribute is known and available in the Tango system. Setting stateless = true will make the subscription succeed, even if an attribute of this name was never known. The real event subscription will happen when the given attribute will be available in the Tango system.+ Bool ->+ EventCallback m ->+ -- | Action to perform while we have the subscription+ m () ->+ m ()+withSubscribedEvent proxy attributeName eventType stateless eventCallback f =+ bracket (subscribeEvent proxy attributeName eventType stateless eventCallback) (unsubscribeEvent proxy) (const f)
+ lib/Tango/Raw/Common.hsc view
@@ -0,0 +1,1133 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CApiFFI #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- |+-- Description : Low-level interface to all Tango functions+module Tango.Raw.Common+ ( HaskellTangoDevState (..),+ HaskellDispLevel (..),+ HaskellTangoPropertyData (..),+ HaskellTangoDevEncoded (..),+ EventType (..),+ HaskellAttrWriteType (..),+ ErrSeverity (..),+ DatabaseProxyPtr,+ HaskellDataQuality (..),+ HaskellDbData (..),+ HaskellDbDatum (..),+ HaskellAttributeInfoList (..),+ HaskellAttributeDataList (..),+ HaskellAttributeInfo (..),+ HaskellDataFormat (..),+ HaskellTangoVarArray (..),+ Timeval (..),+ DeviceProxyPtr,+ HaskellDevSource (..),+ HaskellErrorStack (..),+ DevFailed (..),+ TangoAttrMemorizedType (..),+ HaskellAttributeData (..),+ HaskellCommandData (..),+ HaskellTangoDataType (..),+ HaskellTangoCommandData (..),+ HaskellCommandInfoList (..),+ HaskellCommandInfo (..),+ HaskellTangoAttributeData (..),+ tango_create_device_proxy,+ tango_delete_device_proxy,+ tango_read_attribute,+ tango_write_attribute,+ tango_poll_command,+ tango_stop_poll_command,+ tango_free_AttributeInfoList,+ tango_poll_attribute,+ -- tango_throw_exception,+ tango_stop_poll_attribute,+ tango_command_inout,+ tango_free_AttributeData,+ createEventCallbackWrapper,+ tango_free_CommandData,+ tango_get_timeout_millis,+ tango_set_timeout_millis,+ tango_create_database_proxy,+ tango_delete_database_proxy,+ tango_get_property,+ tango_command_query,+ tango_free_DbData,+ tango_free_DbDatum,+ tango_put_property,+ tango_delete_property,+ tango_get_device_property,+ tango_delete_device_property,+ tango_get_object_list,+ tango_write_attributes,+ tango_get_object_property_list,+ tango_free_VarStringArray,+ tango_get_attribute_list,+ tango_read_attributes,+ tango_get_device_exported,+ tango_put_device_property,+ tango_set_source,+ tango_command_list_query,+ tango_free_CommandInfoList,+ tango_free_CommandInfo,+ -- tango_get_source,+ tango_lock,+ tango_get_device_exported_for_class,+ haskellDisplayLevelExpert,+ tango_get_attribute_config,+ haskellDisplayLevelOperator,+ tango_unlock,+ -- tango_is_locked,+ tango_locking_status,+ -- tango_is_locked_by_me,+ devSourceToInt,+ devSourceFromInt,+ tango_create_event_callback,+ tango_free_event_callback,+ tango_subscribe_event,+ tango_unsubscribe_event,+ )+where++import Control.Applicative (pure)+import Data.Bool (Bool)+import Data.Eq (Eq, (==))+import Data.Foldable (Foldable)+import Data.Function ((.))+import Data.Functor (Functor, (<$>))+import Data.Int (Int32)+import Data.List (find, zip)+import Data.Maybe (Maybe (Just, Nothing))+import Data.Ord (Ord)+import Data.Semigroup ((<>))+import Data.String (String)+import Data.Traversable (Traversable)+import Data.Tuple (fst, snd)+import Data.Word (Word16, Word32, Word64, Word8)+import Foreign (Storable (alignment, peek, poke, sizeOf), peekByteOff, pokeByteOff)+import Foreign.C.String (CString, peekCString)+import Foreign.C.Types (CBool (CBool), CChar, CDouble, CFloat, CInt (CInt), CLong, CShort, CUInt, CULong, CUShort)+import Foreign.Ptr (FunPtr, Ptr, castPtr)+import Foreign.Storable.Generic (GStorable)+import GHC.Generics (Generic)+import System.IO (IO)+import Text.Show (Show, show)+import Prelude (Bounded, Enum, error, maxBound, minBound)++#include <c_tango.h>+-- for timeval+#include <sys/time.h>++peekBounded :: (Enum a, Bounded a) => String -> Ptr a -> IO a+peekBounded desc ptr = do+ value :: CInt <- peek (castPtr ptr)+ case snd <$> find ((== value) . fst) (zip [0 ..] [minBound .. maxBound]) of+ Nothing -> error ("invalid constant (" <> desc <> "): " <> show value)+ Just v -> pure v++pokeBounded :: (Show a, Eq a, Enum a, Bounded a) => String -> Ptr a -> a -> IO ()+pokeBounded desc ptr x =+ case fst <$> (find ((== x) . snd) (zip [0 ..] [minBound .. maxBound])) of+ Nothing -> error ("invalid constant (" <> desc <> "): " <> show x)+ Just v -> poke @CInt (castPtr ptr) v++-- | List of all states that Tango knows about for device servers+data HaskellTangoDevState+ = On+ | Off+ | Close+ | Open+ | Insert+ | Extract+ | Moving+ | Standby+ | Fault+ | Init+ | Running+ | Alarm+ | Disable+ | Unknown+ deriving (Show, Eq, Bounded, Enum)++instance Storable HaskellTangoDevState where+ sizeOf _ = (# size TangoDevState)+ alignment _ = (# alignment TangoDevState)+ peek = peekBounded "dev state"+ poke = pokeBounded "dev state"++data TangoAttrMemorizedType+ = NotKnown+ | None+ | Memorized+ | MemorizedWriteInit+ deriving (Show, Eq, Bounded, Enum)++instance Storable TangoAttrMemorizedType where+ sizeOf _ = (# size TangoAttrMemorizedType)+ alignment _ = (# alignment TangoAttrMemorizedType)+ peek = peekBounded "TangoAttrMemorizedType"+ poke = pokeBounded "TangoAttrMemorizedType"++data HaskellDevSource+ = Dev+ | Cache+ | CacheDev+ deriving (Show, Eq, Bounded, Enum)++devSourceToInt :: HaskellDevSource -> CInt+devSourceToInt Dev = 0+devSourceToInt Cache = 1+devSourceToInt CacheDev = 2++devSourceFromInt :: CInt -> HaskellDevSource+devSourceFromInt 0 = Dev+devSourceFromInt 1 = Cache+devSourceFromInt _ = CacheDev++-- Whatever type Tango reserves for enumerations+type CTangoEnum = CShort++data HaskellTangoVarArray a = HaskellTangoVarArray+ { varArrayLength :: Word32,+ varArrayValues :: Ptr a+ }+ deriving (Show, Generic)++instance (Storable a) => GStorable (HaskellTangoVarArray a)++data HaskellTangoCommandData+ = HaskellCommandVoid+ | HaskellCommandBool !CBool+ | HaskellCommandShort !CShort+ | HaskellCommandUShort !CUShort+ | HaskellCommandInt32 !CInt+ | HaskellCommandUInt32 !CUInt+ | HaskellCommandFloat !CFloat+ | HaskellCommandDouble !CDouble+ | HaskellCommandCString !CString+ | HaskellCommandLong64 !CLong+ | HaskellCommandDevState !HaskellTangoDevState+ | HaskellCommandULong64 !CULong+ | HaskellCommandDevEncoded !HaskellTangoDevEncoded+ | HaskellCommandDevEnum !CTangoEnum+ | HaskellCommandVarBool !(HaskellTangoVarArray CBool)+ | HaskellCommandVarChar !(HaskellTangoVarArray CChar)+ | HaskellCommandVarShort !(HaskellTangoVarArray CShort)+ | HaskellCommandVarUShort !(HaskellTangoVarArray CUShort)+ | HaskellCommandVarLong !(HaskellTangoVarArray CLong)+ | HaskellCommandVarULong !(HaskellTangoVarArray CULong)+ | HaskellCommandVarLong64 !(HaskellTangoVarArray CLong)+ | HaskellCommandVarULong64 !(HaskellTangoVarArray CULong)+ | HaskellCommandVarFloat !(HaskellTangoVarArray CFloat)+ | HaskellCommandVarDouble !(HaskellTangoVarArray CDouble)+ | HaskellCommandVarCString !(HaskellTangoVarArray CString)+ | HaskellCommandVarDevState !(HaskellTangoVarArray HaskellTangoDevState)+ | HaskellCommandLongStringArray !HaskellVarLongStringArray+ | HaskellCommandDoubleStringArray !HaskellVarDoubleStringArray+ deriving (Show)++data HaskellTangoAttributeData+ = HaskellAttributeDataBoolArray !(HaskellTangoVarArray CBool)+ | HaskellAttributeDataCharArray !(HaskellTangoVarArray CChar)+ | HaskellAttributeDataShortArray !(HaskellTangoVarArray CShort)+ | HaskellAttributeDataUShortArray !(HaskellTangoVarArray CUShort)+ | HaskellAttributeDataLongArray !(HaskellTangoVarArray CLong)+ | HaskellAttributeDataULongArray !(HaskellTangoVarArray CULong)+ | -- Long is defined as Word64 in Haskell, so...+ HaskellAttributeDataLong64Array !(HaskellTangoVarArray CLong)+ | HaskellAttributeDataULong64Array !(HaskellTangoVarArray CULong)+ | HaskellAttributeDataFloatArray !(HaskellTangoVarArray CFloat)+ | HaskellAttributeDataDoubleArray !(HaskellTangoVarArray CDouble)+ | HaskellAttributeDataStringArray !(HaskellTangoVarArray CString)+ | HaskellAttributeDataStateArray !(HaskellTangoVarArray HaskellTangoDevState)+ | HaskellAttributeDataEncodedArray !(HaskellTangoVarArray HaskellTangoDevEncoded)+ deriving (Show)++data HaskellTangoPropertyData+ = HaskellPropBool !CBool+ | HaskellPropChar !CChar+ | HaskellPropShort !CShort+ | HaskellPropUShort !CUShort+ | -- Yes, I know. But it says long in the C struct+ HaskellPropLong !CInt+ | HaskellPropULong !CUInt+ | HaskellPropFloat !CFloat+ | HaskellPropDouble !CDouble+ | HaskellPropString !CString+ | HaskellPropLong64 !CLong+ | HaskellPropULong64 !CULong+ | HaskellPropShortArray !(HaskellTangoVarArray CShort)+ | HaskellPropUShortArray !(HaskellTangoVarArray CUShort)+ | HaskellPropLongArray !(HaskellTangoVarArray CLong)+ | HaskellPropULongArray !(HaskellTangoVarArray CULong)+ | HaskellPropLong64Array !(HaskellTangoVarArray CLong)+ | HaskellPropULong64Array !(HaskellTangoVarArray CULong)+ | HaskellPropFloatArray !(HaskellTangoVarArray CFloat)+ | HaskellPropDoubleArray !(HaskellTangoVarArray CDouble)+ | HaskellPropStringArray !(HaskellTangoVarArray CString)+ deriving (Show)++-- | Haskell mapping for the C type TangoDataType+-- Beware: this is encoded positionally!+data HaskellTangoDataType+ = HaskellDevVoid+ | HaskellDevBoolean+ | HaskellDevShort+ | HaskellDevLong+ | HaskellDevFloat+ | HaskellDevDouble+ | HaskellDevUShort+ | HaskellDevULong+ | HaskellDevString+ | HaskellDevVarCharArray+ | HaskellDevVarShortArray+ | HaskellDevVarLongArray+ | HaskellDevVarFloatArray+ | HaskellDevVarDoubleArray+ | HaskellDevVarUShortArray+ | HaskellDevVarULongArray+ | HaskellDevVarStringArray+ | HaskellDevVarLongStringArray+ | HaskellDevVarDoubleStringArray+ | HaskellDevState+ | HaskellConstDevString+ | HaskellDevVarBooleanArray+ | HaskellDevUChar+ | HaskellDevLong64+ | HaskellDevULong64+ | HaskellDevVarLong64Array+ | HaskellDevVarULong64Array+ | HaskellDevInt+ | HaskellDevEncoded+ | HaskellDevEnum+ | -- We explicitly have a type with index 29 and I don't know what that's supposed to be+ HaskellDevUnknown+ | HaskellDevVarStateArray+ | HaskellDevVarEncodedArray+ deriving (Show, Eq, Ord, Bounded, Enum)++instance Storable HaskellTangoDataType where+ sizeOf _ = (# size TangoDataType)+ alignment _ = (# alignment TangoDataType)+ peek = peekBounded "data type"+ poke = pokeBounded "data type"++-- | Event type if you want to subscribe to events. The events are losely described [in the Tango docs](https://tango-controls.readthedocs.io/en/latest/development/client-api/cpp-client-programmers-guide.html#events-tangoclient)+data EventType+ = -- | It is a type of event that gets fired when the associated attribute changes its value according to its configuration specified in system specific attribute properties (@abs_change@ and @rel_change@).+ ChangeEvent+ | -- | An “alarming” (or quality) subset of change events to allow clients to monitor when attributes’ quality factors are either Tango::ATTR_WARNING or Tango::ATTR_ALARM, without receiving unneeded events relating to value changes.+ QualityEvent+ | -- | It is a type of event that gets fired at a fixed periodic interval.+ PeriodicEvent+ | -- | An event is sent if one of the archiving conditions is satisfied. Archiving conditions are defined via properties in the database. These can be a mixture of delta_change and periodic. Archive events can be send from the polling thread or can be manually pushed from the device server code (@DeviceImpl::push_archive_event()@).+ ArchiveEvent+ | -- | The criteria and configuration of these user events are managed by the device server programmer who uses a specific method of one of the Tango device server class to fire the event (@DeviceImpl::push_event()@).+ UserEvent+ | -- | An event is sent if the attribute configuration is changed.+ AttrConfEvent+ | -- | This event is sent when coded by the device server programmer who uses a specific method of one of the Tango device server class to fire the event (@DeviceImpl::push_data_ready_event()@). The rule of this event is to inform a client that it is now possible to read an attribute. This could be useful in case of attribute with many data.+ DataReadyEvent+ | -- | This event is sent when the device interface changes. Using Tango, it is possible to dynamically add/remove attribute/command to a device. This event is the way to inform client(s) that attribute/command has been added/removed from a device.+ InterfaceChangeEvent+ | -- | This is the kind of event which has to be used when the user want to push data through a pipe. This kind of event is only sent by the user code by using a specific method (@DeviceImpl::push_pipe_event()@).+ PipeEvent+ deriving (Show, Eq, Ord, Bounded, Enum)++instance Storable EventType where+ sizeOf _ = (# size TangoEventType)+ alignment _ = (# alignment TangoEventType)+ peek = peekBounded "event type"+ poke = pokeBounded "event type"++data HaskellDataFormat+ = HaskellScalar+ | HaskellSpectrum+ | HaskellImage+ deriving (Show)++instance Storable HaskellDataFormat where+ sizeOf _ = (# size AttrDataFormat)+ alignment _ = (# alignment AttrDataFormat)+ peek ptr = do+ value :: CInt <- peek (castPtr ptr)+ case value of+ 0 -> pure HaskellScalar+ 1 -> pure HaskellSpectrum+ _ -> pure HaskellImage+ poke ptr x =+ poke @CInt+ (castPtr ptr)+ ( case x of+ HaskellScalar -> 0+ HaskellSpectrum -> 1+ HaskellImage -> 2+ )++data HaskellDataQuality+ = HaskellValid+ | HaskellInvalid+ | HaskellAlarm+ | HaskellChanging+ | HaskellWarning+ deriving (Show)++data Timeval = Timeval+ { -- Guesswork, not sure how to type it+ tvSec :: !CLong,+ tvUsec :: !CLong+ }+ deriving (Show)++instance Storable Timeval where+ sizeOf _ = (# size struct timeval)+ alignment _ = (# alignment struct timeval)+ peek ptr = do+ tvSec' <- (# peek struct timeval, tv_sec) ptr+ tvUsec' <- (# peek struct timeval, tv_usec) ptr+ pure (Timeval tvSec' tvUsec')+ poke ptr (Timeval tvSec' tvUsec') = do+ (# poke struct timeval, tv_sec) ptr tvSec'+ (# poke struct timeval, tv_usec) ptr tvUsec'++data HaskellAttrWriteType = Read | ReadWithWrite | Write | ReadWrite deriving (Show)++instance Storable HaskellAttrWriteType where+ sizeOf _ = (# size AttrWriteType)+ alignment _ = (# alignment AttrWriteType)+ peek ptr = do+ value :: CInt <- peek (castPtr ptr)+ case value of+ 0 -> pure Read+ 1 -> pure ReadWithWrite+ 2 -> pure Write+ _ -> pure ReadWrite+ poke ptr x =+ poke @CInt+ (castPtr ptr)+ ( case x of+ Read -> 0+ ReadWithWrite -> 1+ Write -> 2+ ReadWrite -> 3+ )++data HaskellDispLevel = Operator | Expert deriving (Show, Eq)++instance Storable HaskellDispLevel where+ sizeOf _ = (# size DispLevel)+ alignment _ = (# alignment DispLevel)+ peek ptr = do+ value :: CInt <- peek (castPtr ptr)+ case value of+ 0 -> pure Operator+ _ -> pure Expert+ poke ptr x = poke @CInt (castPtr ptr) (if x == Operator then 0 else 1)++data HaskellVarLongStringArray = HaskellVarLongStringArray+ { longLength :: !Word32,+ longSequence :: !(Ptr Word64),+ longStringLength :: !Word32,+ longStringSequence :: !(Ptr CString)+ }+ deriving (Show)++instance Storable HaskellVarLongStringArray where+ sizeOf _ = (# size VarLongStringArray)+ alignment _ = (# alignment VarLongStringArray)+ peek ptr = do+ long_length' <- ((# peek VarLongStringArray, long_length) ptr)+ long_sequence' <- ((# peek VarLongStringArray, long_sequence) ptr)+ string_length' <- ((# peek VarLongStringArray, string_length) ptr)+ string_sequence' <- ((# peek VarLongStringArray, string_sequence) ptr)+ pure (HaskellVarLongStringArray long_length' long_sequence' string_length' string_sequence')+ poke ptr (HaskellVarLongStringArray longLength' longSequence' stringLength' stringSequence') = do+ (# poke VarLongStringArray, long_length) ptr longLength'+ (# poke VarLongStringArray, long_sequence) ptr longSequence'+ (# poke VarLongStringArray, string_length) ptr stringLength'+ (# poke VarLongStringArray, string_sequence) ptr stringSequence'++data HaskellVarDoubleStringArray = HaskellVarDoubleStringArray+ { doubleLength :: !Word32,+ doubleSequence :: !(Ptr CDouble),+ doubleStringLength :: !Word32,+ doubleStringSequence :: !(Ptr CString)+ }+ deriving (Show)++instance Storable HaskellVarDoubleStringArray where+ sizeOf _ = (# size VarDoubleStringArray)+ alignment _ = (# alignment VarDoubleStringArray)+ peek ptr = do+ double_length' <- ((# peek VarDoubleStringArray, double_length) ptr)+ double_sequence' <- ((# peek VarDoubleStringArray, double_sequence) ptr)+ string_length' <- ((# peek VarDoubleStringArray, string_length) ptr)+ string_sequence' <- ((# peek VarDoubleStringArray, string_sequence) ptr)+ pure (HaskellVarDoubleStringArray double_length' double_sequence' string_length' string_sequence')+ poke ptr (HaskellVarDoubleStringArray doubleLength' doubleSequence' stringLength' stringSequence') = do+ (# poke VarDoubleStringArray, double_length) ptr doubleLength'+ (# poke VarDoubleStringArray, double_sequence) ptr doubleSequence'+ (# poke VarDoubleStringArray, string_length) ptr stringLength'+ (# poke VarDoubleStringArray, string_sequence) ptr stringSequence'++data HaskellTangoDevEncoded = HaskellTangoDevEncoded+ { devEncodedFormat :: !CString,+ devEncodedLength :: !Word32,+ devEncodedData :: !(Ptr Word8)+ }+ deriving (Show, Generic)++instance GStorable HaskellTangoDevEncoded++data HaskellAttributeInfo = HaskellAttributeInfo+ { attributeInfoName :: !CString,+ attributeInfoWritable :: !HaskellAttrWriteType,+ attributeInfoDataFormat :: !HaskellDataFormat,+ attributeInfoDataType :: !HaskellTangoDataType,+ attributeInfoMaxDimX :: !Int32,+ attributeInfoMaxDimY :: !Int32,+ attributeInfoDescription :: !CString,+ attributeInfoLabel :: !CString,+ attributeInfoUnit :: !CString,+ attributeInfoStandardUnit :: !CString,+ attributeInfoDisplayUnit :: !CString,+ attributeInfoFormat :: !CString,+ attributeInfoMinValue :: !CString,+ attributeInfoMaxValue :: !CString,+ attributeInfoMinAlarm :: !CString,+ attributeInfoMaxAlarm :: !CString,+ attributeInfoWritableAttrName :: !CString,+ attributeInfoDispLevel :: !HaskellDispLevel,+ attributeInfoEnumLabels :: !(Ptr CString),+ attributeInfoEnumLabelsCount :: !Word16,+ attributeInfoRootAttrName :: !CString,+ attributeInfoMemorized :: !TangoAttrMemorizedType+ }+ deriving (Show, Generic)++instance GStorable HaskellAttributeInfo++data HaskellDbDatum = HaskellDbDatum+ { dbDatumPropertyName :: !CString,+ dbDatumIsEmpty :: !Bool,+ dbDatumWrongDataType :: !Bool,+ dbDatumDataType :: !HaskellTangoDataType,+ dbDatumPropData :: !HaskellTangoPropertyData+ }+ deriving (Show)++data HaskellAttributeData = HaskellAttributeData+ { dataFormat :: !HaskellDataFormat,+ dataQuality :: !HaskellDataQuality,+ nbRead :: !CLong,+ name :: !CString,+ dimX :: !Int32,+ dimY :: !Int32,+ timeStamp :: !Timeval,+ dataType :: !HaskellTangoDataType,+ tangoAttributeData :: !HaskellTangoAttributeData+ }+ deriving (Show)++data HaskellCommandData = HaskellCommandData+ { argType :: !HaskellTangoDataType,+ tangoCommandData :: !HaskellTangoCommandData+ }+ deriving (Show)++haskellDisplayLevelOperator :: CInt+haskellDisplayLevelOperator = 0++haskellDisplayLevelExpert :: CInt+haskellDisplayLevelExpert = 1++data HaskellCommandInfo = HaskellCommandInfo+ { cmdName :: !CString,+ cmdTag :: !Int32,+ cmdInType :: !Int32,+ cmdOutType :: !Int32,+ cmdInTypeDesc :: !CString,+ cmdOutTypeDesc :: !CString,+ cmdDisplayLevel :: !CInt+ }+ deriving (Show)++instance Storable HaskellCommandInfo where+ sizeOf _ = (# size CommandInfo)+ alignment _ = (# alignment CommandInfo)+ peek ptr = do+ cmd_name' <- (# peek CommandInfo, cmd_name) ptr+ cmd_tag' <- (# peek CommandInfo, cmd_tag) ptr+ in_type' <- (# peek CommandInfo, in_type) ptr+ out_type' <- (# peek CommandInfo, out_type) ptr+ in_type_desc' <- (# peek CommandInfo, in_type_desc) ptr+ out_type_desc' <- (# peek CommandInfo, out_type_desc) ptr+ disp_level' <- (# peek CommandInfo, disp_level) ptr+ pure (HaskellCommandInfo cmd_name' cmd_tag' in_type' out_type' in_type_desc' out_type_desc' disp_level')++ -- I see no reason why we'd ever poke this (i.e. write an info struct)+ poke ptr (HaskellCommandInfo cmd_name' cmd_tag' in_type' out_type' in_type_desc' out_type_desc' disp_level') = do+ (# poke CommandInfo, cmd_name) ptr cmd_name'+ (# poke CommandInfo, cmd_tag) ptr cmd_tag'+ (# poke CommandInfo, in_type) ptr in_type'+ (# poke CommandInfo, out_type) ptr out_type'+ (# poke CommandInfo, in_type_desc) ptr in_type_desc'+ (# poke CommandInfo, out_type_desc) ptr out_type_desc'+ (# poke CommandInfo, disp_level) ptr disp_level'++qualityToHaskell :: CInt -> HaskellDataQuality+qualityToHaskell 0 = HaskellValid+qualityToHaskell 1 = HaskellInvalid+qualityToHaskell 2 = HaskellAlarm+qualityToHaskell 3 = HaskellChanging+qualityToHaskell _ = HaskellWarning++instance Storable HaskellDbDatum where+ sizeOf _ = (# size DbDatum)+ alignment _ = (# alignment DbDatum)+ peek ptr = do+ property_name' <- (# peek DbDatum, property_name) ptr+ data_type' <- (# peek DbDatum, data_type) ptr+ is_empty' <- (# peek DbDatum, is_empty) ptr+ wrong_data_type' <- (# peek DbDatum, wrong_data_type) ptr+ let withoutType =+ HaskellDbDatum+ property_name'+ is_empty'+ wrong_data_type'+ data_type'+ case data_type' of+ HaskellDevVoid -> error "encountered void type in DbDatum"+ HaskellDevUnknown -> error "encountered unknown type in DbDatum"+ HaskellDevEnum -> error "encountered enum in DbDatum"+ HaskellDevBoolean -> (withoutType . HaskellPropBool) <$> ((# peek DbDatum, prop_data) ptr)+ HaskellDevShort -> (withoutType . HaskellPropShort) <$> ((# peek DbDatum, prop_data) ptr)+ HaskellDevLong -> (withoutType . HaskellPropLong) <$> ((# peek DbDatum, prop_data) ptr)+ HaskellDevFloat -> (withoutType . HaskellPropFloat) <$> ((# peek DbDatum, prop_data) ptr)+ HaskellDevDouble -> (withoutType . HaskellPropDouble) <$> ((# peek DbDatum, prop_data) ptr)+ HaskellDevUShort -> (withoutType . HaskellPropUShort) <$> ((# peek DbDatum, prop_data) ptr)+ HaskellDevULong -> (withoutType . HaskellPropULong) <$> ((# peek DbDatum, prop_data) ptr)+ HaskellDevString -> (withoutType . HaskellPropString) <$> ((# peek DbDatum, prop_data) ptr)+ HaskellDevVarCharArray -> error "type var char array not supported in dbdatum"+ HaskellDevVarShortArray -> (withoutType . HaskellPropShortArray) <$> ((# peek DbDatum, prop_data) ptr)+ HaskellDevVarStateArray -> error "type var state array not supported in dbdatum"+ HaskellDevVarLongArray -> (withoutType . HaskellPropLongArray) <$> ((# peek DbDatum, prop_data) ptr)+ HaskellDevVarFloatArray -> (withoutType . HaskellPropFloatArray) <$> ((# peek DbDatum, prop_data) ptr)+ HaskellDevVarDoubleArray -> (withoutType . HaskellPropDoubleArray) <$> ((# peek DbDatum, prop_data) ptr)+ HaskellDevVarUShortArray -> (withoutType . HaskellPropUShortArray) <$> ((# peek DbDatum, prop_data) ptr)+ HaskellDevVarULongArray -> (withoutType . HaskellPropULongArray) <$> ((# peek DbDatum, prop_data) ptr)+ HaskellDevVarStringArray -> (withoutType . HaskellPropStringArray) <$> ((# peek DbDatum, prop_data) ptr)+ HaskellDevVarLongStringArray -> error "type long string array not supported in dbdatum"+ HaskellDevVarDoubleStringArray -> error "type double string array not supported in dbdatum"+ HaskellDevState -> error "type state not supported in dbdatum"+ HaskellConstDevString -> error "type const dev string not supported in dbdatum"+ HaskellDevVarBooleanArray -> do+ propertyName <- peekCString property_name'+ error ("encountered a property " <> show propertyName <> " with type boolean array -- this is not supported (yet)")+ HaskellDevUChar -> error "type unsigned char not supported in dbdatum"+ HaskellDevLong64 -> (withoutType . HaskellPropLong64) <$> ((# peek DbDatum, prop_data) ptr)+ HaskellDevULong64 -> (withoutType . HaskellPropULong64) <$> ((# peek DbDatum, prop_data) ptr)+ HaskellDevInt -> error "type int not supported in dbdatum"+ HaskellDevEncoded -> error "type encoded not supported in dbdatum"+ HaskellDevVarEncodedArray -> error "type encoded array not supported in dbdatum"+ HaskellDevVarLong64Array -> (withoutType . HaskellPropLong64Array) <$> ((# peek DbDatum, prop_data) ptr)+ HaskellDevVarULong64Array -> (withoutType . HaskellPropULong64Array) <$> ((# peek DbDatum, prop_data) ptr)+ poke ptr haskellDbDatum = do+ (# poke DbDatum, property_name) ptr (dbDatumPropertyName haskellDbDatum)+ (# poke DbDatum, is_empty) ptr (dbDatumIsEmpty haskellDbDatum)+ (# poke DbDatum, wrong_data_type) ptr (dbDatumWrongDataType haskellDbDatum)+ (# poke DbDatum, data_type) ptr (dbDatumDataType haskellDbDatum)+ case dbDatumPropData haskellDbDatum of+ HaskellPropDoubleArray doubles' -> do+ (# poke DbDatum, prop_data) ptr doubles'+ HaskellPropStringArray strings' -> do+ (# poke DbDatum, prop_data) ptr strings'+ -- FIXME?+ _ -> pure ()++instance Storable HaskellAttributeData where+ sizeOf _ = (# size AttributeData)+ alignment _ = (# alignment AttributeData)+ peek ptr = do+ data_type' <- (# peek AttributeData, data_type) ptr+ dim_x' <- (# peek AttributeData, dim_x) ptr+ dim_y' <- (# peek AttributeData, dim_y) ptr+ name' <- (# peek AttributeData, name) ptr+ nb_read' <- (# peek AttributeData, nb_read) ptr+ quality' <- (# peek AttributeData, quality) ptr+ data_format' <- (# peek AttributeData, data_format) ptr+ time_stamp' <- (# peek AttributeData, time_stamp) ptr+ let withoutType =+ HaskellAttributeData+ data_format'+ (qualityToHaskell quality')+ nb_read'+ name'+ dim_x'+ dim_y'+ time_stamp'+ data_type'+ case data_type' of+ HaskellDevUnknown -> error "encountered DevUnknown data type"+ HaskellDevVoid -> error "encountered DevVoid data type"+ HaskellDevVarEncodedArray -> error "encountered DevVarEncodedArray data type"+ HaskellDevBoolean -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataBoolArray attr_data'))+ HaskellDevShort -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataShortArray attr_data'))+ HaskellDevLong -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataLongArray attr_data'))+ HaskellDevFloat -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataFloatArray attr_data'))+ HaskellDevDouble -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataDoubleArray attr_data'))+ HaskellDevUShort -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataUShortArray attr_data'))+ HaskellDevULong -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataULongArray attr_data'))+ HaskellDevString -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataStringArray attr_data'))+ HaskellDevVarCharArray -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataCharArray attr_data'))+ HaskellDevVarStateArray -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataStateArray attr_data'))+ HaskellDevVarShortArray -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataShortArray attr_data'))+ HaskellDevVarLongArray -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataLongArray attr_data'))+ HaskellDevVarFloatArray -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataFloatArray attr_data'))+ HaskellDevVarDoubleArray -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataDoubleArray attr_data'))+ HaskellDevVarUShortArray -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataUShortArray attr_data'))+ HaskellDevVarULongArray -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataULongArray attr_data'))+ HaskellDevVarStringArray -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataStringArray attr_data'))+ HaskellDevVarLongStringArray -> error "long string arrays are not supported right now"+ HaskellDevVarDoubleStringArray -> error "double string arrays are not supported right now"+ HaskellDevState -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataStateArray attr_data'))+ HaskellConstDevString -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataStringArray attr_data'))+ HaskellDevUChar -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataCharArray attr_data'))+ HaskellDevVarBooleanArray -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataBoolArray attr_data'))+ HaskellDevLong64 -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataLong64Array attr_data'))+ HaskellDevULong64 -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataULong64Array attr_data'))+ HaskellDevVarLong64Array -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataLong64Array attr_data'))+ HaskellDevVarULong64Array -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataULong64Array attr_data'))+ HaskellDevInt -> error "int arrays are not supported right now"+ HaskellDevEncoded -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataEncodedArray attr_data'))+ HaskellDevEnum -> do+ attr_data' <- (# peek AttributeData, attr_data) ptr+ pure (withoutType (HaskellAttributeDataShortArray attr_data'))+ poke ptr haskellAttributeData = do+ (# poke AttributeData, dim_x) ptr (dimX haskellAttributeData)+ (# poke AttributeData, dim_y) ptr (dimY haskellAttributeData)+ (# poke AttributeData, name) ptr (name haskellAttributeData)+ (# poke AttributeData, data_type) ptr (dataType haskellAttributeData)+ case tangoAttributeData haskellAttributeData of+ HaskellAttributeDataBoolArray v -> (# poke AttributeData, attr_data) ptr v+ HaskellAttributeDataCharArray v -> (# poke AttributeData, attr_data) ptr v+ HaskellAttributeDataShortArray v -> (# poke AttributeData, attr_data) ptr v+ HaskellAttributeDataUShortArray v -> (# poke AttributeData, attr_data) ptr v+ HaskellAttributeDataLongArray v -> (# poke AttributeData, attr_data) ptr v+ HaskellAttributeDataULongArray v -> (# poke AttributeData, attr_data) ptr v+ HaskellAttributeDataLong64Array v -> (# poke AttributeData, attr_data) ptr v+ HaskellAttributeDataULong64Array v -> (# poke AttributeData, attr_data) ptr v+ HaskellAttributeDataFloatArray v -> (# poke AttributeData, attr_data) ptr v+ HaskellAttributeDataDoubleArray v -> (# poke AttributeData, attr_data) ptr v+ HaskellAttributeDataStringArray v -> (# poke AttributeData, attr_data) ptr v+ HaskellAttributeDataStateArray v -> (# poke AttributeData, attr_data) ptr v+ HaskellAttributeDataEncodedArray v -> (# poke AttributeData, attr_data) ptr v++instance Storable HaskellCommandData where+ sizeOf _ = (# size CommandData)+ alignment _ = (# alignment CommandData)+ peek ptr = do+ data_type' <- (# peek CommandData, arg_type) ptr+ case data_type' of+ HaskellDevVoid -> pure (HaskellCommandData data_type' HaskellCommandVoid)+ HaskellDevBoolean -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandBool cmd_data'))+ HaskellDevShort -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandShort cmd_data'))+ HaskellDevUShort -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandUShort cmd_data'))+ -- There seems to be no "UInt" for some reason+ HaskellDevInt -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandInt32 cmd_data'))+ HaskellDevFloat -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandFloat cmd_data'))+ HaskellDevDouble -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandDouble cmd_data'))+ HaskellDevString -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandCString cmd_data'))+ HaskellDevLong64 -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandLong64 cmd_data'))+ HaskellDevState -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandDevState cmd_data'))+ HaskellDevULong64 -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandULong64 cmd_data'))+ HaskellDevEncoded -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandDevEncoded cmd_data'))+ HaskellDevEnum -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandDevEnum cmd_data'))+ HaskellDevVarBooleanArray -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandVarBool cmd_data'))+ HaskellDevVarCharArray -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandVarChar cmd_data'))+ HaskellDevVarShortArray -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandVarShort cmd_data'))+ HaskellDevVarUShortArray -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandVarUShort cmd_data'))+ HaskellDevVarLongArray -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandVarLong cmd_data'))+ HaskellDevVarULongArray -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandVarULong cmd_data'))+ HaskellDevVarLong64Array -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandVarLong64 cmd_data'))+ HaskellDevVarULong64Array -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandVarULong64 cmd_data'))+ HaskellDevVarFloatArray -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandVarFloat cmd_data'))+ HaskellDevVarDoubleArray -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandVarDouble cmd_data'))+ HaskellDevVarStringArray -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandVarCString cmd_data'))+ -- Also curiously, no type for this exists+ -- HaskellDevVarDevStateArray -> do+ -- cmd_data' <- (#peek CommandData, cmd_data) ptr+ -- pure (HaskellCommandData data_type' (HaskellCommandVarDevState cmd_data'))+ HaskellDevVarLongStringArray -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandLongStringArray cmd_data'))+ HaskellDevVarDoubleStringArray -> do+ cmd_data' <- (# peek CommandData, cmd_data) ptr+ pure (HaskellCommandData data_type' (HaskellCommandDoubleStringArray cmd_data'))+ _ -> error "shit"+ poke ptr (HaskellCommandData argType' tangoCommandData') = do+ (# poke CommandData, arg_type) ptr argType'+ case tangoCommandData' of+ HaskellCommandVoid -> pure ()+ HaskellCommandBool v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandShort v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandUShort v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandInt32 v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandUInt32 v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandFloat v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandDouble v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandCString v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandLong64 v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandDevState v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandULong64 v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandDevEncoded v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandVarBool v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandVarChar v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandVarShort v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandVarUShort v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandVarLong v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandVarULong v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandVarLong64 v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandVarULong64 v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandVarFloat v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandVarDouble v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandVarCString v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandVarDevState v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandLongStringArray v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandDoubleStringArray v -> (# poke CommandData, cmd_data) ptr v+ HaskellCommandDevEnum v -> (# poke CommandData, cmd_data) ptr v++-- | How severe is the error (used in the Tango error types)+data ErrSeverity+ = Warn+ | Err+ | Panic+ deriving (Show, Eq, Bounded, Enum)++instance Storable ErrSeverity where+ sizeOf _ = (# size TangoDevState)+ alignment _ = (# alignment TangoDevState)+ peek = peekBounded "ErrSeverity"+ poke = pokeBounded "ErrSeverity"++-- | Wraps one piece of a Tango error trace (usually you will have lists of @DevFailed@ records). This is a generic to make treating its fields easier with respect to 'Text' and 'CString' (it's also a 'Functor' and 'Traversable' and all that for that reason)+data DevFailed a = DevFailed+ { -- | Failure description; this will usually be the actual error message you're interested in and will be human-readable+ devFailedDesc :: !a,+ -- | Failure reason; this is usually an error code string, like @API_AttrNotFound@+ devFailedReason :: !a,+ -- | Failure origin: this is usually the C++ function that caused the error+ devFailedOrigin :: !a,+ -- | Severity: not sure what the consequences of the individual severities are+ devFailedSeverity :: !ErrSeverity+ }+ deriving (Functor, Foldable, Traversable, Generic, Show)++instance (Storable a) => GStorable (DevFailed a)++data HaskellErrorStack = HaskellErrorStack+ { errorStackLength :: !Word32,+ errorStackSequence :: !(Ptr (DevFailed CString))+ }+ deriving (Generic)++instance GStorable HaskellErrorStack++data HaskellDbData = HaskellDbData+ { dbDataLength :: Word32,+ dbDataSequence :: Ptr HaskellDbDatum+ }+ deriving (Show, Generic)++instance GStorable HaskellDbData++data HaskellCommandInfoList = HaskellCommandInfoList+ { commandInfoLength :: Word32,+ commandInfoSequence :: Ptr HaskellCommandInfo+ }+ deriving (Show, Generic)++instance GStorable HaskellCommandInfoList++data HaskellAttributeInfoList = HaskellAttributeInfoList+ { attributeInfoListLength :: Word32,+ attributeInfoListSequence :: Ptr HaskellAttributeInfo+ }+ deriving (Show, Generic)++instance GStorable HaskellAttributeInfoList++data HaskellAttributeDataList = HaskellAttributeDataList+ { attributeDataListLength :: Word32,+ attributeDataListSequence :: Ptr HaskellAttributeData+ }+ deriving (Show, Generic)++instance GStorable HaskellAttributeDataList++type DeviceProxyPtr = Ptr ()++type DatabaseProxyPtr = Ptr ()++type TangoError = Ptr HaskellErrorStack++foreign import capi "c_tango.h tango_create_device_proxy"+ tango_create_device_proxy :: CString -> Ptr DeviceProxyPtr -> IO TangoError++foreign import capi "c_tango.h tango_delete_device_proxy"+ tango_delete_device_proxy :: DeviceProxyPtr -> IO TangoError++foreign import capi "c_tango.h tango_read_attribute"+ tango_read_attribute :: DeviceProxyPtr -> CString -> Ptr HaskellAttributeData -> IO TangoError++foreign import capi "c_tango.h tango_write_attribute"+ tango_write_attribute :: DeviceProxyPtr -> Ptr HaskellAttributeData -> IO TangoError++foreign import capi "c_tango.h tango_command_inout"+ tango_command_inout :: DeviceProxyPtr -> CString -> Ptr HaskellCommandData -> Ptr HaskellCommandData -> IO TangoError++foreign import capi "c_tango.h tango_free_AttributeData"+ tango_free_AttributeData :: Ptr HaskellAttributeData -> IO ()++foreign import capi "c_tango.h tango_free_AttributeInfoList"+ tango_free_AttributeInfoList :: Ptr HaskellAttributeInfoList -> IO ()++foreign import capi "c_tango.h tango_free_CommandData"+ tango_free_CommandData :: Ptr HaskellCommandData -> IO ()++foreign import capi "c_tango.h tango_free_VarStringArray"+ tango_free_VarStringArray :: Ptr (HaskellTangoVarArray CString) -> IO ()++foreign import capi "c_tango.h tango_set_timeout_millis"+ tango_set_timeout_millis :: DeviceProxyPtr -> CInt -> IO TangoError++foreign import capi "c_tango.h tango_get_timeout_millis"+ tango_get_timeout_millis :: DeviceProxyPtr -> Ptr CInt -> IO TangoError++foreign import capi "c_tango.h tango_set_source"+ tango_set_source :: DeviceProxyPtr -> CInt -> IO TangoError++-- comment out for now: it has some incompatible pointer error in capi+-- foreign import capi "c_tango.h tango_get_source"+-- tango_get_source :: DeviceProxyPtr -> Ptr CInt -> IO TangoError++foreign import capi "c_tango.h tango_lock"+ tango_lock :: DeviceProxyPtr -> IO TangoError++foreign import capi "c_tango.h tango_unlock"+ tango_unlock :: DeviceProxyPtr -> IO TangoError++-- comment out for now: it has some incompatible pointer error in capi+-- foreign import capi "c_tango.h tango_is_locked"+-- tango_is_locked :: DeviceProxyPtr -> Ptr Bool -> IO TangoError++-- comment out for now: it has some incompatible pointer error in capi+-- foreign import capi "c_tango.h tango_is_locked_by_me"+-- tango_is_locked_by_me :: DeviceProxyPtr -> Ptr Bool -> IO TangoError++foreign import capi "c_tango.h tango_locking_status"+ tango_locking_status :: DeviceProxyPtr -> Ptr CString -> IO TangoError++foreign import capi "c_tango.h tango_command_list_query"+ tango_command_list_query :: DeviceProxyPtr -> Ptr HaskellCommandInfoList -> IO TangoError++foreign import capi "c_tango.h tango_command_query"+ tango_command_query :: DeviceProxyPtr -> CString -> Ptr HaskellCommandInfo -> IO TangoError++foreign import capi "c_tango.h tango_free_CommandInfo"+ tango_free_CommandInfo :: Ptr HaskellCommandInfo -> IO ()++foreign import capi "c_tango.h tango_free_CommandInfoList"+ tango_free_CommandInfoList :: Ptr HaskellCommandInfoList -> IO ()++foreign import capi "c_tango.h tango_get_attribute_list"+ tango_get_attribute_list :: DeviceProxyPtr -> Ptr (HaskellTangoVarArray CString) -> IO TangoError++foreign import capi "c_tango.h tango_get_attribute_config"+ tango_get_attribute_config :: DeviceProxyPtr -> Ptr (HaskellTangoVarArray CString) -> Ptr HaskellAttributeInfoList -> IO TangoError++foreign import capi "c_tango.h tango_read_attributes"+ tango_read_attributes :: DeviceProxyPtr -> Ptr (HaskellTangoVarArray CString) -> Ptr HaskellAttributeDataList -> IO TangoError++foreign import capi "c_tango.h tango_write_attributes"+ tango_write_attributes :: DeviceProxyPtr -> Ptr HaskellAttributeDataList -> IO TangoError++foreign import capi "c_tango.h tango_create_database_proxy"+ tango_create_database_proxy :: Ptr DatabaseProxyPtr -> IO TangoError++foreign import capi "c_tango.h tango_delete_database_proxy"+ tango_delete_database_proxy :: DatabaseProxyPtr -> IO TangoError++foreign import capi "c_tango.h tango_get_device_exported"+ tango_get_device_exported :: DatabaseProxyPtr -> CString -> Ptr HaskellDbDatum -> IO TangoError++foreign import capi "c_tango.h tango_get_device_exported_for_class"+ tango_get_device_exported_for_class :: DatabaseProxyPtr -> CString -> Ptr HaskellDbDatum -> IO TangoError++foreign import capi "c_tango.h tango_get_object_list"+ tango_get_object_list :: DatabaseProxyPtr -> CString -> Ptr HaskellDbDatum -> IO TangoError++foreign import capi "c_tango.h tango_get_object_property_list"+ tango_get_object_property_list :: DatabaseProxyPtr -> CString -> CString -> Ptr HaskellDbDatum -> IO TangoError++foreign import capi "c_tango.h tango_get_property"+ tango_get_property :: DatabaseProxyPtr -> CString -> Ptr HaskellDbData -> IO TangoError++foreign import capi "c_tango.h tango_put_property"+ tango_put_property :: DatabaseProxyPtr -> CString -> Ptr HaskellDbData -> IO TangoError++foreign import capi "c_tango.h tango_delete_property"+ tango_delete_property :: DatabaseProxyPtr -> CString -> Ptr HaskellDbData -> IO TangoError++foreign import capi "c_tango.h tango_get_device_property"+ tango_get_device_property :: DeviceProxyPtr -> Ptr HaskellDbData -> IO TangoError++foreign import capi "c_tango.h tango_put_device_property"+ tango_put_device_property :: DeviceProxyPtr -> Ptr HaskellDbData -> IO TangoError++foreign import capi "c_tango.h tango_delete_device_property"+ tango_delete_device_property :: DeviceProxyPtr -> Ptr HaskellDbData -> IO TangoError++foreign import capi "c_tango.h tango_free_DbDatum"+ tango_free_DbDatum :: Ptr HaskellDbDatum -> IO ()++foreign import capi "c_tango.h tango_free_DbData"+ tango_free_DbData :: Ptr HaskellDbData -> IO ()++type EventCallback = Ptr () -> CString -> Bool -> IO ()++foreign import ccall "wrapper" createEventCallbackWrapper :: EventCallback -> IO (FunPtr EventCallback)++foreign import capi "c_tango.h tango_create_event_callback"+ tango_create_event_callback :: FunPtr EventCallback -> IO (Ptr ())++foreign import capi "c_tango.h tango_free_event_callback"+ tango_free_event_callback :: Ptr () -> IO ()++foreign import capi "c_tango.h tango_subscribe_event"+ tango_subscribe_event :: DeviceProxyPtr -> CString -> CInt -> Ptr () -> CBool -> IO CInt++foreign import capi "c_tango.h tango_unsubscribe_event"+ tango_unsubscribe_event :: DeviceProxyPtr -> CInt -> IO ()++foreign import capi "c_tango.h tango_poll_command"+ tango_poll_command :: DeviceProxyPtr -> CString -> CInt -> IO TangoError++foreign import capi "c_tango.h tango_stop_poll_command"+ tango_stop_poll_command :: DeviceProxyPtr -> CString -> IO TangoError++foreign import capi "c_tango.h tango_poll_attribute"+ tango_poll_attribute :: DeviceProxyPtr -> CString -> CInt -> IO TangoError++foreign import capi "c_tango.h tango_stop_poll_attribute"+ tango_stop_poll_attribute :: DeviceProxyPtr -> CString -> IO TangoError++-- FIXME: This function is not memory-safe!+-- foreign import capi "c_tango.h tango_throw_exception"+-- tango_throw_exception :: CString -> IO ()