Fourth attempt

Author: bolt12

examples/c-qrcode/generate-and-run.sh

@@ -10,11 +10,14 @@ echo "# "
 echo "# Building qrcode C bindings"
 echo "# "
 
-git submodule init QR-Code-generator
-git submodule update QR-Code-generator
-
-cd "$SCRIPT_DIR/QR-Code-generator/c"
-make
+# Check out the submodule and build the C library only if it is not already
+# built. Delete libqrcodegen.a to force a rebuild.
+if [ -e "$SCRIPT_DIR/QR-Code-generator/c/libqrcodegen.a" ]; then
+    echo "# libqrcodegen.a already built, skipping submodule checkout and make"
+else
+    git submodule update --init "$SCRIPT_DIR/QR-Code-generator"
+    ( cd "$SCRIPT_DIR/QR-Code-generator/c" && make )
+fi
 
 echo "# "
 echo "# Generating Haskell bindings"
@@ -32,28 +35,27 @@ cabal run hs-bindgen-cli -- \
     "$SCRIPT_DIR/QR-Code-generator/c/qrcodegen.h"
 
 echo "# "
-echo "# Updating cabal.project.local"
+echo "# Writing cabal.project.local"
 echo "# "
 
-LINE=$(
-    cat <<-EOF
+# cabal.project.local is gitignored and machine-specific, so rewrite it from
+# scratch each run rather than appending (which would accumulate stale paths).
+cat > "$SCRIPT_DIR/hs-project/cabal.project.local" <<EOF
 package c-qrcode
     extra-include-dirs:
         $SCRIPT_DIR/QR-Code-generator/c/
     extra-lib-dirs:
         $SCRIPT_DIR/QR-Code-generator/c/
 EOF
-)
-grep -qxF "$LINE" "$SCRIPT_DIR/hs-project/cabal.project.local" || echo "$LINE" >>"$SCRIPT_DIR/hs-project/cabal.project.local"
 cat "$SCRIPT_DIR/hs-project/cabal.project.local"
 
 echo "# "
 echo "# Done!"
 echo "# "
 echo "Running the project"
 
-cd $SCRIPT_DIR/hs-project
-export LD_LIBRARY_PATH=$SCRIPT_DIR/QR-Code-generator/c/:\$LD_LIBRARY_PATH
+cd "$SCRIPT_DIR/hs-project"
+export LD_LIBRARY_PATH="$SCRIPT_DIR/QR-Code-generator/c/:$LD_LIBRARY_PATH"
 
-cabal build
-cabal run c-qrcode
+cabal build exe:c-qrcode
+cabal run exe:c-qrcode

examples/c-qrcode/hs-project/app/HighLevel.hs

@@ -1,4 +1,10 @@
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies     #-}
+
+-- The DefaultIn instances for the generated enums below are orphans: the enum types
+-- and the class are both defined elsewhere. The natural home is the generated module
+-- (ideally hs-bindgen would emit them), so silence the expected warning here.
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 -- | High-level wrappers around the generated qrcodegen bindings.
 --
@@ -11,21 +17,33 @@ module HighLevel (
 import Data.Word (Word8)
 import Foreign.Ptr (Ptr)
 
-import HsBindgen.Runtime.HighLevel.ToHighLevel (OutMarshaller, input, output,
-                                                pureIn, scratchArray,
-                                                toHighLevel)
-import HsBindgen.Runtime.HighLevel.ToHighLevel.Defaults (defaultIn, defaultRes)
-import HsBindgen.Runtime.HighLevel.ToHighLevel.Marshallers (peekIncompleteArrayOut,
-                                                            withCStringIn,
-                                                            withConstIncompleteArrayIn)
+import HsBindgen.Runtime.HighLevel (output, scratchArray, toHighLevel)
+import HsBindgen.Runtime.HighLevel.Defaults (DefaultIn (..), auto)
+import HsBindgen.Runtime.HighLevel.Marshaller (Unmarshaller, scalar)
+import HsBindgen.Runtime.HighLevel.Marshaller.Utils (peekIncompleteArrayOut)
 import HsBindgen.Runtime.IncompleteArray (IncompleteArray)
 
 import QRCodeGenerator.Generated qualified as QR
 import QRCodeGenerator.Generated.Safe qualified as QR
 
--- | Lift @qrcodegen_encodeText@. @tempBuffer@ is a 'scratchArray', so it adds
--- nothing to the result: only the QR code and the success flag come back. The
--- scalar inputs and the result use default marshallers.
+-- | Passthrough defaults for the generated enums: each enum is its own C argument
+-- type, so the default marshaller is @scalar id@. With these in scope, 'auto' can
+-- fill the @ecc@ and @mask@ arguments of 'encodeText'. These are orphan instances;
+-- the natural home is alongside the enum in the generated module, so ideally
+-- hs-bindgen would emit them.
+instance DefaultIn QR.Qrcodegen_Ecc where
+  type DefInArrow QR.Qrcodegen_Ecc lo = QR.Qrcodegen_Ecc -> lo
+  defaultIn = scalar id
+
+instance DefaultIn QR.Qrcodegen_Mask where
+  type DefInArrow QR.Qrcodegen_Mask lo = QR.Qrcodegen_Mask -> lo
+  defaultIn = scalar id
+
+-- | Lift @qrcodegen_encodeText@. Only the two positions that need a human decision
+-- are explicit: @tempBuffer@ is a 'scratchArray' (the callee writes it, the caller
+-- never sees it) and @qrcode@ is the 'output' we keep. 'auto' fills the rest from
+-- the signature: the leading 'String', then the two enums, the version 'Int's, the
+-- boost 'Bool', and the result.
 encodeText
   :: String
   -> QR.Qrcodegen_Ecc
@@ -35,33 +53,22 @@ encodeText
   -> Bool
   -> IO (IncompleteArray Word8, Bool)
 encodeText = toHighLevel
-  ( input   withCStringIn
+  ( auto                       -- text (String)
   $ scratchArray @Word8 maxLen -- tempBuffer: written, never read
-  $ output  qrCodeOut
-  $ input   (pureIn id)        -- ecc level (enum, passthrough)
-  $ input   defaultIn          -- minVersion (Int -> CInt)
-  $ input   defaultIn          -- maxVersion (Int -> CInt)
-  $ input   (pureIn id)        -- mask (enum, passthrough)
-  $ input   defaultIn          -- boostEcl (Bool -> CBool)
-  $ defaultRes                 -- CBool -> Bool
+  $ output  qrCodeOut          -- qrcode: the out-parameter we keep
+  $ auto                       -- ecc, minVersion, maxVersion, mask, boostEcl, result
   ) QR.qrcodegen_encodeText
   where
     maxLen :: Int
     maxLen = fromIntegral QR.qrcodegen_BUFFER_LEN_MAX
 
-    qrCodeOut :: OutMarshaller (Ptr Word8) (IncompleteArray Word8)
+    qrCodeOut :: Unmarshaller (Ptr Word8) (IncompleteArray Word8)
     qrCodeOut = peekIncompleteArrayOut maxLen
 
+-- | Every position is a default ('IncompleteArray' marshals as a @const@ pointer,
+-- 'CInt' \/ 'CBool' scalars), so the whole wrapper is 'auto'.
 getSize :: IncompleteArray Word8 -> IO Int
-getSize = toHighLevel
-  ( input  withConstIncompleteArrayIn
-  $ defaultRes
-  ) QR.qrcodegen_getSize
+getSize = toHighLevel auto QR.qrcodegen_getSize
 
 getModule :: IncompleteArray Word8 -> Int -> Int -> IO Bool
-getModule = toHighLevel
-  ( input  withConstIncompleteArrayIn
-  $ input  defaultIn                  -- x (Int -> CInt)
-  $ input  defaultIn                  -- y (Int -> CInt)
-  $ defaultRes                 -- CBool -> Bool
-  ) QR.qrcodegen_getModule
+getModule = toHighLevel auto QR.qrcodegen_getModule

examples/libpcap/generate-and-run.sh

@@ -5,22 +5,33 @@ set -e
 SCRIPT_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd)"
 PROJECT_ROOT="$(cd "$SCRIPT_DIR/../.." && pwd)"
 export PROJECT_ROOT
+cd "$SCRIPT_DIR"
 
-(
+# Download and build libpcap only if it is not already built. Delete the
+# ./libpcap directory to force a fresh download and rebuild. (The previous
+# version unconditionally deleted and re-downloaded, which fails offline and
+# throws away an existing build.)
+if [ -e libpcap/libpcap.so ]; then
     echo "# "
-    echo "# Building libpcap"
+    echo "# libpcap already built in ./libpcap, skipping download"
     echo "# "
+else
+    (
+        echo "# "
+        echo "# Building libpcap"
+        echo "# "
 
-    rm -rfv libpcap*
-    wget https://www.tcpdump.org/release/libpcap-1.10.5.tar.xz
-    tar -xf libpcap-1.10.5.tar.xz
-    mv libpcap-1.10.5 libpcap
-    rm libpcap-1.10.5.tar.xz
+        rm -rfv libpcap libpcap-1.10.5 libpcap-1.10.5.tar.xz
+        wget https://www.tcpdump.org/release/libpcap-1.10.5.tar.xz
+        tar -xf libpcap-1.10.5.tar.xz
+        mv libpcap-1.10.5 libpcap
+        rm libpcap-1.10.5.tar.xz
 
-    cd "libpcap"
-    cmake .
-    make
-)
+        cd "libpcap"
+        cmake .
+        make
+    )
+fi
 
 LIBPCAP_DIR=$(realpath libpcap)
 
@@ -31,18 +42,18 @@ echo "# "
 ./generate.sh
 
 echo "# "
-echo "# Updating cabal.project.local"
+echo "# Writing cabal.project.local"
 echo "# "
 
-LINE=$(cat <<-EOF
+# cabal.project.local is gitignored and machine-specific, so rewrite it from
+# scratch each run rather than appending (which would accumulate stale paths).
+cat > "$SCRIPT_DIR/hs-project/cabal.project.local" <<EOF
 package libpcap
     extra-include-dirs:
         $LIBPCAP_DIR
     extra-lib-dirs:
         $LIBPCAP_DIR
 EOF
-)
-grep -qxF "$LINE" "$SCRIPT_DIR/hs-project/cabal.project.local" || echo "$LINE" >> "$SCRIPT_DIR/hs-project/cabal.project.local"
 cat "$SCRIPT_DIR/hs-project/cabal.project.local"
 
 echo "# "

examples/libpcap/hs-project/app/HighLevel.hs

@@ -10,29 +10,28 @@ module HighLevel (
 import Control.Exception (Exception, throwIO)
 import Control.Monad (when)
 import Foreign.C.String qualified as C
-import Foreign.C.Types (CInt)
-import Foreign.Marshal.Alloc (alloca)
+import Foreign.C.Types (CChar, CInt)
+import Foreign.Marshal.Alloc (alloca, allocaBytes)
 import Foreign.Ptr (Ptr, nullPtr)
 import Foreign.Storable (peek)
 
-import HsBindgen.Runtime.HighLevel.ToHighLevel (OutMarshaller, mkOut, output,
-                                                resultPure, toHighLevel)
-import HsBindgen.Runtime.HighLevel.ToHighLevel.Marshallers (peekCStringOut)
+import HsBindgen.Runtime.HighLevel (output, resultIO, scratch, toHighLevel)
+import HsBindgen.Runtime.HighLevel.Marshaller (Unmarshaller, unmarshalOutWith)
 
 import Generated.Pcap qualified as Pcap
 import Generated.Pcap.Safe qualified as Pcap
 
 -- | Thrown by 'findAllDevNames' when @pcap_findalldevs@ reports failure.
 --
-data PcapError = PcapError { msg :: String, code :: CInt }
+data PcapError = PcapError { msg :: String, code :: Int }
   deriving stock (Show)
 instance Exception PcapError
 
 -- | Allocate a @pcap_if_t **@, walk the linked list after the call, free it.
 --
 peekPcapDeviceNames
-  :: OutMarshaller (Ptr (Ptr Pcap.Pcap_if_t)) [String]
-peekPcapDeviceNames = mkOut alloca $ \pp -> do
+  :: Unmarshaller (Ptr (Ptr Pcap.Pcap_if_t)) [String]
+peekPcapDeviceNames = unmarshalOutWith alloca $ \pp -> do
   headPtr <- peek pp
   names   <- collect [] headPtr
   Pcap.pcap_freealldevs headPtr
@@ -45,16 +44,24 @@ peekPcapDeviceNames = mkOut alloca $ \pp -> do
           name <- C.peekCString (Pcap.pcap_if_t_name dev)
           collect (name : acc) (Pcap.pcap_if_t_next dev)
 
--- | Collect the names of all devices visible to libpcap. The status check
--- runs after the spec rather than inside a 'throwOn' because the error
--- buffer lives in a separate output position.
+-- | Collect the names of all devices visible to libpcap. @pcap_findalldevs@
+-- signals failure with a non-zero status and writes a message into a separate
+-- error buffer. The buffer is pre-allocated and passed as 'scratch', so the
+-- 'resultIO' closer can read it and throw on failure, keeping the check inside
+-- the spec.
 --
 findAllDevNames :: IO [String]
-findAllDevNames = do
-  (names, errMsg, status) <- toHighLevel
-    ( output peekPcapDeviceNames
-    $ output (peekCStringOut (fromIntegral Pcap.pCAP_ERRBUF_SIZE))
-    $ resultPure id
-    ) Pcap.pcap_findalldevs
-  when (status /= 0) $ throwIO (PcapError errMsg status)
-  pure names
+findAllDevNames =
+  allocaBytes (fromIntegral Pcap.pCAP_ERRBUF_SIZE) $ \errbuf -> do
+    (names, ()) <- toHighLevel
+      ( output peekPcapDeviceNames        -- pcap_if_t ** : device names (kept)
+      $ scratch (\k -> k errbuf)          -- char *       : pre-allocated errbuf
+      $ resultIO (throwOnStatus errbuf)   -- int          : throw on failure
+      ) Pcap.pcap_findalldevs
+    pure names
+  where
+    throwOnStatus :: Ptr CChar -> CInt -> IO ()
+    throwOnStatus errbuf status =
+      when (status /= 0) $ do
+        errMsg <- C.peekCString errbuf
+        throwIO (PcapError errMsg (fromIntegral status))

hs-bindgen-runtime/CHANGELOG.md

@@ -5,7 +5,35 @@
 ### New features
 
 * Add a combinator library for hand-writing high-level wrappers over the
-  generated low-level FFI bindings.
+  generated low-level FFI bindings, in two modules under
+  `HsBindgen.Runtime.HighLevel`. `Marshaller` is the marshaller vocabulary: a
+  single `Marshal` arrow marshals a Haskell value into the C argument(s) it fills
+  (build one with `scalar` or `bracket`, aim it with `at`, compose fields with
+  `>>>` from the `Category` instance, and embed a sub-struct with `marshalNested`). A
+  `MarshalStruct` seals a field chain into a whole-struct marshaller; `Unmarshaller`
+  handles out-parameters; and `UnmarshalStruct` is the dual that reads C back into
+  Haskell.
+  Optional values cross the boundary with `marshalOptional` (write) and `unmarshalOptional`
+  (read). `HighLevel` itself lifts a low-level function into a wrapper (`input` /
+  `output` / `scratch` / result closers) and drops a struct marshaller into a
+  wrapper position with `asArgument` / `asOutput` / `asResult`; a by-value struct
+  argument is written into a zeroed slot, so its padding reaches C as zeros. Kept
+  outputs accumulate into a flat result tuple (result last, up to eight
+  components). Ready-made
+  marshallers live in `Marshaller.Utils` and per-type defaults in `Defaults`, where
+  `auto` is a single combinator that fills the mundane input positions and the
+  closer of a wrapper from its high-level signature. It covers multi-C-argument
+  defaults (such as a `ByteString` filling a `(const char *, size_t)` pair) and any
+  user-defined `DefaultIn`, so only the interesting positions are written by hand;
+  outputs stay explicit via `output`. The built-in defaults convert the idiomatic
+  scalars (`Int`, `Word`, `Bool`, `Double`, `Float`) and the `String` / `ByteString`
+  / `IncompleteArray` compounds, and pass through unchanged every raw C scalar type,
+  every fixed-width type, and a raw pointer or function pointer (`Ptr` / `FunPtr`).
+  In every position, including the result, the Haskell type in the signature picks the
+  representation, so `auto` closes a wrapper that keeps the C return type (`IO CInt`)
+  as readily as one that converts it (`IO Int`).
+  The combinators (including `auto`) carry
+  `INLINE` pragmas and fuse to the raw `alloca` / `poke` / `peek` at `-O2`.
 
 ## 0.1.0-alpha2 -- 2026-03-27
 

hs-bindgen-runtime/hs-bindgen-runtime.cabal

@@ -77,10 +77,12 @@ library
     HsBindgen.Runtime.FLAM
     HsBindgen.Runtime.HasCBitfield
     HsBindgen.Runtime.HasCField
-    HsBindgen.Runtime.HighLevel.ToHighLevel
-    HsBindgen.Runtime.HighLevel.ToHighLevel.Defaults
-    HsBindgen.Runtime.HighLevel.ToHighLevel.Errors
-    HsBindgen.Runtime.HighLevel.ToHighLevel.Marshallers
+    HsBindgen.Runtime.HighLevel
+    HsBindgen.Runtime.HighLevel.Defaults
+    HsBindgen.Runtime.HighLevel.Internal.Errors
+    HsBindgen.Runtime.HighLevel.Internal.Threading
+    HsBindgen.Runtime.HighLevel.Marshaller
+    HsBindgen.Runtime.HighLevel.Marshaller.Utils
     HsBindgen.Runtime.IncompleteArray
     HsBindgen.Runtime.Internal.Bitfield
     HsBindgen.Runtime.Internal.ByteArray
@@ -133,7 +135,7 @@ test-suite test-hs-bindgen-runtime
     Test.HsBindgen.Runtime.CEnum
     Test.HsBindgen.Runtime.CEnumArbitrary
     Test.HsBindgen.Runtime.ConstantArray
-    Test.HsBindgen.Runtime.HighLevel.CoreDump
+    Test.HsBindgen.Runtime.HighLevel.Struct
     Test.HsBindgen.Runtime.HighLevel.Test
     Test.HsBindgen.Runtime.IncompleteArray
     Test.HsBindgen.Runtime.SizedByteArray