Replace all fromIntegral with unwitch conversions

hatter.cabal

@@ -119,7 +119,8 @@ library
       containers < 1,
       bytestring < 1,
       transformers < 0.7,
-      time
+      time,
+      unwitch >= 3.0.0 && < 4
   c-sources:
       cbits/android_stubs.c
       cbits/platform_log.c
@@ -191,7 +192,8 @@ executable redraw-demo
       test
   build-depends:
       hatter,
-      text
+      text,
+      unwitch >= 3.0.0 && < 4
 
 executable confetti-repro-demo
   import: common-options
@@ -250,4 +252,5 @@ test-suite unit
       text,
       bytestring,
       directory,
-      filepath
+      filepath,
+      unwitch >= 3.0.0 && < 4

nix/cross-deps.nix

@@ -228,10 +228,18 @@ WRAPPER
         });
     } else {};
 
+  unwitchOverride = self: super: {
+    unwitch = self.callCabal2nix "unwitch" (builtins.fetchTarball {
+      url = "https://github.com/jappeace/unwitch/archive/2759bdd153f293e0e6524d0170e861e51302caa4.tar.gz";
+      sha256 = "sha256:BGxZ1CQGIYP/gg/J9jua2/wSEH4qq7bW91qooNELUlI=";
+    }) {};
+  };
+
   defaultOverrides =
     let
       common = pkgs.lib.composeManyExtensions [
         vectorOverride
+        unwitchOverride
         thPackageDbOverride
         thIservOverride
         hatterOverride
@@ -284,9 +292,13 @@ WRAPPER
   # so its .a and .conf are available for linking.
   hatterDep = if hatterSrc != null then [ crossHaskellPkgs.hatter ] else [];
 
+  # Hatter's own non-boot dependencies — must be collected so hatter's
+  # .conf can resolve them (collect-deps doesn't follow propagatedBuildInputs).
+  hatterOwnDeps = [ crossHaskellPkgs.unwitch ];
+
 in import ./collect-deps.nix {
   inherit pkgs ghc ghcPkgCmd;
-  deps = resolvedDeps ++ hatterDep;
+  deps = resolvedDeps ++ hatterDep ++ hatterOwnDeps;
   mainLibPnames = if hatterSrc != null then [ "hatter" ] else [];
   iservProxy = iservWrapper;
 }

nix/hpkgs.nix

@@ -9,5 +9,9 @@ pkgs.haskellPackages.override {
     # NB this is a bit silly because nix files are now considered for the build
     # bigger projects should consider putting haskell stuff in a subfolder
     hatter-project = hnew.callCabal2nix "hatter" ../. { };
+    unwitch = hnew.callCabal2nix "unwitch" (builtins.fetchTarball {
+      url = "https://github.com/jappeace/unwitch/archive/2759bdd153f293e0e6524d0170e861e51302caa4.tar.gz";
+      sha256 = "sha256:BGxZ1CQGIYP/gg/J9jua2/wSEH4qq7bW91qooNELUlI=";
+    }) {};
   };
 }

nix/ios-deps.nix

@@ -18,8 +18,15 @@
 let
   pkgs = import sources.nixpkgs {};
 
+  unwitchOverride = self: super: {
+    unwitch = self.callCabal2nix "unwitch" (builtins.fetchTarball {
+      url = "https://github.com/jappeace/unwitch/archive/2759bdd153f293e0e6524d0170e861e51302caa4.tar.gz";
+      sha256 = "sha256:BGxZ1CQGIYP/gg/J9jua2/wSEH4qq7bW91qooNELUlI=";
+    }) {};
+  };
+
   nativeHaskellPkgs = pkgs.haskellPackages.override {
-    overrides = hpkgs;
+    overrides = pkgs.lib.composeExtensions unwitchOverride hpkgs;
   };
 
   ghc = nativeHaskellPkgs.ghc;
@@ -30,7 +37,11 @@ let
     haskellPkgs = nativeHaskellPkgs;
   };
 
+  # Hatter's own non-boot dependencies — always included so mkIOSLib's
+  # raw GHC invocation can find them even without a consumer cabal file.
+  hatterOwnDeps = [ nativeHaskellPkgs.unwitch ];
+
 in import ./collect-deps.nix {
   inherit pkgs ghc ghcPkgCmd;
-  deps = resolvedDeps;
+  deps = resolvedDeps ++ hatterOwnDeps;
 }

src/Hatter.hs

@@ -130,6 +130,7 @@ import Foreign.C.Types (CDouble(..), CInt(..))
 import Foreign.Ptr (Ptr, castPtr, nullPtr)
 import Data.ByteString qualified as BS
 import Data.Word (Word8)
+import Unwitch.Convert.CInt qualified as CInt
 import Hatter.Action
   ( Action(..)
   , OnChange(..)
@@ -316,7 +317,7 @@ haskellOnUIEvent :: Ptr AppContext -> CInt -> IO ()
 haskellOnUIEvent ctxPtr callbackId =
   withExceptionHandler ctxPtr $ do
     appCtx <- derefAppContext ctxPtr
-    dispatchEvent (acRenderState appCtx) (fromIntegral callbackId)
+    dispatchEvent (acRenderState appCtx) (CInt.toInt32 callbackId)
     renderView ctxPtr
 
 foreign export ccall haskellOnUIEvent :: Ptr AppContext -> CInt -> IO ()
@@ -332,7 +333,7 @@ haskellOnUITextChange ctxPtr callbackId cstr =
   withExceptionHandler ctxPtr $ do
     appCtx <- derefAppContext ctxPtr
     str <- peekCString cstr
-    dispatchTextEvent (acRenderState appCtx) (fromIntegral callbackId) (pack str)
+    dispatchTextEvent (acRenderState appCtx) (CInt.toInt32 callbackId) (pack str)
     renderView ctxPtr
 
 foreign export ccall haskellOnUITextChange :: Ptr AppContext -> CInt -> CString -> IO ()
@@ -452,7 +453,7 @@ haskellOnCameraResult ctxPtr requestId statusCode
     appCtx <- derefAppContext ctxPtr
     maybeImageData <- if imageDataPtr == nullPtr || imageDataLen <= 0
       then pure Nothing
-      else Just <$> BS.packCStringLen (castPtr imageDataPtr, fromIntegral imageDataLen)
+      else Just <$> BS.packCStringLen (castPtr imageDataPtr, CInt.toInt imageDataLen)
     dispatchCameraResult (acCameraState appCtx) requestId statusCode
       maybeImageData width height
 
@@ -467,7 +468,7 @@ haskellOnVideoFrame :: Ptr AppContext -> CInt
 haskellOnVideoFrame ctxPtr requestId frameDataPtr frameDataLen width height =
   withExceptionHandler ctxPtr $ do
     appCtx <- derefAppContext ctxPtr
-    frameBytes <- BS.packCStringLen (castPtr frameDataPtr, fromIntegral frameDataLen)
+    frameBytes <- BS.packCStringLen (castPtr frameDataPtr, CInt.toInt frameDataLen)
     dispatchVideoFrame (acCameraState appCtx) requestId frameBytes width height
 
 foreign export ccall haskellOnVideoFrame
@@ -480,7 +481,7 @@ haskellOnAudioChunk :: Ptr AppContext -> CInt
 haskellOnAudioChunk ctxPtr requestId audioDataPtr audioDataLen =
   withExceptionHandler ctxPtr $ do
     appCtx <- derefAppContext ctxPtr
-    audioBytes <- BS.packCStringLen (castPtr audioDataPtr, fromIntegral audioDataLen)
+    audioBytes <- BS.packCStringLen (castPtr audioDataPtr, CInt.toInt audioDataLen)
     dispatchAudioChunk (acCameraState appCtx) requestId audioBytes
 
 foreign export ccall haskellOnAudioChunk
@@ -508,7 +509,7 @@ haskellOnHttpResult ctxPtr requestId resultCode httpStatus
     maybeHeaders <- peekOptionalCString cHeaders
     responseBody <- if bodyPtr == nullPtr || bodyLen <= 0
       then pure BS.empty
-      else BS.packCStringLen (castPtr bodyPtr, fromIntegral bodyLen)
+      else BS.packCStringLen (castPtr bodyPtr, CInt.toInt bodyLen)
     dispatchHttpResult (acHttpState appCtx) requestId resultCode httpStatus
       maybeHeaders responseBody
 

src/Hatter/Action.hs

@@ -40,6 +40,7 @@ import Data.Int (Int32)
 import Data.IntMap.Strict (IntMap)
 import Data.IntMap.Strict qualified as IntMap
 import Data.Text (Text)
+import Unwitch.Convert.Int32 qualified as Int32
 
 -- | An opaque handle to a click / tap callback.
 -- Carries only an 'Int32' identifier, so it derives 'Eq' and 'Show'.
@@ -86,15 +87,15 @@ newtype ActionM a = ActionM (ActionState -> IO a)
 createAction :: IO () -> ActionM Action
 createAction callback = ActionM $ \state -> do
   handleId <- readIORef (asNextId state)
-  modifyIORef' (asCallbacks state) (IntMap.insert (fromIntegral handleId) callback)
+  modifyIORef' (asCallbacks state) (IntMap.insert (Int32.toInt handleId) callback)
   modifyIORef' (asNextId state) (+ 1)
   pure (Action handleId)
 
 -- | Register a text-change callback and return its opaque handle.
 createOnChange :: (Text -> IO ()) -> ActionM OnChange
 createOnChange callback = ActionM $ \state -> do
   handleId <- readIORef (asNextId state)
-  modifyIORef' (asTextCallbacks state) (IntMap.insert (fromIntegral handleId) callback)
+  modifyIORef' (asTextCallbacks state) (IntMap.insert (Int32.toInt handleId) callback)
   modifyIORef' (asNextId state) (+ 1)
   pure (OnChange handleId)
 
@@ -107,11 +108,11 @@ runActionM state (ActionM f) = f state
 lookupAction :: ActionState -> Int32 -> IO (Maybe (IO ()))
 lookupAction state handleId = do
   callbacks <- readIORef (asCallbacks state)
-  pure (IntMap.lookup (fromIntegral handleId) callbacks)
+  pure (IntMap.lookup (Int32.toInt handleId) callbacks)
 
 -- | Look up a text-change callback by handle ID.
 -- Returns 'Nothing' if the ID is not registered.
 lookupTextAction :: ActionState -> Int32 -> IO (Maybe (Text -> IO ()))
 lookupTextAction state handleId = do
   callbacks <- readIORef (asTextCallbacks state)
-  pure (IntMap.lookup (fromIntegral handleId) callbacks)
+  pure (IntMap.lookup (Int32.toInt handleId) callbacks)

src/Hatter/Animation.hs

@@ -31,6 +31,7 @@ import Data.List (sortBy)
 import Data.Ord (comparing)
 import Data.Time.Clock (NominalDiffTime)
 import Foreign.Ptr (Ptr)
+import Unwitch.Convert.Int32 qualified as Int32
 import Hatter.Widget
   ( Keyframe(..)
   , WidgetStyle(..)
@@ -86,7 +87,7 @@ registerTween animState nodeId keyframes duration = do
         , atNodeId     = nodeId
         , atDuration   = duration
         }
-  modifyIORef' (ansTweens animState) (IntMap.insert (fromIntegral nodeId) tween)
+  modifyIORef' (ansTweens animState) (IntMap.insert (Int32.toInt nodeId) tween)
   ensureLoopStarted animState
 
 -- | Start the platform animation loop if not already active.

src/Hatter/AuthSession.hs

@@ -36,6 +36,8 @@ import Foreign.C.String (CString, withCString)
 import Foreign.C.Types (CInt(..))
 import Foreign.Ptr (Ptr, nullPtr)
 import System.IO (hPutStrLn, stderr)
+import Unwitch.Convert.CInt qualified as CInt
+import Unwitch.Convert.Int32 qualified as Int32
 
 -- | Result of an authentication session.
 data AuthSessionResult
@@ -88,12 +90,12 @@ authSessionResultFromInt _ _                  _          = Nothing
 startAuthSession :: AuthSessionState -> Text -> Text -> (AuthSessionResult -> IO ()) -> IO ()
 startAuthSession authSessionState authUrl callbackScheme callback = do
   requestId <- readIORef (asNextId authSessionState)
-  modifyIORef' (asCallbacks authSessionState) (IntMap.insert (fromIntegral requestId) callback)
+  modifyIORef' (asCallbacks authSessionState) (IntMap.insert (Int32.toInt requestId) callback)
   writeIORef (asNextId authSessionState) (requestId + 1)
   ctx <- readIORef (asContextPtr authSessionState)
   withCString (Text.unpack authUrl) $ \cUrl ->
     withCString (Text.unpack callbackScheme) $ \cScheme ->
-      c_authSessionStart ctx (fromIntegral requestId) cUrl cScheme
+      c_authSessionStart ctx (Int32.toCInt requestId) cUrl cScheme
 
 -- | Dispatch an auth session result from the platform back to the
 -- registered Haskell callback. Removes the callback after firing.
@@ -104,7 +106,7 @@ dispatchAuthSessionResult authSessionState requestId statusCode maybeRedirectUrl
     Nothing -> hPutStrLn stderr $
       "dispatchAuthSessionResult: unknown status code " ++ show statusCode
     Just result -> do
-      let reqKey = fromIntegral requestId
+      let reqKey = CInt.toInt requestId
       callbacks <- readIORef (asCallbacks authSessionState)
       case IntMap.lookup reqKey callbacks of
         Just callback -> do

src/Hatter/Ble.hs

@@ -31,6 +31,7 @@ import Foreign.C.String (CString, peekCString)
 import Foreign.C.Types (CInt(..))
 import Foreign.Ptr (Ptr, nullPtr)
 import System.IO (hPutStrLn, stderr)
+import Unwitch.Convert.CInt qualified as CInt
 
 -- | Status of the platform's BLE adapter.
 data BleAdapterStatus
@@ -136,7 +137,7 @@ dispatchBleScanResult bleState cName cAddr cRssi = do
       let scanResult = BleScanResult
             { bsrDeviceName    = nameStr
             , bsrDeviceAddress = addrStr
-            , bsrRssi          = fromIntegral cRssi
+            , bsrRssi          = CInt.toInt cRssi
             }
       callback scanResult
 

src/Hatter/BottomSheet.hs

@@ -32,6 +32,8 @@ import Foreign.C.String (CString, withCString)
 import Foreign.C.Types (CInt(..))
 import Foreign.Ptr (Ptr, nullPtr)
 import System.IO (hPutStrLn, stderr)
+import Unwitch.Convert.CInt qualified as CInt
+import Unwitch.Convert.Int32 qualified as Int32
 
 -- | Result of a bottom sheet interaction.
 data BottomSheetAction
@@ -76,7 +78,7 @@ newBottomSheetState = do
 bottomSheetActionFromInt :: CInt -> Maybe BottomSheetAction
 bottomSheetActionFromInt (-1) = Just BottomSheetDismissed
 bottomSheetActionFromInt code
-  | code >= 0 = Just (BottomSheetItemSelected (fromIntegral code))
+  | code >= 0 = Just (BottomSheetItemSelected (CInt.toInt32 code))
   | otherwise = Nothing
 
 -- | Show a bottom sheet with the given configuration.  Registers
@@ -86,13 +88,13 @@ bottomSheetActionFromInt code
 showBottomSheet :: BottomSheetState -> BottomSheetConfig -> (BottomSheetAction -> IO ()) -> IO ()
 showBottomSheet bottomSheetState config callback = do
   requestId <- readIORef (bssNextId bottomSheetState)
-  modifyIORef' (bssCallbacks bottomSheetState) (IntMap.insert (fromIntegral requestId) callback)
+  modifyIORef' (bssCallbacks bottomSheetState) (IntMap.insert (Int32.toInt requestId) callback)
   writeIORef (bssNextId bottomSheetState) (requestId + 1)
   ctx <- readIORef (bssContextPtr bottomSheetState)
   let joinedItems = Text.unpack (Text.intercalate "\n" (bscItems config))
   withCString (Text.unpack (bscTitle config)) $ \cTitle ->
     withCString joinedItems $ \cItems ->
-      c_bottomSheetShow ctx (fromIntegral requestId) cTitle cItems
+      c_bottomSheetShow ctx (Int32.toCInt requestId) cTitle cItems
 
 -- | Dispatch a bottom sheet result from the platform back to the
 -- registered Haskell callback.  Removes the callback after firing.
@@ -103,7 +105,7 @@ dispatchBottomSheetResult bottomSheetState requestId actionCode =
     Nothing -> hPutStrLn stderr $
       "dispatchBottomSheetResult: unknown action code " ++ show actionCode
     Just action -> do
-      let reqKey = fromIntegral requestId
+      let reqKey = CInt.toInt requestId
       callbacks <- readIORef (bssCallbacks bottomSheetState)
       case IntMap.lookup reqKey callbacks of
         Just callback -> do

src/Hatter/Camera.hs

@@ -43,6 +43,8 @@ import Data.IntMap.Strict qualified as IntMap
 import Foreign.C.Types (CInt(..))
 import Foreign.Ptr (Ptr, nullPtr)
 import System.IO (hPutStrLn, stderr)
+import Unwitch.Convert.CInt qualified as CInt
+import Unwitch.Convert.Int32 qualified as Int32
 
 -- | Which camera to use.
 data CameraSource
@@ -130,7 +132,7 @@ cameraStatusFromInt _ = Nothing
 startCameraSession :: CameraState -> CameraSource -> IO ()
 startCameraSession cameraState source = do
   ctx <- readIORef (csContextPtr cameraState)
-  c_cameraStartSession ctx (fromIntegral (cameraSourceToInt source))
+  c_cameraStartSession ctx (Int32.toCInt (cameraSourceToInt source))
 
 -- | Stop the active camera session.
 -- Safe to call when no session is active (no-op).
@@ -144,10 +146,10 @@ stopCameraSession _cameraState =
 capturePhoto :: CameraState -> (CameraResult -> IO ()) -> IO ()
 capturePhoto cameraState callback = do
   requestId <- readIORef (csNextId cameraState)
-  modifyIORef' (csCallbacks cameraState) (IntMap.insert (fromIntegral requestId) callback)
+  modifyIORef' (csCallbacks cameraState) (IntMap.insert (Int32.toInt requestId) callback)
   writeIORef (csNextId cameraState) (requestId + 1)
   ctx <- readIORef (csContextPtr cameraState)
-  c_cameraCapturePhoto ctx (fromIntegral requestId)
+  c_cameraCapturePhoto ctx (Int32.toCInt requestId)
 
 -- | Start recording video.  Registers three callbacks:
 --
@@ -163,13 +165,13 @@ startVideoCapture :: CameraState
                   -> IO ()
 startVideoCapture cameraState frameCallback audioCallback completionCallback = do
   requestId <- readIORef (csNextId cameraState)
-  let reqKey = fromIntegral requestId
+  let reqKey = Int32.toInt requestId
   modifyIORef' (csCallbacks cameraState) (IntMap.insert reqKey completionCallback)
   modifyIORef' (csFrameCallbacks cameraState) (IntMap.insert reqKey frameCallback)
   modifyIORef' (csAudioCallbacks cameraState) (IntMap.insert reqKey audioCallback)
   writeIORef (csNextId cameraState) (requestId + 1)
   ctx <- readIORef (csContextPtr cameraState)
-  c_cameraStartVideo ctx (fromIntegral requestId)
+  c_cameraStartVideo ctx (Int32.toCInt requestId)
 
 -- | Stop recording video. The callback registered by 'startVideoCapture'
 -- will be fired with a completion result.
@@ -191,12 +193,12 @@ dispatchCameraResult cameraState requestId statusCode
     Nothing -> hPutStrLn stderr $
       "dispatchCameraResult: unknown status code " ++ show statusCode
     Just status -> do
-      let reqKey = fromIntegral requestId
+      let reqKey = CInt.toInt requestId
           maybePicture = case status of
             CameraSuccess -> case maybeImageData of
               Just imageBytes -> Just Picture
-                { pictureWidth  = fromIntegral imageWidth
-                , pictureHeight = fromIntegral imageHeight
+                { pictureWidth  = CInt.toInt imageWidth
+                , pictureHeight = CInt.toInt imageHeight
                 , pictureData   = imageBytes
                 }
               Nothing -> Nothing
@@ -220,10 +222,10 @@ dispatchCameraResult cameraState requestId statusCode
 -- recording stops.
 dispatchVideoFrame :: CameraState -> CInt -> ByteString -> CInt -> CInt -> IO ()
 dispatchVideoFrame cameraState requestId frameBytes frameWidth frameHeight = do
-  let reqKey = fromIntegral requestId
+  let reqKey = CInt.toInt requestId
       picture = Picture
-        { pictureWidth  = fromIntegral frameWidth
-        , pictureHeight = fromIntegral frameHeight
+        { pictureWidth  = CInt.toInt frameWidth
+        , pictureHeight = CInt.toInt frameHeight
         , pictureData   = frameBytes
         }
   frameCallbacks <- readIORef (csFrameCallbacks cameraState)
@@ -237,7 +239,7 @@ dispatchVideoFrame cameraState requestId frameBytes frameWidth frameHeight = do
 -- recording stops.
 dispatchAudioChunk :: CameraState -> CInt -> ByteString -> IO ()
 dispatchAudioChunk cameraState requestId audioBytes = do
-  let reqKey = fromIntegral requestId
+  let reqKey = CInt.toInt requestId
   audioCallbacks <- readIORef (csAudioCallbacks cameraState)
   case IntMap.lookup reqKey audioCallbacks of
     Just callback -> callback audioBytes