Help reducing repetition in a C binding

Learn
1

I’m writing bindings to a C library that interfaces with hardware. One of the functions reads an attribute with a name (the CString below) from a device (the DeviceProxyPtr):

tango_read_attribute :: DeviceProxyPtr -> CString -> Ptr HaskellAttributeData -> IO ()

This C function fills HaskellAttributeData, which is a record. For now, only one of the record fields is important: tangoAttributeData :: HaskellTangoAttributeData - the actual data. This, in turn, is defined as:

data HaskellTangoAttributeData
  = HaskellAttributeDataBoolArray !(HaskellTangoVarArray CBool)
  | HaskellAttributeDataCharArray !(HaskellTangoVarArray CChar)
  | HaskellAttributeDataShortArray !(HaskellTangoVarArray CShort)
  | HaskellAttributeDataUShortArray !(HaskellTangoVarArray CUShort)
  | many more types here

Finally, HaskellTangoVarArray is:

data HaskellTangoVarArray a = HaskellTangoVarArray
  { varArrayLength :: Word32,
    varArrayValues :: Ptr a
  }

(even for a scalar attribute, we get an array, and then take only the first element - but there are array attributes as well and even 2D images)

Sorry for the long opener, but I didn’t know how to cut it down further.

The problem is, I’d like to expose functions like readBoolAttribute, readShortAttribute, readUShortAttribute and so on, but without repeating myself too much. My current approach is pretty minimal:

readBoolAttribute :: DeviceProxy -> AttributeName -> IO Bool
readBoolAttribute =
  readAttributeSimple extract
  where
    extract (HaskellAttributeDataBoolArray (HaskellTangoVarArray {varArrayValues})) = Just . (/= 0) <$> peek varArrayValues
    extract _ = pure Nothing

As you can see, I’ve written a function readAttributeSimple that takes care of the FFI specific things and leaves the extract function to pattern-match the right constructor type and then convert to the target format.

My question is, can I write this with even less repetition? Via Template Haskell? Type magic? I’m willing to include extensions from, say, ghc 9.6, if it helps.

2

I think you could do this:

data MyType t where
  TBool :: MyType CBool
  TChar :: MyType CChar
  TShort :: MyType CShort
  TUShort :: MyType CUShort
  ...

-- You could use `EqP` from the `some` package:
-- https://hackage.haskell.org/package/some-1.0.6/docs/Data-EqP.html#t:EqP
equalType :: MyType t -> MyType t' -> Maybe (t :~: t')
equalType TBool TBool = Just Refl
...
equalType TUShort TUShort = Just Refl
...
equalType _ _ = Nothing

data HaskellTangoAttributeData where
  HaskellAttributeArray :: !(MyType t) -> !(HaskellTangoVarArray t) -> HaskellTangoAttributeData

readAttribute :: Storable t => MyType t -> DeviceProxy -> AttributeName -> IO t
readAttribute t = readAttributeSimple extract where
  extract (HaskellAttributeArray t' (HaskellTangoVarArray varArrayValues)) =
    case equalType t t' of
      Just Refl -> Just <$> peek varArrayValues
      Nothing -> pure Nothing