From ffbbffbb094650dc6f74c7f40f0d17b6ae2d10e3 Mon Sep 17 00:00:00 2001 From: jappeace-sloth Date: Sun, 19 Apr 2026 18:56:34 +0000 Subject: [PATCH 1/7] Replace all fromIntegral with unwitch type-safe conversions MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Eliminate every fromIntegral call (70+) across 20 files by using explicit unwitch conversion functions. This makes numeric type conversions self-documenting and catches unsafe casts at compile time. Conversion patterns used: - Int32 ↔ CInt: Int32.toCInt / CInt.toInt32 (total) - CInt → Int: CInt.toInt (total, for IntMap keys and BS lengths) - Int → CInt: Int.toCInt with maybe 0 id (partial) - Int → Word8: Int.toWord8 with maybe 0 id (partial, hex parsing) - Word8 → Int/Double: Word8.toInt / Word8.toDouble (total) - Int32 → Int (IntMap keys): CInt.toInt . Int32.toCInt (total chain, avoids Int32.toInt which returns Maybe due to Haskell spec) - Int32/CInt → Double: Int32.toDouble / CInt.toDouble (total) Added unwitch 2.2.0 to cabal deps (library, test-suite, redraw-demo) and to both nix overlays (hpkgs.nix for native, cross-deps.nix for Android cross-compilation). Prompt: replace all primitive conversions in hatter with unwitch Co-Authored-By: Claude Opus 4.6 --- hatter.cabal | 9 ++++++--- nix/cross-deps.nix | 8 ++++++++ nix/hpkgs.nix | 4 ++++ src/Hatter.hs | 13 +++++++------ src/Hatter/Action.hs | 16 ++++++++++++---- src/Hatter/Animation.hs | 10 +++++++++- src/Hatter/AuthSession.hs | 13 ++++++++++--- src/Hatter/Ble.hs | 3 ++- src/Hatter/BottomSheet.hs | 15 +++++++++++---- src/Hatter/Camera.hs | 31 +++++++++++++++++++------------ src/Hatter/Dialog.hs | 13 ++++++++++--- src/Hatter/Http.hs | 18 +++++++++++++----- src/Hatter/Permission.hs | 15 +++++++++++---- src/Hatter/PlatformSignIn.hs | 13 ++++++++++--- src/Hatter/Render.hs | 5 +++-- src/Hatter/SecureStorage.hs | 21 ++++++++++++++------- src/Hatter/UIBridge.hs | 21 ++++++++++++--------- src/Hatter/Widget.hs | 10 ++++++---- test/RedrawDemoMain.hs | 5 +++-- test/Test/AppContextTests.hs | 5 +++-- 20 files changed, 173 insertions(+), 75 deletions(-) diff --git a/hatter.cabal b/hatter.cabal index 4b812c8c..d5a3e87a 100644 --- a/hatter.cabal +++ b/hatter.cabal @@ -119,7 +119,8 @@ library containers < 1, bytestring < 1, transformers < 0.7, - time + time, + unwitch >= 2.2.0 && < 3 c-sources: cbits/android_stubs.c cbits/platform_log.c @@ -191,7 +192,8 @@ executable redraw-demo test build-depends: hatter, - text + text, + unwitch >= 2.2.0 && < 3 executable confetti-repro-demo import: common-options @@ -250,4 +252,5 @@ test-suite unit text, bytestring, directory, - filepath + filepath, + unwitch >= 2.2.0 && < 3 diff --git a/nix/cross-deps.nix b/nix/cross-deps.nix index 2621d4b6..13aa5e96 100644 --- a/nix/cross-deps.nix +++ b/nix/cross-deps.nix @@ -228,10 +228,18 @@ WRAPPER }); } else {}; + unwitchOverride = self: super: { + unwitch = self.callCabal2nix "unwitch" (builtins.fetchTarball { + url = "https://hackage.haskell.org/package/unwitch-2.2.0/unwitch-2.2.0.tar.gz"; + sha256 = "sha256:he/wdUN1XOcEo0VTmJVRrdQnGmZldxgCPCxlSDvzd9c="; + }) {}; + }; + defaultOverrides = let common = pkgs.lib.composeManyExtensions [ vectorOverride + unwitchOverride thPackageDbOverride thIservOverride hatterOverride diff --git a/nix/hpkgs.nix b/nix/hpkgs.nix index 7c056584..a9d5bf6c 100644 --- a/nix/hpkgs.nix +++ b/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://hackage.haskell.org/package/unwitch-2.2.0/unwitch-2.2.0.tar.gz"; + sha256 = "sha256:he/wdUN1XOcEo0VTmJVRrdQnGmZldxgCPCxlSDvzd9c="; + }) {}; }; } diff --git a/src/Hatter.hs b/src/Hatter.hs index 328c2abf..883f4dcd 100644 --- a/src/Hatter.hs +++ b/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 diff --git a/src/Hatter/Action.hs b/src/Hatter/Action.hs index 5080e4a4..7278f6af 100644 --- a/src/Hatter/Action.hs +++ b/src/Hatter/Action.hs @@ -40,6 +40,8 @@ import Data.Int (Int32) import Data.IntMap.Strict (IntMap) import Data.IntMap.Strict qualified as IntMap import Data.Text (Text) +import Unwitch.Convert.CInt qualified as CInt +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,7 +88,7 @@ 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 (int32ToIntKey handleId) callback) modifyIORef' (asNextId state) (+ 1) pure (Action handleId) @@ -94,7 +96,7 @@ createAction callback = ActionM $ \state -> do 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 (int32ToIntKey handleId) callback) modifyIORef' (asNextId state) (+ 1) pure (OnChange handleId) @@ -107,11 +109,17 @@ 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 (int32ToIntKey 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 (int32ToIntKey handleId) callbacks) + +-- | Convert Int32 to Int for use as IntMap key. +-- Total on all GHC-supported platforms (Int >= 32 bits). +-- Uses the total chain Int32 -> CInt -> Int. +int32ToIntKey :: Int32 -> Int +int32ToIntKey = CInt.toInt . Int32.toCInt diff --git a/src/Hatter/Animation.hs b/src/Hatter/Animation.hs index 029b7ff2..592ef0b0 100644 --- a/src/Hatter/Animation.hs +++ b/src/Hatter/Animation.hs @@ -31,6 +31,8 @@ import Data.List (sortBy) import Data.Ord (comparing) import Data.Time.Clock (NominalDiffTime) import Foreign.Ptr (Ptr) +import Unwitch.Convert.CInt qualified as CInt +import Unwitch.Convert.Int32 qualified as Int32 import Hatter.Widget ( Keyframe(..) , WidgetStyle(..) @@ -86,7 +88,7 @@ registerTween animState nodeId keyframes duration = do , atNodeId = nodeId , atDuration = duration } - modifyIORef' (ansTweens animState) (IntMap.insert (fromIntegral nodeId) tween) + modifyIORef' (ansTweens animState) (IntMap.insert (int32ToIntKey nodeId) tween) ensureLoopStarted animState -- | Start the platform animation loop if not already active. @@ -255,6 +257,12 @@ interpolateStyle nodeId fromStyle toStyle progress = do (Just _fromEnabled, Nothing) -> pure () (Nothing, Nothing) -> pure () +-- | Convert Int32 to Int for use as IntMap key. +-- Total on all GHC-supported platforms (Int >= 32 bits). +-- Uses the total chain Int32 -> CInt -> Int. +int32ToIntKey :: Int32 -> Int +int32ToIntKey = CInt.toInt . Int32.toCInt + -- | FFI imports for the C animation bridge. foreign import ccall "animation_start_loop" c_animationStartLoop :: Ptr () -> IO () foreign import ccall "animation_stop_loop" c_animationStopLoop :: IO () diff --git a/src/Hatter/AuthSession.hs b/src/Hatter/AuthSession.hs index b91511f2..c6f0e853 100644 --- a/src/Hatter/AuthSession.hs +++ b/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 (int32ToIntKey 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 @@ -113,6 +115,11 @@ dispatchAuthSessionResult authSessionState requestId statusCode maybeRedirectUrl Nothing -> hPutStrLn stderr $ "dispatchAuthSessionResult: unknown request ID " ++ show requestId +-- | Convert Int32 to Int for use as IntMap key. +-- Total on all GHC-supported platforms (Int >= 32 bits). +int32ToIntKey :: Int32 -> Int +int32ToIntKey = CInt.toInt . Int32.toCInt + -- | FFI import: start an auth session via the C bridge. foreign import ccall "auth_session_start" c_authSessionStart :: Ptr () -> CInt -> CString -> CString -> IO () diff --git a/src/Hatter/Ble.hs b/src/Hatter/Ble.hs index 492dd7dc..9ade5254 100644 --- a/src/Hatter/Ble.hs +++ b/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 diff --git a/src/Hatter/BottomSheet.hs b/src/Hatter/BottomSheet.hs index 0bec8e5c..9830f107 100644 --- a/src/Hatter/BottomSheet.hs +++ b/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 (int32ToIntKey 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 @@ -112,6 +114,11 @@ dispatchBottomSheetResult bottomSheetState requestId actionCode = Nothing -> hPutStrLn stderr $ "dispatchBottomSheetResult: unknown request ID " ++ show requestId +-- | Convert Int32 to Int for use as IntMap key. +-- Total on all GHC-supported platforms (Int >= 32 bits). +int32ToIntKey :: Int32 -> Int +int32ToIntKey = CInt.toInt . Int32.toCInt + -- | FFI import: show a bottom sheet via the C bridge. foreign import ccall "bottom_sheet_show" c_bottomSheetShow :: Ptr () -> CInt -> CString -> CString -> IO () diff --git a/src/Hatter/Camera.hs b/src/Hatter/Camera.hs index ee999015..b7555b0c 100644 --- a/src/Hatter/Camera.hs +++ b/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 (int32ToIntKey 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 = int32ToIntKey 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,13 +239,18 @@ 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 Nothing -> hPutStrLn stderr $ "dispatchAudioChunk: unknown request ID " ++ show requestId +-- | Convert Int32 to Int for use as IntMap key. +-- Total on all GHC-supported platforms (Int >= 32 bits). +int32ToIntKey :: Int32 -> Int +int32ToIntKey = CInt.toInt . Int32.toCInt + -- | FFI import: start a camera session via the C bridge. foreign import ccall "camera_start_session" c_cameraStartSession :: Ptr () -> CInt -> IO () diff --git a/src/Hatter/Dialog.hs b/src/Hatter/Dialog.hs index be80d5e8..8fc16803 100644 --- a/src/Hatter/Dialog.hs +++ b/src/Hatter/Dialog.hs @@ -31,6 +31,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 -- | Which button was tapped, or whether the dialog was dismissed. data DialogAction @@ -91,7 +93,7 @@ dialogActionFromInt _ = Nothing showDialog :: DialogState -> DialogConfig -> (DialogAction -> IO ()) -> IO () showDialog dialogState config callback = do requestId <- readIORef (dsNextId dialogState) - modifyIORef' (dsCallbacks dialogState) (IntMap.insert (fromIntegral requestId) callback) + modifyIORef' (dsCallbacks dialogState) (IntMap.insert (int32ToIntKey requestId) callback) writeIORef (dsNextId dialogState) (requestId + 1) ctx <- readIORef (dsContextPtr dialogState) withCString (Text.unpack (dcTitle config)) $ \cTitle -> @@ -99,7 +101,7 @@ showDialog dialogState config callback = do withCString (Text.unpack (dcButton1 config)) $ \cButton1 -> withOptionalCString (dcButton2 config) $ \cButton2 -> withOptionalCString (dcButton3 config) $ \cButton3 -> - c_dialogShow ctx (fromIntegral requestId) cTitle cMessage cButton1 cButton2 cButton3 + c_dialogShow ctx (Int32.toCInt requestId) cTitle cMessage cButton1 cButton2 cButton3 -- | Dispatch a dialog result from the platform back to the -- registered Haskell callback. Removes the callback after firing. @@ -110,7 +112,7 @@ dispatchDialogResult dialogState requestId actionCode = Nothing -> hPutStrLn stderr $ "dispatchDialogResult: unknown action code " ++ show actionCode Just action -> do - let reqKey = fromIntegral requestId + let reqKey = CInt.toInt requestId callbacks <- readIORef (dsCallbacks dialogState) case IntMap.lookup reqKey callbacks of Just callback -> do @@ -124,6 +126,11 @@ withOptionalCString :: Maybe Text -> (CString -> IO a) -> IO a withOptionalCString Nothing action = action nullPtr withOptionalCString (Just t) action = withCString (Text.unpack t) action +-- | Convert Int32 to Int for use as IntMap key. +-- Total on all GHC-supported platforms (Int >= 32 bits). +int32ToIntKey :: Int32 -> Int +int32ToIntKey = CInt.toInt . Int32.toCInt + -- | FFI import: show a dialog via the C bridge. foreign import ccall "dialog_show" c_dialogShow :: Ptr () -> CInt -> CString -> CString -> CString -> CString -> CString -> IO () diff --git a/src/Hatter/Http.hs b/src/Hatter/Http.hs index b8c70543..b592b867 100644 --- a/src/Hatter/Http.hs +++ b/src/Hatter/Http.hs @@ -43,6 +43,9 @@ 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.Int qualified as Int +import Unwitch.Convert.Int32 qualified as Int32 -- | HTTP request method. data HttpMethod @@ -128,7 +131,7 @@ parseHeaders headerText = performRequest :: HttpState -> HttpRequest -> (Either HttpError HttpResponse -> IO ()) -> IO () performRequest httpState request callback = do requestId <- readIORef (hsNextId httpState) - modifyIORef' (hsCallbacks httpState) (IntMap.insert (fromIntegral requestId) callback) + modifyIORef' (hsCallbacks httpState) (IntMap.insert (int32ToIntKey requestId) callback) writeIORef (hsNextId httpState) (requestId + 1) ctx <- readIORef (hsContextPtr httpState) let methodInt = httpMethodToInt (hrMethod request) @@ -136,22 +139,22 @@ performRequest httpState request callback = do withCString (Text.unpack (hrUrl request)) $ \cUrl -> withCString headerStr $ \cHeaders -> BS.useAsCStringLen (hrBody request) $ \(cBody, bodyLen) -> - c_httpRequest ctx (fromIntegral requestId) methodInt - cUrl cHeaders cBody (fromIntegral bodyLen) + c_httpRequest ctx (Int32.toCInt requestId) methodInt + cUrl cHeaders cBody (maybe 0 id (Int.toCInt bodyLen)) -- | Dispatch an HTTP result from the platform back to the registered -- Haskell callback. Removes the callback after firing. -- Unknown request IDs or result codes are silently logged to stderr. dispatchHttpResult :: HttpState -> CInt -> CInt -> CInt -> Maybe Text -> ByteString -> IO () dispatchHttpResult httpState requestId resultCode httpStatus maybeHeaders responseBody = do - let reqKey = fromIntegral requestId + let reqKey = CInt.toInt requestId callbacks <- readIORef (hsCallbacks httpState) case IntMap.lookup reqKey callbacks of Just callback -> do modifyIORef' (hsCallbacks httpState) (IntMap.delete reqKey) let result = case resultCode of 0 -> Right HttpResponse - { hrStatusCode = fromIntegral httpStatus + { hrStatusCode = CInt.toInt httpStatus , hrRespHeaders = maybe [] parseHeaders maybeHeaders , hrRespBody = responseBody } @@ -162,6 +165,11 @@ dispatchHttpResult httpState requestId resultCode httpStatus maybeHeaders respon Nothing -> hPutStrLn stderr $ "dispatchHttpResult: unknown request ID " ++ show requestId +-- | Convert Int32 to Int for use as IntMap key. +-- Total on all GHC-supported platforms (Int >= 32 bits). +int32ToIntKey :: Int32 -> Int +int32ToIntKey = CInt.toInt . Int32.toCInt + -- | FFI import: send an HTTP request via the C bridge. foreign import ccall "http_request" c_httpRequest :: Ptr () -> CInt -> CInt -> CString -> CString diff --git a/src/Hatter/Permission.hs b/src/Hatter/Permission.hs index 73d49aca..e6112493 100644 --- a/src/Hatter/Permission.hs +++ b/src/Hatter/Permission.hs @@ -29,6 +29,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 -- | Dangerous permissions that require runtime consent on mobile. data Permission @@ -98,10 +100,10 @@ permissionStatusFromInt _ = Nothing requestPermission :: PermissionState -> Permission -> (PermissionStatus -> IO ()) -> IO () requestPermission permissionState permission callback = do requestId <- readIORef (psNextId permissionState) - modifyIORef' (psCallbacks permissionState) (IntMap.insert (fromIntegral requestId) callback) + modifyIORef' (psCallbacks permissionState) (IntMap.insert (int32ToIntKey requestId) callback) writeIORef (psNextId permissionState) (requestId + 1) ctx <- readIORef (psContextPtr permissionState) - c_permissionRequest ctx (permissionToInt permission) (fromIntegral requestId) + c_permissionRequest ctx (permissionToInt permission) (Int32.toCInt requestId) -- | Check whether a permission is currently granted (synchronous). checkPermission :: Permission -> IO PermissionStatus @@ -123,13 +125,18 @@ dispatchPermissionResult permissionState requestId statusCode = "dispatchPermissionResult: unknown status code " ++ show statusCode Just status -> do callbacks <- readIORef (psCallbacks permissionState) - case IntMap.lookup (fromIntegral requestId) callbacks of + case IntMap.lookup (CInt.toInt requestId) callbacks of Nothing -> hPutStrLn stderr $ "dispatchPermissionResult: unknown request ID " ++ show requestId Just callback -> do - modifyIORef' (psCallbacks permissionState) (IntMap.delete (fromIntegral requestId)) + modifyIORef' (psCallbacks permissionState) (IntMap.delete (CInt.toInt requestId)) callback status +-- | Convert Int32 to Int for use as IntMap key. +-- Total on all GHC-supported platforms (Int >= 32 bits). +int32ToIntKey :: Int32 -> Int +int32ToIntKey = CInt.toInt . Int32.toCInt + -- | FFI import: request a permission via the C bridge. -- Takes an opaque context pointer, permission code, and request ID. foreign import ccall "permission_request" diff --git a/src/Hatter/PlatformSignIn.hs b/src/Hatter/PlatformSignIn.hs index a878ea1b..ef23a2f1 100644 --- a/src/Hatter/PlatformSignIn.hs +++ b/src/Hatter/PlatformSignIn.hs @@ -35,6 +35,8 @@ import Data.Text (Text) 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 -- | Identity provider for platform sign-in. data SignInProvider @@ -126,10 +128,10 @@ signInResultFromInt _ _ _ _ _ _ = Nothing startPlatformSignIn :: PlatformSignInState -> SignInProvider -> (SignInResult -> IO ()) -> IO () startPlatformSignIn signInState provider callback = do requestId <- readIORef (psiNextId signInState) - modifyIORef' (psiCallbacks signInState) (IntMap.insert (fromIntegral requestId) callback) + modifyIORef' (psiCallbacks signInState) (IntMap.insert (int32ToIntKey requestId) callback) writeIORef (psiNextId signInState) (requestId + 1) ctx <- readIORef (psiContextPtr signInState) - c_platformSignInStart ctx (fromIntegral requestId) (providerToInt provider) + c_platformSignInStart ctx (Int32.toCInt requestId) (providerToInt provider) -- | Dispatch a platform sign-in result from the platform back to the -- registered Haskell callback. Removes the callback after firing. @@ -140,7 +142,7 @@ dispatchPlatformSignInResult signInState requestId statusCode maybeToken maybeUs Nothing -> hPutStrLn stderr $ "dispatchPlatformSignInResult: unknown status code " ++ show statusCode Just result -> do - let reqKey = fromIntegral requestId + let reqKey = CInt.toInt requestId callbacks <- readIORef (psiCallbacks signInState) case IntMap.lookup reqKey callbacks of Just callback -> do @@ -149,6 +151,11 @@ dispatchPlatformSignInResult signInState requestId statusCode maybeToken maybeUs Nothing -> hPutStrLn stderr $ "dispatchPlatformSignInResult: unknown request ID " ++ show requestId +-- | Convert Int32 to Int for use as IntMap key. +-- Total on all GHC-supported platforms (Int >= 32 bits). +int32ToIntKey :: Int32 -> Int +int32ToIntKey = CInt.toInt . Int32.toCInt + -- | FFI import: start a platform sign-in via the C bridge. foreign import ccall "platform_sign_in_start" c_platformSignInStart :: Ptr () -> CInt -> CInt -> IO () diff --git a/src/Hatter/Render.hs b/src/Hatter/Render.hs index 80a2e89a..e2772411 100644 --- a/src/Hatter/Render.hs +++ b/src/Hatter/Render.hs @@ -31,6 +31,7 @@ import Data.Text (Text, pack) import Hatter.Action (Action(..), ActionState, OnChange(..), lookupAction, lookupTextAction) import Data.List (sortBy) import Data.Ord (comparing) +import Unwitch.Convert.Int32 qualified as Int32 import Hatter.Animation (AnimationState, registerTween) import Hatter.Widget (AnimatedConfig(..), ButtonConfig(..), FontConfig(..), ImageConfig(..), ImageSource(..), InputType(..), Keyframe(..), LayoutItem(..), LayoutSettings(..), MapViewConfig(..), ResourceName(..), ScaleType(..), TextAlignment(..), TextConfig(..), TextInputConfig(..), WebViewConfig(..), Widget(..), WidgetStyle(..), colorToHex, normalizeAnimated, resolveKeyAtIndex) @@ -192,7 +193,7 @@ createRenderedNode _animState widget@(TextInput config) = do nodeId <- Bridge.createNode Bridge.NodeTextInput Bridge.setStrProp nodeId Bridge.PropText (tiValue config) Bridge.setStrProp nodeId Bridge.PropHint (tiHint config) - Bridge.setNumProp nodeId Bridge.PropInputType (fromIntegral (inputTypeToInt (tiInputType config))) + Bridge.setNumProp nodeId Bridge.PropInputType (Int32.toDouble (inputTypeToInt (tiInputType config))) Bridge.setHandler nodeId Bridge.EventTextChange (onChangeId (tiOnChange config)) applyFontConfig nodeId (tiFontConfig config) when (tiAutoFocus config) $ @@ -437,7 +438,7 @@ diffRenderNode _animState (Just (RenderedLeaf (TextInput oldConfig) nodeId)) new else pure () if tiInputType oldConfig /= tiInputType newConfig then Bridge.setNumProp nodeId Bridge.PropInputType - (fromIntegral (inputTypeToInt (tiInputType newConfig))) + (Int32.toDouble (inputTypeToInt (tiInputType newConfig))) else pure () if onChangeId (tiOnChange oldConfig) /= onChangeId (tiOnChange newConfig) then Bridge.setHandler nodeId Bridge.EventTextChange diff --git a/src/Hatter/SecureStorage.hs b/src/Hatter/SecureStorage.hs index 2ddf8da7..4998ba68 100644 --- a/src/Hatter/SecureStorage.hs +++ b/src/Hatter/SecureStorage.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 secure storage operation. data SecureStorageStatus @@ -89,12 +91,12 @@ storageStatusFromInt _ = Nothing secureStorageWrite :: SecureStorageState -> Text -> Text -> (SecureStorageStatus -> IO ()) -> IO () secureStorageWrite storageState key value callback = do requestId <- readIORef (ssNextId storageState) - modifyIORef' (ssWriteCallbacks storageState) (IntMap.insert (fromIntegral requestId) callback) + modifyIORef' (ssWriteCallbacks storageState) (IntMap.insert (int32ToIntKey requestId) callback) writeIORef (ssNextId storageState) (requestId + 1) ctx <- readIORef (ssContextPtr storageState) withCString (Text.unpack key) $ \cKey -> withCString (Text.unpack value) $ \cValue -> - c_secureStorageWrite ctx (fromIntegral requestId) cKey cValue + c_secureStorageWrite ctx (Int32.toCInt requestId) cKey cValue -- | Read a value from secure storage by key. Registers @callback@ and -- calls the C bridge. The callback receives the status and an optional @@ -102,22 +104,22 @@ secureStorageWrite storageState key value callback = do secureStorageRead :: SecureStorageState -> Text -> (SecureStorageStatus -> Maybe Text -> IO ()) -> IO () secureStorageRead storageState key callback = do requestId <- readIORef (ssNextId storageState) - modifyIORef' (ssReadCallbacks storageState) (IntMap.insert (fromIntegral requestId) callback) + modifyIORef' (ssReadCallbacks storageState) (IntMap.insert (int32ToIntKey requestId) callback) writeIORef (ssNextId storageState) (requestId + 1) ctx <- readIORef (ssContextPtr storageState) withCString (Text.unpack key) $ \cKey -> - c_secureStorageRead ctx (fromIntegral requestId) cKey + c_secureStorageRead ctx (Int32.toCInt requestId) cKey -- | Delete a key from secure storage. Registers @callback@ and calls -- the C bridge. The callback fires when the platform responds. secureStorageDelete :: SecureStorageState -> Text -> (SecureStorageStatus -> IO ()) -> IO () secureStorageDelete storageState key callback = do requestId <- readIORef (ssNextId storageState) - modifyIORef' (ssDeleteCallbacks storageState) (IntMap.insert (fromIntegral requestId) callback) + modifyIORef' (ssDeleteCallbacks storageState) (IntMap.insert (int32ToIntKey requestId) callback) writeIORef (ssNextId storageState) (requestId + 1) ctx <- readIORef (ssContextPtr storageState) withCString (Text.unpack key) $ \cKey -> - c_secureStorageDelete ctx (fromIntegral requestId) cKey + c_secureStorageDelete ctx (Int32.toCInt requestId) cKey -- | Dispatch a secure storage result from the platform back to the -- registered Haskell callback. Tries write callbacks first, then read, @@ -129,7 +131,7 @@ dispatchSecureStorageResult storageState requestId statusCode maybeValue = Nothing -> hPutStrLn stderr $ "dispatchSecureStorageResult: unknown status code " ++ show statusCode Just status -> do - let reqKey = fromIntegral requestId + let reqKey = CInt.toInt requestId -- Try write callbacks writeCallbacks <- readIORef (ssWriteCallbacks storageState) case IntMap.lookup reqKey writeCallbacks of @@ -156,6 +158,11 @@ dispatchSecureStorageResult storageState requestId statusCode maybeValue = Nothing -> hPutStrLn stderr $ "dispatchSecureStorageResult: unknown request ID " ++ show requestId +-- | Convert Int32 to Int for use as IntMap key. +-- Total on all GHC-supported platforms (Int >= 32 bits). +int32ToIntKey :: Int32 -> Int +int32ToIntKey = CInt.toInt . Int32.toCInt + -- | FFI import: write a key-value pair via the C bridge. foreign import ccall "secure_storage_write" c_secureStorageWrite :: Ptr () -> CInt -> CString -> CString -> IO () diff --git a/src/Hatter/UIBridge.hs b/src/Hatter/UIBridge.hs index 04865d32..9ee6045f 100644 --- a/src/Hatter/UIBridge.hs +++ b/src/Hatter/UIBridge.hs @@ -31,6 +31,9 @@ import Data.Word (Word8) import Foreign.C.String (CString, withCString) import Foreign.C.Types (CInt(..), CDouble(..)) import Foreign.Ptr (Ptr, castPtr) +import Unwitch.Convert.Int qualified as Int +import Unwitch.Convert.Int32 qualified as Int32 +import Unwitch.Convert.CInt qualified as CInt -- | Widget node types corresponding to @UI_NODE_*@ in @UIBridge.h@. data NodeType @@ -133,50 +136,50 @@ foreign import ccall "ui_clear" c_clear :: IO () -- | Create a native node of the given type. Returns an opaque node ID. createNode :: NodeType -> IO Int32 -createNode nt = fromIntegral <$> c_createNode (fromIntegral (nodeTypeToInt nt)) +createNode nt = CInt.toInt32 <$> c_createNode (Int32.toCInt (nodeTypeToInt nt)) -- | Set a string property on a node. setStrProp :: Int32 -> PropId -> Text -> IO () setStrProp nodeId propId value = withCString (unpack value) $ \cstr -> - c_setStrProp (fromIntegral nodeId) (fromIntegral (propIdToInt propId)) cstr + c_setStrProp (Int32.toCInt nodeId) (Int32.toCInt (propIdToInt propId)) cstr -- | Set a numeric property on a node. setNumProp :: Int32 -> PropId -> Double -> IO () setNumProp nodeId propId value = - c_setNumProp (fromIntegral nodeId) (fromIntegral (propIdToInt propId)) (realToFrac value) + c_setNumProp (Int32.toCInt nodeId) (Int32.toCInt (propIdToInt propId)) (realToFrac value) -- | Set raw image data (PNG/JPEG bytes) on a node. setImageData :: Int32 -> ByteString -> IO () setImageData nodeId imageBytes = BS.useAsCStringLen imageBytes $ \(ptr, len) -> - c_setImageData (fromIntegral nodeId) (castPtr ptr) (fromIntegral len) + c_setImageData (Int32.toCInt nodeId) (castPtr ptr) (maybe 0 id (Int.toCInt len)) -- | Register an event handler on a node. The @callbackId@ is looked up -- in the 'RenderState' callback registry when the event fires. setHandler :: Int32 -> EventType -> Int32 -> IO () setHandler nodeId eventType callbackId = - c_setHandler (fromIntegral nodeId) (fromIntegral (eventTypeToInt eventType)) (fromIntegral callbackId) + c_setHandler (Int32.toCInt nodeId) (Int32.toCInt (eventTypeToInt eventType)) (Int32.toCInt callbackId) -- | Add a child node to a parent container. addChild :: Int32 -> Int32 -> IO () addChild parentId childId = - c_addChild (fromIntegral parentId) (fromIntegral childId) + c_addChild (Int32.toCInt parentId) (Int32.toCInt childId) -- | Remove a child node from a parent container. removeChild :: Int32 -> Int32 -> IO () removeChild parentId childId = - c_removeChild (fromIntegral parentId) (fromIntegral childId) + c_removeChild (Int32.toCInt parentId) (Int32.toCInt childId) -- | Destroy a node and free its native resources. destroyNode :: Int32 -> IO () destroyNode nodeId = - c_destroyNode (fromIntegral nodeId) + c_destroyNode (Int32.toCInt nodeId) -- | Set a node as the root of the display. setRoot :: Int32 -> IO () setRoot nodeId = - c_setRoot (fromIntegral nodeId) + c_setRoot (Int32.toCInt nodeId) -- | Clear all nodes (called before re-render). clear :: IO () diff --git a/src/Hatter/Widget.hs b/src/Hatter/Widget.hs index 63d2ffff..bef08704 100644 --- a/src/Hatter/Widget.hs +++ b/src/Hatter/Widget.hs @@ -73,6 +73,8 @@ import Data.Text qualified as Text import Data.Time.Clock (NominalDiffTime) import Data.Word (Word8) import Hatter.Action (Action, OnChange) +import Unwitch.Convert.Int qualified as Int +import Unwitch.Convert.Word8 qualified as Word8 -- | Font configuration for text-bearing widgets. -- Only 'Text', 'Button', and 'TextInput' can carry a 'FontConfig'. @@ -149,7 +151,7 @@ colorFromText raw = do if all isHexDigit hex then case hex of [r1, g1, b1] -> - let expand ch = let val = digitToInt ch in fromIntegral (val * 16 + val) + let expand ch = let val = digitToInt ch in maybe 0 id (Int.toWord8 (val * 16 + val)) in Just (Color (expand r1) (expand g1) (expand b1) 255) [r1, r2, g1, g2, b1, b2] -> Just (Color (hexByte r1 r2) (hexByte g1 g2) (hexByte b1 b2) 255) @@ -160,14 +162,14 @@ colorFromText raw = do -- | Convert two hex characters to a Word8. hexByte :: Char -> Char -> Word8 -hexByte high low = fromIntegral (digitToInt high * 16 + digitToInt low) +hexByte high low = maybe 0 id (Int.toWord8 (digitToInt high * 16 + digitToInt low)) -- | Convert a 'Color' to a hex string in @"#AARRGGBB"@ format for the C bridge. colorToHex :: Color -> Text colorToHex (Color r g b a) = Text.pack ('#' : toHexByte a ++ toHexByte r ++ toHexByte g ++ toHexByte b) where toHexByte :: Word8 -> String - toHexByte byte = [intToDigit (fromIntegral byte `div` 16), intToDigit (fromIntegral byte `mod` 16)] + toHexByte byte = [intToDigit (Word8.toInt byte `div` 16), intToDigit (Word8.toInt byte `mod` 16)] -- | Visual style overrides for a widget node. -- Font size is not here — it belongs in the config records of @@ -367,7 +369,7 @@ andThen first second = AnimatedConfig -- | Linearly interpolate a single 'Word8' channel. lerpWord8 :: Word8 -> Word8 -> Double -> Word8 lerpWord8 from to progress = - round (fromIntegral from + (fromIntegral to - fromIntegral from) * progress :: Double) + round (Word8.toDouble from + (Word8.toDouble to - Word8.toDouble from) * progress :: Double) -- | Interpolate between two colors by lerping each RGBA channel. interpolateColor :: Color -> Color -> Double -> Color diff --git a/test/RedrawDemoMain.hs b/test/RedrawDemoMain.hs index b87c46e8..9f0f2526 100644 --- a/test/RedrawDemoMain.hs +++ b/test/RedrawDemoMain.hs @@ -15,6 +15,7 @@ import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Text (pack) import Foreign.C.Types (CInt(..)) import Foreign.Ptr (Ptr) +import Unwitch.Convert.CInt qualified as CInt import Hatter ( MobileApp(..) , UserState(..) @@ -59,8 +60,8 @@ redrawView startedRef _userState = do -- Start C-level timer: 3 ticks, 3 seconds apart. -- The context was stored by redraw_store_ctx() in renderView. c_startPeriodicRedraw 3 3 - count <- fromIntegral <$> c_getPeriodicCounter - platformLog ("view rebuilt: count=" <> pack (show (count :: Int))) + count <- CInt.toInt <$> c_getPeriodicCounter + platformLog ("view rebuilt: count=" <> pack (show count)) pure $ column [Text TextConfig { tcLabel = "Count: " <> pack (show count) , tcFontConfig = Nothing diff --git a/test/Test/AppContextTests.hs b/test/Test/AppContextTests.hs index 012601d7..9e39840b 100644 --- a/test/Test/AppContextTests.hs +++ b/test/Test/AppContextTests.hs @@ -24,6 +24,7 @@ import Hatter , haskellOnLifecycle ) import Hatter.AppContext (AppContext(..), newAppContext, freeAppContext, derefAppContext) +import Unwitch.Convert.Int32 qualified as Int32 import Hatter.Lifecycle ( LifecycleEvent(..) , MobileContext(..) @@ -203,7 +204,7 @@ exceptionHandlerTests = testGroup "ExceptionHandler" -- First render to register the button callback haskellRenderUI ctxPtr -- Dispatch the button, which throws — handler overwrites view - haskellOnUIEvent ctxPtr (fromIntegral (actionId crashHandle)) + haskellOnUIEvent ctxPtr (Int32.toCInt (actionId crashHandle)) isError <- viewIsErrorWidget ctxPtr assertBool "view should be error widget after button callback exception" isError freeAppContext ctxPtr @@ -232,7 +233,7 @@ exceptionHandlerTests = testGroup "ExceptionHandler" -- Dispatch the dismiss action (pre-registered during newAppContext). appCtx <- derefAppContext ctxPtr let dismissId = actionId (acDismissAction appCtx) - haskellOnUIEvent ctxPtr (fromIntegral dismissId) + haskellOnUIEvent ctxPtr (Int32.toCInt dismissId) isStillError <- viewIsErrorWidget ctxPtr assertBool "should no longer show error widget after dismiss" (not isStillError) freeAppContext ctxPtr From d1298bc1d645439abe65c46129e94f33f75a3534 Mon Sep 17 00:00:00 2001 From: jappeace-sloth Date: Sun, 19 Apr 2026 19:02:27 +0000 Subject: [PATCH 2/7] Add unwitch override to ios-deps.nix for iOS/watchOS builds iOS and watchOS use ios-deps.nix (native macOS GHC) rather than cross-deps.nix (Android cross-GHC). The unwitch package was missing from the iOS/watchOS haskellPackages overlay, causing "Could not find module Unwitch.Convert.*" errors in CI. Co-Authored-By: Claude Opus 4.6 --- nix/ios-deps.nix | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/nix/ios-deps.nix b/nix/ios-deps.nix index 48fc56ef..68793672 100644 --- a/nix/ios-deps.nix +++ b/nix/ios-deps.nix @@ -18,8 +18,15 @@ let pkgs = import sources.nixpkgs {}; + unwitchOverride = self: super: { + unwitch = self.callCabal2nix "unwitch" (builtins.fetchTarball { + url = "https://hackage.haskell.org/package/unwitch-2.2.0/unwitch-2.2.0.tar.gz"; + sha256 = "sha256:he/wdUN1XOcEo0VTmJVRrdQnGmZldxgCPCxlSDvzd9c="; + }) {}; + }; + nativeHaskellPkgs = pkgs.haskellPackages.override { - overrides = hpkgs; + overrides = pkgs.lib.composeExtensions unwitchOverride hpkgs; }; ghc = nativeHaskellPkgs.ghc; From bbb9c4326ce82e3e5b472869293228a57f829d58 Mon Sep 17 00:00:00 2001 From: jappeace-sloth Date: Sun, 19 Apr 2026 19:07:32 +0000 Subject: [PATCH 3/7] Include hatter's own non-boot deps in ios-deps.nix mkIOSLib compiles hatter with raw ghc -staticlib, not through cabal, so its non-boot dependencies must be explicitly provided in the crossDeps package DB. Before unwitch, hatter only used GHC boot packages (base, containers, text, etc.). Now it also needs unwitch. Add hatterOwnDeps list to ios-deps.nix so the unwitch .a/.hi/.conf are collected even when no consumerCabalFile is provided (as in CI). This fixes iOS and watchOS builds which both use ios-deps.nix. Co-Authored-By: Claude Opus 4.6 --- nix/ios-deps.nix | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/nix/ios-deps.nix b/nix/ios-deps.nix index 68793672..d167f837 100644 --- a/nix/ios-deps.nix +++ b/nix/ios-deps.nix @@ -37,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; } From 43b63c6f1f3112db743429f113d9036468a5779b Mon Sep 17 00:00:00 2001 From: jappeace-sloth Date: Sun, 19 Apr 2026 19:25:28 +0000 Subject: [PATCH 4/7] Collect unwitch in cross-deps.nix for Android builds MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit collect-deps.nix only processes packages explicitly in its deps list — it doesn't follow propagatedBuildInputs. Since hatter's .conf now references unwitch, unwitch's .a and .conf must also be collected. Without this, Android builds fail with "unusable due to missing dependencies: unwitch-2.2.0-..." when importing Hatter. Co-Authored-By: Claude Opus 4.6 --- nix/cross-deps.nix | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/nix/cross-deps.nix b/nix/cross-deps.nix index 13aa5e96..48dad8b2 100644 --- a/nix/cross-deps.nix +++ b/nix/cross-deps.nix @@ -292,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; } From fd918ec4692d1a47ffa7c2a4f7c62895c22e1833 Mon Sep 17 00:00:00 2001 From: jappeace-sloth Date: Mon, 20 Apr 2026 17:44:11 +0000 Subject: [PATCH 5/7] Replace placeholder 0.3.0 changelog with detailed release notes Categorise all changes since 0.2.0 into Breaking changes, Added, and Fixed sections based on the git history (c17518a..HEAD). Prompt: go repair the changelog in hatter for 0.3.0, use git to figure out what happened between the 0.3.0 release and 0.2.0 Co-Authored-By: Claude Opus 4.6 --- Changelog.md | 82 +++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 71 insertions(+), 11 deletions(-) diff --git a/Changelog.md b/Changelog.md index 80d9c0f9..008007ed 100644 --- a/Changelog.md +++ b/Changelog.md @@ -1,22 +1,82 @@ # Change log for hatter -## Version 0.3.0 2026.04.19 -We used advanced sciences and made hatter even better! - -Science was used to make the animations work! +## Version 0.3.0 2026.04.19 +### Breaking changes -Also we used science to get IOS to run and install !!! +- `Column` and `Row` constructors now take `LayoutSettings` instead of + `[Widget]`. Use the `column`, `row`, `scrollColumn`, `scrollRow` + smart constructors for the old behaviour. +- `ScrollView` constructor removed. Scrolling is now a property of + `Column`/`Row` via the `lsScrollable` field in `LayoutSettings`, + or use `scrollColumn`/`scrollRow`. +- Container children are now wrapped in `LayoutItem` (with optional + `WidgetKey`) for key-based diffing. +- `Easing`-based tween animations replaced with CSS-like keyframe + animations. Use `linearAnimation`, `easeIn`, `easeOut`, + `easeInOut`, `andThen`, and `lerpStyle` for the new API. +- Removed configurable `soName` from `mkAndroidLib`. -We had some science left and use that to -kill all bugs with pesticides. +### Added -very good. +- `Hatter.Widget.Stack` — z-order overlay container (maps to + FrameLayout on Android, UIView overlay on iOS, ZStack on watchOS). + Includes `wsTouchPassthrough` style field for controlling touch + interception on overlay layers. +- Smart constructors: `column`, `row`, `scrollColumn`, `scrollRow`, + `stack`, `item`, `keyedItem`. +- `LayoutSettings`, `LayoutItem`, `WidgetKey` types for keyed + container children with key-based child matching in `diffContainer`. +- Keyframe animation API: `linearAnimation`, `easeIn`, `easeOut`, + `easeInOut`, `andThen`, `lerpStyle` for composable CSS-like + animation sequences. +- `requestRedraw` API (`Hatter.Render`) for triggering UI re-renders + from background threads. Uses C pthread timer on Android + (non-threaded RTS safe) and platform-native dispatch elsewhere. +- `tiAutoFocus` field on `TextInputConfig` — auto-focus on render + (deferred on Android via `View.post` for attachment safety). +- `Hatter.DeviceInfo` — query device model, OS version, and screen + dimensions on all platforms. +- Re-render UI automatically after `TextInput` value changes. +- `hatter_hs_init` with `RtsConfig` for reliable RTS initialisation + on iOS/watchOS (fixes `hs_init` hang). +- RTS heap limit (`-xr`) on iOS/watchOS real devices to avoid 1TB + `mmap` rejection. +- Build hatter as a normal cross-compiled Haskell package via + `collect-deps.nix` / `cross-deps.nix`. +- Share pre-compiled hatter objects across all Android ABI builds. +- `-split-sections` + `--gc-sections` for smaller Android `.so` files. +- Node ID reclamation via free stack on all platforms. -I can make ask claudes to make a nice overview in here. -but fuck that, +### Fixed -better to make u laugh traveler. +- First-render animation bug: tweens now register from zero origin + on initial render, not only on re-render. +- Animated widget toggle-back bug: animation config preserved when + toggling an `Animated` wrapper off then back on. +- Key-based child diffing prevents cascading native view destruction + when inserting/removing children mid-list. +- Index-based default keys replace content-based `inferKey`, avoiding + hash collisions for identical widgets. +- `Styled` wrapper now reapplies style when the child widget changes + type (e.g. `Text` to `Button`). +- Android `destroy_node` detaches view from parent before freeing JNI + refs (fixes orphaned native views). +- ScrollView SIGABRT on Android when mixing `TextInput` with other + widgets — children now wrapped in inner `LinearLayout`. +- Android `TextWatcher` re-entry crash prevented by guarding against + redundant `setText` calls. +- In-place diff for `Text`/`Button` widgets preserves native IME + connection on Android. +- armv7a OOM from duplicated `registerForeignExports` `.init_array` + entries. +- iOS/watchOS cross-build: drop `deriving stock` on `WidgetKey`. +- iOS `hs_init` hang resolved via `hatter_hs_init` with explicit + `RtsConfig` and null-terminated argv. +- Swift type inference errors on Xcode 16.4. +- `os_log` `CVarArg` conformance on iOS — use `String(describing:)` + for pointer values. +- GNU `libffi` built from source for static iOS/watchOS bundling. ## Version 0.2.0 From b85af206af51c0b154dd01fe89cfe9b4504ae056 Mon Sep 17 00:00:00 2001 From: jappeace-sloth Date: Mon, 20 Apr 2026 19:20:13 +0000 Subject: [PATCH 6/7] Simplify Int32->Int conversions with unwitch 3.0.0 unwitch 3.0.0 makes Int32.toInt total (Int32 -> Int) on GHC, so the int32ToIntKey helper and CInt.toInt . Int32.toCInt chain are no longer needed. Replace all 10 copies with direct Int32.toInt calls and remove the CInt import from files that only used it for the helper. Bump unwitch dependency to >= 3.0.0, point nix overlays to the jappeace/unwitch commit with the total conversion. Prompt: go simplify conversions here with unwitch 3 Co-Authored-By: Claude Opus 4.6 --- hatter.cabal | 6 +++--- nix/cross-deps.nix | 4 ++-- nix/hpkgs.nix | 4 ++-- nix/ios-deps.nix | 4 ++-- src/Hatter/Action.hs | 15 ++++----------- src/Hatter/Animation.hs | 9 +-------- src/Hatter/AuthSession.hs | 7 +------ src/Hatter/BottomSheet.hs | 7 +------ src/Hatter/Camera.hs | 9 ++------- src/Hatter/Dialog.hs | 7 +------ src/Hatter/Http.hs | 7 +------ src/Hatter/Permission.hs | 7 +------ src/Hatter/PlatformSignIn.hs | 7 +------ src/Hatter/SecureStorage.hs | 11 +++-------- 14 files changed, 25 insertions(+), 79 deletions(-) diff --git a/hatter.cabal b/hatter.cabal index d5a3e87a..c5d180fa 100644 --- a/hatter.cabal +++ b/hatter.cabal @@ -120,7 +120,7 @@ library bytestring < 1, transformers < 0.7, time, - unwitch >= 2.2.0 && < 3 + unwitch >= 3.0.0 && < 4 c-sources: cbits/android_stubs.c cbits/platform_log.c @@ -193,7 +193,7 @@ executable redraw-demo build-depends: hatter, text, - unwitch >= 2.2.0 && < 3 + unwitch >= 3.0.0 && < 4 executable confetti-repro-demo import: common-options @@ -253,4 +253,4 @@ test-suite unit bytestring, directory, filepath, - unwitch >= 2.2.0 && < 3 + unwitch >= 3.0.0 && < 4 diff --git a/nix/cross-deps.nix b/nix/cross-deps.nix index 48dad8b2..0a0570c2 100644 --- a/nix/cross-deps.nix +++ b/nix/cross-deps.nix @@ -230,8 +230,8 @@ WRAPPER unwitchOverride = self: super: { unwitch = self.callCabal2nix "unwitch" (builtins.fetchTarball { - url = "https://hackage.haskell.org/package/unwitch-2.2.0/unwitch-2.2.0.tar.gz"; - sha256 = "sha256:he/wdUN1XOcEo0VTmJVRrdQnGmZldxgCPCxlSDvzd9c="; + url = "https://github.com/jappeace/unwitch/archive/2759bdd153f293e0e6524d0170e861e51302caa4.tar.gz"; + sha256 = "sha256:BGxZ1CQGIYP/gg/J9jua2/wSEH4qq7bW91qooNELUlI="; }) {}; }; diff --git a/nix/hpkgs.nix b/nix/hpkgs.nix index a9d5bf6c..5eec64a5 100644 --- a/nix/hpkgs.nix +++ b/nix/hpkgs.nix @@ -10,8 +10,8 @@ pkgs.haskellPackages.override { # bigger projects should consider putting haskell stuff in a subfolder hatter-project = hnew.callCabal2nix "hatter" ../. { }; unwitch = hnew.callCabal2nix "unwitch" (builtins.fetchTarball { - url = "https://hackage.haskell.org/package/unwitch-2.2.0/unwitch-2.2.0.tar.gz"; - sha256 = "sha256:he/wdUN1XOcEo0VTmJVRrdQnGmZldxgCPCxlSDvzd9c="; + url = "https://github.com/jappeace/unwitch/archive/2759bdd153f293e0e6524d0170e861e51302caa4.tar.gz"; + sha256 = "sha256:BGxZ1CQGIYP/gg/J9jua2/wSEH4qq7bW91qooNELUlI="; }) {}; }; } diff --git a/nix/ios-deps.nix b/nix/ios-deps.nix index d167f837..9247fb80 100644 --- a/nix/ios-deps.nix +++ b/nix/ios-deps.nix @@ -20,8 +20,8 @@ let unwitchOverride = self: super: { unwitch = self.callCabal2nix "unwitch" (builtins.fetchTarball { - url = "https://hackage.haskell.org/package/unwitch-2.2.0/unwitch-2.2.0.tar.gz"; - sha256 = "sha256:he/wdUN1XOcEo0VTmJVRrdQnGmZldxgCPCxlSDvzd9c="; + url = "https://github.com/jappeace/unwitch/archive/2759bdd153f293e0e6524d0170e861e51302caa4.tar.gz"; + sha256 = "sha256:BGxZ1CQGIYP/gg/J9jua2/wSEH4qq7bW91qooNELUlI="; }) {}; }; diff --git a/src/Hatter/Action.hs b/src/Hatter/Action.hs index 7278f6af..41d9f6b4 100644 --- a/src/Hatter/Action.hs +++ b/src/Hatter/Action.hs @@ -40,7 +40,6 @@ import Data.Int (Int32) import Data.IntMap.Strict (IntMap) import Data.IntMap.Strict qualified as IntMap import Data.Text (Text) -import Unwitch.Convert.CInt qualified as CInt import Unwitch.Convert.Int32 qualified as Int32 -- | An opaque handle to a click / tap callback. @@ -88,7 +87,7 @@ 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 (int32ToIntKey handleId) callback) + modifyIORef' (asCallbacks state) (IntMap.insert (Int32.toInt handleId) callback) modifyIORef' (asNextId state) (+ 1) pure (Action handleId) @@ -96,7 +95,7 @@ createAction callback = ActionM $ \state -> do createOnChange :: (Text -> IO ()) -> ActionM OnChange createOnChange callback = ActionM $ \state -> do handleId <- readIORef (asNextId state) - modifyIORef' (asTextCallbacks state) (IntMap.insert (int32ToIntKey handleId) callback) + modifyIORef' (asTextCallbacks state) (IntMap.insert (Int32.toInt handleId) callback) modifyIORef' (asNextId state) (+ 1) pure (OnChange handleId) @@ -109,17 +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 (int32ToIntKey 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 (int32ToIntKey handleId) callbacks) - --- | Convert Int32 to Int for use as IntMap key. --- Total on all GHC-supported platforms (Int >= 32 bits). --- Uses the total chain Int32 -> CInt -> Int. -int32ToIntKey :: Int32 -> Int -int32ToIntKey = CInt.toInt . Int32.toCInt + pure (IntMap.lookup (Int32.toInt handleId) callbacks) diff --git a/src/Hatter/Animation.hs b/src/Hatter/Animation.hs index 592ef0b0..db1085c2 100644 --- a/src/Hatter/Animation.hs +++ b/src/Hatter/Animation.hs @@ -31,7 +31,6 @@ import Data.List (sortBy) import Data.Ord (comparing) import Data.Time.Clock (NominalDiffTime) import Foreign.Ptr (Ptr) -import Unwitch.Convert.CInt qualified as CInt import Unwitch.Convert.Int32 qualified as Int32 import Hatter.Widget ( Keyframe(..) @@ -88,7 +87,7 @@ registerTween animState nodeId keyframes duration = do , atNodeId = nodeId , atDuration = duration } - modifyIORef' (ansTweens animState) (IntMap.insert (int32ToIntKey nodeId) tween) + modifyIORef' (ansTweens animState) (IntMap.insert (Int32.toInt nodeId) tween) ensureLoopStarted animState -- | Start the platform animation loop if not already active. @@ -257,12 +256,6 @@ interpolateStyle nodeId fromStyle toStyle progress = do (Just _fromEnabled, Nothing) -> pure () (Nothing, Nothing) -> pure () --- | Convert Int32 to Int for use as IntMap key. --- Total on all GHC-supported platforms (Int >= 32 bits). --- Uses the total chain Int32 -> CInt -> Int. -int32ToIntKey :: Int32 -> Int -int32ToIntKey = CInt.toInt . Int32.toCInt - -- | FFI imports for the C animation bridge. foreign import ccall "animation_start_loop" c_animationStartLoop :: Ptr () -> IO () foreign import ccall "animation_stop_loop" c_animationStopLoop :: IO () diff --git a/src/Hatter/AuthSession.hs b/src/Hatter/AuthSession.hs index c6f0e853..cc469b0a 100644 --- a/src/Hatter/AuthSession.hs +++ b/src/Hatter/AuthSession.hs @@ -90,7 +90,7 @@ authSessionResultFromInt _ _ _ = Nothing startAuthSession :: AuthSessionState -> Text -> Text -> (AuthSessionResult -> IO ()) -> IO () startAuthSession authSessionState authUrl callbackScheme callback = do requestId <- readIORef (asNextId authSessionState) - modifyIORef' (asCallbacks authSessionState) (IntMap.insert (int32ToIntKey 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 -> @@ -115,11 +115,6 @@ dispatchAuthSessionResult authSessionState requestId statusCode maybeRedirectUrl Nothing -> hPutStrLn stderr $ "dispatchAuthSessionResult: unknown request ID " ++ show requestId --- | Convert Int32 to Int for use as IntMap key. --- Total on all GHC-supported platforms (Int >= 32 bits). -int32ToIntKey :: Int32 -> Int -int32ToIntKey = CInt.toInt . Int32.toCInt - -- | FFI import: start an auth session via the C bridge. foreign import ccall "auth_session_start" c_authSessionStart :: Ptr () -> CInt -> CString -> CString -> IO () diff --git a/src/Hatter/BottomSheet.hs b/src/Hatter/BottomSheet.hs index 9830f107..a901f3f2 100644 --- a/src/Hatter/BottomSheet.hs +++ b/src/Hatter/BottomSheet.hs @@ -88,7 +88,7 @@ bottomSheetActionFromInt code showBottomSheet :: BottomSheetState -> BottomSheetConfig -> (BottomSheetAction -> IO ()) -> IO () showBottomSheet bottomSheetState config callback = do requestId <- readIORef (bssNextId bottomSheetState) - modifyIORef' (bssCallbacks bottomSheetState) (IntMap.insert (int32ToIntKey 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)) @@ -114,11 +114,6 @@ dispatchBottomSheetResult bottomSheetState requestId actionCode = Nothing -> hPutStrLn stderr $ "dispatchBottomSheetResult: unknown request ID " ++ show requestId --- | Convert Int32 to Int for use as IntMap key. --- Total on all GHC-supported platforms (Int >= 32 bits). -int32ToIntKey :: Int32 -> Int -int32ToIntKey = CInt.toInt . Int32.toCInt - -- | FFI import: show a bottom sheet via the C bridge. foreign import ccall "bottom_sheet_show" c_bottomSheetShow :: Ptr () -> CInt -> CString -> CString -> IO () diff --git a/src/Hatter/Camera.hs b/src/Hatter/Camera.hs index b7555b0c..28d4c961 100644 --- a/src/Hatter/Camera.hs +++ b/src/Hatter/Camera.hs @@ -146,7 +146,7 @@ stopCameraSession _cameraState = capturePhoto :: CameraState -> (CameraResult -> IO ()) -> IO () capturePhoto cameraState callback = do requestId <- readIORef (csNextId cameraState) - modifyIORef' (csCallbacks cameraState) (IntMap.insert (int32ToIntKey requestId) callback) + modifyIORef' (csCallbacks cameraState) (IntMap.insert (Int32.toInt requestId) callback) writeIORef (csNextId cameraState) (requestId + 1) ctx <- readIORef (csContextPtr cameraState) c_cameraCapturePhoto ctx (Int32.toCInt requestId) @@ -165,7 +165,7 @@ startVideoCapture :: CameraState -> IO () startVideoCapture cameraState frameCallback audioCallback completionCallback = do requestId <- readIORef (csNextId cameraState) - let reqKey = int32ToIntKey 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) @@ -246,11 +246,6 @@ dispatchAudioChunk cameraState requestId audioBytes = do Nothing -> hPutStrLn stderr $ "dispatchAudioChunk: unknown request ID " ++ show requestId --- | Convert Int32 to Int for use as IntMap key. --- Total on all GHC-supported platforms (Int >= 32 bits). -int32ToIntKey :: Int32 -> Int -int32ToIntKey = CInt.toInt . Int32.toCInt - -- | FFI import: start a camera session via the C bridge. foreign import ccall "camera_start_session" c_cameraStartSession :: Ptr () -> CInt -> IO () diff --git a/src/Hatter/Dialog.hs b/src/Hatter/Dialog.hs index 8fc16803..a58ef3f6 100644 --- a/src/Hatter/Dialog.hs +++ b/src/Hatter/Dialog.hs @@ -93,7 +93,7 @@ dialogActionFromInt _ = Nothing showDialog :: DialogState -> DialogConfig -> (DialogAction -> IO ()) -> IO () showDialog dialogState config callback = do requestId <- readIORef (dsNextId dialogState) - modifyIORef' (dsCallbacks dialogState) (IntMap.insert (int32ToIntKey requestId) callback) + modifyIORef' (dsCallbacks dialogState) (IntMap.insert (Int32.toInt requestId) callback) writeIORef (dsNextId dialogState) (requestId + 1) ctx <- readIORef (dsContextPtr dialogState) withCString (Text.unpack (dcTitle config)) $ \cTitle -> @@ -126,11 +126,6 @@ withOptionalCString :: Maybe Text -> (CString -> IO a) -> IO a withOptionalCString Nothing action = action nullPtr withOptionalCString (Just t) action = withCString (Text.unpack t) action --- | Convert Int32 to Int for use as IntMap key. --- Total on all GHC-supported platforms (Int >= 32 bits). -int32ToIntKey :: Int32 -> Int -int32ToIntKey = CInt.toInt . Int32.toCInt - -- | FFI import: show a dialog via the C bridge. foreign import ccall "dialog_show" c_dialogShow :: Ptr () -> CInt -> CString -> CString -> CString -> CString -> CString -> IO () diff --git a/src/Hatter/Http.hs b/src/Hatter/Http.hs index b592b867..e420152c 100644 --- a/src/Hatter/Http.hs +++ b/src/Hatter/Http.hs @@ -131,7 +131,7 @@ parseHeaders headerText = performRequest :: HttpState -> HttpRequest -> (Either HttpError HttpResponse -> IO ()) -> IO () performRequest httpState request callback = do requestId <- readIORef (hsNextId httpState) - modifyIORef' (hsCallbacks httpState) (IntMap.insert (int32ToIntKey requestId) callback) + modifyIORef' (hsCallbacks httpState) (IntMap.insert (Int32.toInt requestId) callback) writeIORef (hsNextId httpState) (requestId + 1) ctx <- readIORef (hsContextPtr httpState) let methodInt = httpMethodToInt (hrMethod request) @@ -165,11 +165,6 @@ dispatchHttpResult httpState requestId resultCode httpStatus maybeHeaders respon Nothing -> hPutStrLn stderr $ "dispatchHttpResult: unknown request ID " ++ show requestId --- | Convert Int32 to Int for use as IntMap key. --- Total on all GHC-supported platforms (Int >= 32 bits). -int32ToIntKey :: Int32 -> Int -int32ToIntKey = CInt.toInt . Int32.toCInt - -- | FFI import: send an HTTP request via the C bridge. foreign import ccall "http_request" c_httpRequest :: Ptr () -> CInt -> CInt -> CString -> CString diff --git a/src/Hatter/Permission.hs b/src/Hatter/Permission.hs index e6112493..dc18aa3e 100644 --- a/src/Hatter/Permission.hs +++ b/src/Hatter/Permission.hs @@ -100,7 +100,7 @@ permissionStatusFromInt _ = Nothing requestPermission :: PermissionState -> Permission -> (PermissionStatus -> IO ()) -> IO () requestPermission permissionState permission callback = do requestId <- readIORef (psNextId permissionState) - modifyIORef' (psCallbacks permissionState) (IntMap.insert (int32ToIntKey requestId) callback) + modifyIORef' (psCallbacks permissionState) (IntMap.insert (Int32.toInt requestId) callback) writeIORef (psNextId permissionState) (requestId + 1) ctx <- readIORef (psContextPtr permissionState) c_permissionRequest ctx (permissionToInt permission) (Int32.toCInt requestId) @@ -132,11 +132,6 @@ dispatchPermissionResult permissionState requestId statusCode = modifyIORef' (psCallbacks permissionState) (IntMap.delete (CInt.toInt requestId)) callback status --- | Convert Int32 to Int for use as IntMap key. --- Total on all GHC-supported platforms (Int >= 32 bits). -int32ToIntKey :: Int32 -> Int -int32ToIntKey = CInt.toInt . Int32.toCInt - -- | FFI import: request a permission via the C bridge. -- Takes an opaque context pointer, permission code, and request ID. foreign import ccall "permission_request" diff --git a/src/Hatter/PlatformSignIn.hs b/src/Hatter/PlatformSignIn.hs index ef23a2f1..fa987b8f 100644 --- a/src/Hatter/PlatformSignIn.hs +++ b/src/Hatter/PlatformSignIn.hs @@ -128,7 +128,7 @@ signInResultFromInt _ _ _ _ _ _ = Nothing startPlatformSignIn :: PlatformSignInState -> SignInProvider -> (SignInResult -> IO ()) -> IO () startPlatformSignIn signInState provider callback = do requestId <- readIORef (psiNextId signInState) - modifyIORef' (psiCallbacks signInState) (IntMap.insert (int32ToIntKey requestId) callback) + modifyIORef' (psiCallbacks signInState) (IntMap.insert (Int32.toInt requestId) callback) writeIORef (psiNextId signInState) (requestId + 1) ctx <- readIORef (psiContextPtr signInState) c_platformSignInStart ctx (Int32.toCInt requestId) (providerToInt provider) @@ -151,11 +151,6 @@ dispatchPlatformSignInResult signInState requestId statusCode maybeToken maybeUs Nothing -> hPutStrLn stderr $ "dispatchPlatformSignInResult: unknown request ID " ++ show requestId --- | Convert Int32 to Int for use as IntMap key. --- Total on all GHC-supported platforms (Int >= 32 bits). -int32ToIntKey :: Int32 -> Int -int32ToIntKey = CInt.toInt . Int32.toCInt - -- | FFI import: start a platform sign-in via the C bridge. foreign import ccall "platform_sign_in_start" c_platformSignInStart :: Ptr () -> CInt -> CInt -> IO () diff --git a/src/Hatter/SecureStorage.hs b/src/Hatter/SecureStorage.hs index 4998ba68..33b218d1 100644 --- a/src/Hatter/SecureStorage.hs +++ b/src/Hatter/SecureStorage.hs @@ -91,7 +91,7 @@ storageStatusFromInt _ = Nothing secureStorageWrite :: SecureStorageState -> Text -> Text -> (SecureStorageStatus -> IO ()) -> IO () secureStorageWrite storageState key value callback = do requestId <- readIORef (ssNextId storageState) - modifyIORef' (ssWriteCallbacks storageState) (IntMap.insert (int32ToIntKey requestId) callback) + modifyIORef' (ssWriteCallbacks storageState) (IntMap.insert (Int32.toInt requestId) callback) writeIORef (ssNextId storageState) (requestId + 1) ctx <- readIORef (ssContextPtr storageState) withCString (Text.unpack key) $ \cKey -> @@ -104,7 +104,7 @@ secureStorageWrite storageState key value callback = do secureStorageRead :: SecureStorageState -> Text -> (SecureStorageStatus -> Maybe Text -> IO ()) -> IO () secureStorageRead storageState key callback = do requestId <- readIORef (ssNextId storageState) - modifyIORef' (ssReadCallbacks storageState) (IntMap.insert (int32ToIntKey requestId) callback) + modifyIORef' (ssReadCallbacks storageState) (IntMap.insert (Int32.toInt requestId) callback) writeIORef (ssNextId storageState) (requestId + 1) ctx <- readIORef (ssContextPtr storageState) withCString (Text.unpack key) $ \cKey -> @@ -115,7 +115,7 @@ secureStorageRead storageState key callback = do secureStorageDelete :: SecureStorageState -> Text -> (SecureStorageStatus -> IO ()) -> IO () secureStorageDelete storageState key callback = do requestId <- readIORef (ssNextId storageState) - modifyIORef' (ssDeleteCallbacks storageState) (IntMap.insert (int32ToIntKey requestId) callback) + modifyIORef' (ssDeleteCallbacks storageState) (IntMap.insert (Int32.toInt requestId) callback) writeIORef (ssNextId storageState) (requestId + 1) ctx <- readIORef (ssContextPtr storageState) withCString (Text.unpack key) $ \cKey -> @@ -158,11 +158,6 @@ dispatchSecureStorageResult storageState requestId statusCode maybeValue = Nothing -> hPutStrLn stderr $ "dispatchSecureStorageResult: unknown request ID " ++ show requestId --- | Convert Int32 to Int for use as IntMap key. --- Total on all GHC-supported platforms (Int >= 32 bits). -int32ToIntKey :: Int32 -> Int -int32ToIntKey = CInt.toInt . Int32.toCInt - -- | FFI import: write a key-value pair via the C bridge. foreign import ccall "secure_storage_write" c_secureStorageWrite :: Ptr () -> CInt -> CString -> CString -> IO () From 0a30c0c10730368bd1c7ce5e787e2c5c9bbd5eb8 Mon Sep 17 00:00:00 2001 From: jappeace-sloth Date: Tue, 21 Apr 2026 16:30:48 +0000 Subject: [PATCH 7/7] Refactor nix/lib.nix and cache hatter for iOS/watchOS builds MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Combines two improvements to the Nix build infrastructure: 1. Deduplicate nix/lib.nix (995 → ~700 lines, 30% reduction): - Extract shared data lists (modules, C sources, headers, symbols) and helper functions into top-level let bindings - Merge mkIOSLib + mkWatchOSLib into internal mkAppleStaticLib parameterised by platform; public API preserved via thin wrappers - Merge mkSimulatorApp + mkWatchOSSimulatorApp into internal mkAppleSimulatorApp; public API preserved - Replace 14 repetitive NDK compile blocks with map over list - Hoist applePkgs, appleGhc, gmpStatic, libffiStatic to top-level 2. Build hatter as a cached cabal package for iOS/watchOS: - ios-deps.nix: add hatterSrc param, build hatter via callCabal2nix so the .a and package DB entry are cached - ios.nix, watchos.nix: pass hatterSrc to ios-deps.nix - mkAppleStaticLib: when crossDeps is provided, only compile Main.hs + run_main.c instead of all 22 modules + 19 C sources - Standalone fallback (crossDeps == null) preserved Adding a new bridge module now means editing 1 list, not 6+ places. Demo apps and consumers only recompile their entry point. Prompt: combine PR #213 and #214 into a single PR Co-Authored-By: Claude Opus 4.6 --- nix/ios-deps.nix | 28 +- nix/ios.nix | 1 + nix/lib.nix | 839 ++++++++++++++++------------------------------- nix/watchos.nix | 1 + 4 files changed, 303 insertions(+), 566 deletions(-) diff --git a/nix/ios-deps.nix b/nix/ios-deps.nix index 9247fb80..1491f335 100644 --- a/nix/ios-deps.nix +++ b/nix/ios-deps.nix @@ -14,6 +14,7 @@ , consumerCabalFile ? null , consumerCabal2Nix ? null , hpkgs ? (_: _: {}) # consumer haskellPackages overrides +, hatterSrc ? null # hatter source tree (builds hatter as a normal dep) }: let pkgs = import sources.nixpkgs {}; @@ -25,8 +26,27 @@ let }) {}; }; + # Build hatter as a regular haskellPackages derivation from local source. + # Executables and tests are stripped to avoid pulling in test-framework deps. + hatterOverride = self: super: + if hatterSrc != null then { + hatter = pkgs.haskell.lib.overrideCabal + (self.callCabal2nix "hatter" hatterSrc {}) + (old: { + postPatch = (old.postPatch or "") + '' + sed -i '/^executable /,$d' hatter.cabal + sed -i '/^test-suite /,$d' hatter.cabal + ''; + doCheck = false; + }); + } else {}; + nativeHaskellPkgs = pkgs.haskellPackages.override { - overrides = pkgs.lib.composeExtensions unwitchOverride hpkgs; + overrides = pkgs.lib.composeManyExtensions [ + unwitchOverride + hatterOverride + hpkgs + ]; }; ghc = nativeHaskellPkgs.ghc; @@ -37,11 +57,15 @@ let haskellPkgs = nativeHaskellPkgs; }; + # When hatterSrc is provided, add the hatter package to the collected deps + # so its .a and .conf are available for linking. + hatterDep = if hatterSrc != null then [ nativeHaskellPkgs.hatter ] else []; + # 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 ++ hatterOwnDeps; + deps = resolvedDeps ++ hatterDep ++ hatterOwnDeps; } diff --git a/nix/ios.nix b/nix/ios.nix index 4c9e8680..dfd50dff 100644 --- a/nix/ios.nix +++ b/nix/ios.nix @@ -14,6 +14,7 @@ let lib = import ./lib.nix { inherit sources; }; iosDeps = import ./ios-deps.nix { inherit sources consumerCabalFile consumerCabal2Nix hpkgs; + hatterSrc = ../.; }; in lib.mkIOSLib { diff --git a/nix/lib.nix b/nix/lib.nix index 25958ea5..85d71294 100644 --- a/nix/lib.nix +++ b/nix/lib.nix @@ -69,6 +69,264 @@ let buildTools = "${androidSdk}/libexec/android-sdk/build-tools/34.0.0"; platform = "${androidSdk}/libexec/android-sdk/platforms/android-34"; + # --- Apple (iOS/watchOS) shared infrastructure --- + applePkgs = import sources.nixpkgs {}; + appleGhc = applePkgs.haskellPackages.ghc; + gmpStatic = applePkgs.gmp.overrideAttrs (old: { + dontDisableStatic = true; + }); + # Apple's libffi (v40) only ships .dylib — no static archive. + # Build GNU libffi from source with --enable-static for bundling + # into the iOS fat archive (mac2ios patches the platform tag). + libffiStatic = applePkgs.stdenv.mkDerivation { + pname = "libffi-static"; + version = "3.5.2"; + src = applePkgs.fetchurl { + url = "https://github.com/libffi/libffi/releases/download/v3.5.2/libffi-3.5.2.tar.gz"; + hash = "sha256-86MIKiOzfCk6T80QUxR7Nx8v+R+n6hsqUuM1Z2usgtw="; + }; + configureFlags = [ "--enable-static" "--disable-shared" ]; + }; + + # ------------------------------------------------------------------------- + # Shared data lists — single source of truth for modules, sources, headers + # ------------------------------------------------------------------------- + + # Haskell source modules copied for Apple static builds + hatterModules = [ + "Types" "Lifecycle" "Widget" "UIBridge" "Render" "Locale" "I18n" + "Permission" "SecureStorage" "Ble" "Dialog" "Location" "AuthSession" + "PlatformSignIn" "Camera" "BottomSheet" "Http" "NetworkStatus" + "AppContext" "Animation" "FilesDir" "DeviceInfo" + ]; + + # C source files for Apple static builds + appleCbitsSources = [ + "platform_log" "ui_bridge" "run_main" "locale" + "permission_bridge" "secure_storage_bridge" "ble_bridge" + "dialog_bridge" "location_bridge" "auth_session_bridge" + "platform_sign_in_bridge" "camera_bridge" "bottom_sheet_bridge" + "http_bridge" "network_status_bridge" "animation_bridge" + "redraw_bridge" "files_dir" "device_info" + ]; + + # Bridge headers shipped in output include/ + bridgeHeaders = [ + "Hatter.h" "UIBridge.h" "PermissionBridge.h" "SecureStorageBridge.h" + "BleBridge.h" "DialogBridge.h" "LocationBridge.h" "AuthSessionBridge.h" + "PlatformSignInBridge.h" "CameraBridge.h" "BottomSheetBridge.h" + "HttpBridge.h" "NetworkStatusBridge.h" "AnimationBridge.h" "RedrawBridge.h" + ]; + + # Android C files with identical NDK compile pattern (JNI_PACKAGE=me_jappie_hatter) + androidJniBridgeFiles = [ + "jni_bridge" "permission_bridge_android" "secure_storage_android" + "ble_bridge_android" "dialog_bridge_android" "location_bridge_android" + "auth_session_android" "platform_sign_in_android" "camera_bridge_android" + "bottom_sheet_android" "http_bridge_android" "network_status_android" + "animation_bridge_android" "redraw_bridge_android" + ]; + + # Haskell symbols kept alive via -u linker flags. + # Android uses bare names; Apple prefixes with _. + commonExportedSymbols = [ + "haskellRunMain" "haskellOnLifecycle" "haskellRenderUI" "haskellOnUIEvent" + "haskellOnPermissionResult" "haskellOnSecureStorageResult" + "haskellOnBleScanResult" "haskellOnDialogResult" "haskellOnLocationUpdate" + "haskellOnAuthSessionResult" "haskellOnPlatformSignInResult" + "haskellOnCameraResult" "haskellOnVideoFrame" "haskellOnAudioChunk" + "haskellOnBottomSheetResult" "haskellOnHttpResult" + "haskellOnNetworkStatusChange" "haskellLogLocale" + ]; + androidOnlySymbols = [ "haskellOnUITextChange" ]; + appleOnlySymbols = [ "haskellLogDeviceInfo" ]; + + # ------------------------------------------------------------------------- + # Helper functions — generate repetitive shell/nix fragments + # ------------------------------------------------------------------------- + + # NDK compile one C file with JNI_PACKAGE and standard includes + ndkCompileJni = hatterSrc: cName: + '' + ${ndkCc} -c -fPIC \ + -DJNI_PACKAGE=me_jappie_hatter \ + -I${sysroot}/usr/include \ + -I$RTS_INCLUDE \ + -I${hatterSrc}/include \ + -o ${cName}.o \ + ${hatterSrc}/cbits/${cName}.c + ''; + + # Generate -optl-Wl,-u, flags + undefinedSymbolFlags = prefix: symbols: + builtins.concatStringsSep " \\\n " + (map (s: "-optl-Wl,-u,${prefix}${s}") symbols); + + # Generate header copy commands: cp / / + copyBridgeHeaders = src: dst: + builtins.concatStringsSep "\n" + (map (h: "cp ${src}/${h} ${dst}/${h}") bridgeHeaders); + + # Copy Hatter/*.hs modules from source tree + copyHatterModules = hatterSrc: + builtins.concatStringsSep "\n" + (map (m: "cp ${hatterSrc}/src/Hatter/${m}.hs Hatter/") hatterModules); + + # Copy C source files to writable build dir + copyCbitsSources = hatterSrc: + builtins.concatStringsSep "\n" + (map (f: "cp ${hatterSrc}/cbits/${f}.c cbits/") appleCbitsSources); + + # Generate cbits/*.c arguments for ghc -staticlib + cbitsSourceArgs = + builtins.concatStringsSep " \\\n " + (map (f: "cbits/${f}.c") appleCbitsSources); + + # ------------------------------------------------------------------------- + # Internal: mkAppleStaticLib — shared implementation for iOS and watchOS + # ------------------------------------------------------------------------- + mkAppleStaticLib = + { hatterSrc + , mainModule + , platform # "ios" or "watchos" + , simulator ? false + , pname ? "hatter-${platform}" + , extraModuleCopy ? "" + , crossDeps ? null # output of ios-deps.nix (lib/, pkgdb/) + }: + let + mac2tool = import (hatterSrc + "/nix/mac2${platform}.nix") { + inherit sources; pkgs = applePkgs; + }; + toolBin = "mac2${platform}"; + in + applePkgs.stdenv.mkDerivation { + inherit pname; + version = "0.1.0.0"; + + src = hatterSrc + "/src"; + + nativeBuildInputs = [ appleGhc applePkgs.cctools ]; + buildInputs = [ libffiStatic gmpStatic ]; + + buildPhase = '' + ${if crossDeps != null then '' + # Hatter is pre-built in crossDeps — only compile per-app files. + cp ${mainModule} Main.hs + + # run_main.c is not in cabal c-sources (references per-app ZCMain_main_closure) + mkdir -p cbits + cp ${hatterSrc}/cbits/run_main.c cbits/ + + # Extra module copies (consumer overrides) + ${extraModuleCopy} + + ghc -staticlib \ + -O2 \ + -o libHatter.a \ + -I${hatterSrc}/include \ + -package-db ${crossDeps}/pkgdb \ + -optl-lffi \ + ${undefinedSymbolFlags "_" (commonExportedSymbols ++ appleOnlySymbols)} \ + cbits/run_main.c \ + Main.hs + '' else '' + # Standalone build — compile hatter from source. + mkdir -p Hatter + ${copyHatterModules hatterSrc} + cp ${hatterSrc}/src/Hatter.hs . + + # Extra module copies + ${extraModuleCopy} + + cp ${mainModule} Main.hs + + # Copy C sources into writable build dir (GHC writes .o next to them) + mkdir -p cbits + ${copyCbitsSources hatterSrc} + + ghc -staticlib \ + -O2 \ + -o libHatter.a \ + -I${hatterSrc}/include \ + -optl-lffi \ + ${undefinedSymbolFlags "_" (commonExportedSymbols ++ appleOnlySymbols)} \ + ${cbitsSourceArgs} \ + Main.hs \ + Hatter.hs + ''} + ''; + + installPhase = '' + mkdir -p $out/lib $out/include + + echo "Merging static archives into libHatter.a" + libtool -static -o libCombined.a libHatter.a \ + ${gmpStatic}/lib/libgmp.a \ + ${libffiStatic}/lib/libffi.a \ + ${if crossDeps != null then "${crossDeps}/lib/*.a" else ""} + mv libCombined.a libHatter.a + + ${mac2tool}/bin/${toolBin} ${if simulator then "-s" else ""} libHatter.a + cp libHatter.a $out/lib/ + ${copyBridgeHeaders "${hatterSrc}/include" "$out/include"} + ''; + }; + + # ------------------------------------------------------------------------- + # Internal: mkAppleSimulatorApp — shared implementation for simulator staging + # ------------------------------------------------------------------------- + mkAppleSimulatorApp = + { platformLib # pre-built .a library derivation + , platformSrc # path to ios/ or watchos/ source directory + , platformName # "ios" or "watchos" + , name + , maxNodes ? 256 + , dynamicNodePool ? false + }: + let + nodePoolCFlags = + if dynamicNodePool then ["-DDYNAMIC_NODE_POOL"] + else if maxNodes != 256 then ["-DMAX_NODES=${toString maxNodes}"] + else []; + # Inject OTHER_CFLAGS into project.yml when non-default pool settings used. + # Uses single-quoted -c and argv to avoid shell quoting issues. + flagYaml = ''[${builtins.concatStringsSep ", " (map (f: ''"${f}"'') nodePoolCFlags)}]''; + patchProjectYml = + if nodePoolCFlags == [] then "" + else '' + ${pkgs.python3}/bin/python3 -c ' +import sys +yml = open(sys.argv[1]).read() +yml = yml.replace( + "OTHER_LDFLAGS:", + "OTHER_CFLAGS: " + sys.argv[2] + "\n OTHER_LDFLAGS:" +) +open(sys.argv[1], "w").write(yml) +' "$out/share/${platformName}/project.yml" '${flagYaml}' + ''; + in + pkgs.stdenv.mkDerivation { + inherit name; + + dontUnpack = true; + + buildPhase = '' + mkdir -p $out/share/${platformName}/lib $out/share/${platformName}/include + + cp -r ${platformSrc}/Hatter $out/share/${platformName}/ + cp -r ${platformSrc}/HatterUITests $out/share/${platformName}/ + cp ${platformSrc}/project.yml $out/share/${platformName}/project.yml + ${if nodePoolCFlags != [] then ''chmod u+w $out/share/${platformName}/project.yml'' else ""} + + cp ${platformLib}/lib/libHatter.a $out/share/${platformName}/lib/ + ${copyBridgeHeaders "${platformLib}/include" "$out/share/${platformName}/include"} + ${patchProjectYml} + ''; + + installPhase = "true"; + }; + in { # --------------------------------------------------------------------------- @@ -131,13 +389,7 @@ in { # Core library C files always use me_jappie_hatter because # native methods are declared on HatterActivity (the library's # own class), not the consumer's subclass. - ${ndkCc} -c -fPIC \ - -DJNI_PACKAGE=me_jappie_hatter \ - -I${sysroot}/usr/include \ - -I$RTS_INCLUDE \ - -I${hatterSrc}/include \ - -o jni_bridge.o \ - ${hatterSrc}/cbits/jni_bridge.c + ${builtins.concatStringsSep "\n" (map (ndkCompileJni hatterSrc) androidJniBridgeFiles)} ${ndkCc} -c -fPIC \ ${if dynamicNodePool then "-DDYNAMIC_NODE_POOL" @@ -149,110 +401,6 @@ in { -o ui_bridge_android.o \ ${hatterSrc}/cbits/ui_bridge_android.c - ${ndkCc} -c -fPIC \ - -DJNI_PACKAGE=me_jappie_hatter \ - -I${sysroot}/usr/include \ - -I$RTS_INCLUDE \ - -I${hatterSrc}/include \ - -o permission_bridge_android.o \ - ${hatterSrc}/cbits/permission_bridge_android.c - - ${ndkCc} -c -fPIC \ - -DJNI_PACKAGE=me_jappie_hatter \ - -I${sysroot}/usr/include \ - -I$RTS_INCLUDE \ - -I${hatterSrc}/include \ - -o secure_storage_android.o \ - ${hatterSrc}/cbits/secure_storage_android.c - - ${ndkCc} -c -fPIC \ - -DJNI_PACKAGE=me_jappie_hatter \ - -I${sysroot}/usr/include \ - -I$RTS_INCLUDE \ - -I${hatterSrc}/include \ - -o ble_bridge_android.o \ - ${hatterSrc}/cbits/ble_bridge_android.c - - ${ndkCc} -c -fPIC \ - -DJNI_PACKAGE=me_jappie_hatter \ - -I${sysroot}/usr/include \ - -I$RTS_INCLUDE \ - -I${hatterSrc}/include \ - -o dialog_bridge_android.o \ - ${hatterSrc}/cbits/dialog_bridge_android.c - - ${ndkCc} -c -fPIC \ - -DJNI_PACKAGE=me_jappie_hatter \ - -I${sysroot}/usr/include \ - -I$RTS_INCLUDE \ - -I${hatterSrc}/include \ - -o location_bridge_android.o \ - ${hatterSrc}/cbits/location_bridge_android.c - - ${ndkCc} -c -fPIC \ - -DJNI_PACKAGE=me_jappie_hatter \ - -I${sysroot}/usr/include \ - -I$RTS_INCLUDE \ - -I${hatterSrc}/include \ - -o auth_session_android.o \ - ${hatterSrc}/cbits/auth_session_android.c - - ${ndkCc} -c -fPIC \ - -DJNI_PACKAGE=me_jappie_hatter \ - -I${sysroot}/usr/include \ - -I$RTS_INCLUDE \ - -I${hatterSrc}/include \ - -o platform_sign_in_android.o \ - ${hatterSrc}/cbits/platform_sign_in_android.c - - ${ndkCc} -c -fPIC \ - -DJNI_PACKAGE=me_jappie_hatter \ - -I${sysroot}/usr/include \ - -I$RTS_INCLUDE \ - -I${hatterSrc}/include \ - -o camera_bridge_android.o \ - ${hatterSrc}/cbits/camera_bridge_android.c - - ${ndkCc} -c -fPIC \ - -DJNI_PACKAGE=me_jappie_hatter \ - -I${sysroot}/usr/include \ - -I$RTS_INCLUDE \ - -I${hatterSrc}/include \ - -o bottom_sheet_android.o \ - ${hatterSrc}/cbits/bottom_sheet_android.c - - ${ndkCc} -c -fPIC \ - -DJNI_PACKAGE=me_jappie_hatter \ - -I${sysroot}/usr/include \ - -I$RTS_INCLUDE \ - -I${hatterSrc}/include \ - -o http_bridge_android.o \ - ${hatterSrc}/cbits/http_bridge_android.c - - ${ndkCc} -c -fPIC \ - -DJNI_PACKAGE=me_jappie_hatter \ - -I${sysroot}/usr/include \ - -I$RTS_INCLUDE \ - -I${hatterSrc}/include \ - -o network_status_android.o \ - ${hatterSrc}/cbits/network_status_android.c - - ${ndkCc} -c -fPIC \ - -DJNI_PACKAGE=me_jappie_hatter \ - -I${sysroot}/usr/include \ - -I$RTS_INCLUDE \ - -I${hatterSrc}/include \ - -o animation_bridge_android.o \ - ${hatterSrc}/cbits/animation_bridge_android.c - - ${ndkCc} -c -fPIC \ - -DJNI_PACKAGE=me_jappie_hatter \ - -I${sysroot}/usr/include \ - -I$RTS_INCLUDE \ - -I${hatterSrc}/include \ - -o redraw_bridge_android.o \ - ${hatterSrc}/cbits/redraw_bridge_android.c - # Compile extra JNI bridge sources (consumer-specific JNI methods) ${builtins.concatStringsSep "\n" (builtins.genList (i: let src = builtins.elemAt extraJniBridge i; @@ -351,42 +499,12 @@ in { -optl-llog \ -optl-Wl,-z,max-page-size=16384 \ -optl-Wl,--gc-sections \ - -optl$(pwd)/jni_bridge.o \ + ${builtins.concatStringsSep " \\\n " + (map (f: "-optl$(pwd)/${f}.o") androidJniBridgeFiles)} \ -optl$(pwd)/ui_bridge_android.o \ - -optl$(pwd)/permission_bridge_android.o \ - -optl$(pwd)/secure_storage_android.o \ - -optl$(pwd)/ble_bridge_android.o \ - -optl$(pwd)/dialog_bridge_android.o \ - -optl$(pwd)/location_bridge_android.o \ - -optl$(pwd)/auth_session_android.o \ - -optl$(pwd)/platform_sign_in_android.o \ - -optl$(pwd)/camera_bridge_android.o \ - -optl$(pwd)/bottom_sheet_android.o \ - -optl$(pwd)/http_bridge_android.o \ - -optl$(pwd)/network_status_android.o \ - -optl$(pwd)/animation_bridge_android.o \ - -optl$(pwd)/redraw_bridge_android.o \ ${builtins.concatStringsSep " " (builtins.genList (i: "-optl$(pwd)/extra_jni_${toString i}.o") (builtins.length extraJniBridge))} \ ${builtins.concatStringsSep " " (map (o: "-optl${o}") extraLinkObjects)} \ - -optl-Wl,-u,haskellRunMain \ - -optl-Wl,-u,haskellOnLifecycle \ - -optl-Wl,-u,haskellRenderUI \ - -optl-Wl,-u,haskellOnUIEvent \ - -optl-Wl,-u,haskellOnUITextChange \ - -optl-Wl,-u,haskellOnPermissionResult \ - -optl-Wl,-u,haskellOnSecureStorageResult \ - -optl-Wl,-u,haskellOnBleScanResult \ - -optl-Wl,-u,haskellOnDialogResult \ - -optl-Wl,-u,haskellOnLocationUpdate \ - -optl-Wl,-u,haskellOnAuthSessionResult \ - -optl-Wl,-u,haskellOnPlatformSignInResult \ - -optl-Wl,-u,haskellOnCameraResult \ - -optl-Wl,-u,haskellOnVideoFrame \ - -optl-Wl,-u,haskellOnAudioChunk \ - -optl-Wl,-u,haskellOnBottomSheetResult \ - -optl-Wl,-u,haskellOnHttpResult \ - -optl-Wl,-u,haskellOnNetworkStatusChange \ - -optl-Wl,-u,haskellLogLocale \ + ${undefinedSymbolFlags "" (commonExportedSymbols ++ androidOnlySymbols)} \ -optl-Wl,--wrap=registerForeignExports \ -optl-Wl,--no-undefined \ -optl-Wl,--whole-archive \ @@ -546,173 +664,7 @@ in { # --------------------------------------------------------------------------- # mkIOSLib: Compile Haskell to static .a for iOS (device or simulator) # --------------------------------------------------------------------------- - mkIOSLib = - { hatterSrc - , mainModule - , simulator ? false - , pname ? "hatter-ios" - , extraModuleCopy ? "" - , crossDeps ? null # output of ios-deps.nix (lib/, hi/, pkgdb/) - }: - let - iosPkgs = import sources.nixpkgs {}; - iosGhc = iosPkgs.haskellPackages.ghc; - mac2ios = import (hatterSrc + "/nix/mac2ios.nix") { inherit sources; pkgs = iosPkgs; }; - gmpStatic = iosPkgs.gmp.overrideAttrs (old: { - dontDisableStatic = true; - }); - # Apple's libffi (v40) only ships .dylib — no static archive. - # Build GNU libffi from source with --enable-static for bundling - # into the iOS fat archive (mac2ios patches the platform tag). - libffiStatic = iosPkgs.stdenv.mkDerivation { - pname = "libffi-static"; - version = "3.5.2"; - src = iosPkgs.fetchurl { - url = "https://github.com/libffi/libffi/releases/download/v3.5.2/libffi-3.5.2.tar.gz"; - hash = "sha256-86MIKiOzfCk6T80QUxR7Nx8v+R+n6hsqUuM1Z2usgtw="; - }; - configureFlags = [ "--enable-static" "--disable-shared" ]; - }; - in - iosPkgs.stdenv.mkDerivation { - inherit pname; - version = "0.1.0.0"; - - src = hatterSrc + "/src"; - - nativeBuildInputs = [ iosGhc iosPkgs.cctools ]; - buildInputs = [ libffiStatic gmpStatic ]; - - buildPhase = '' - mkdir -p Hatter - cp ${hatterSrc}/src/Hatter/Types.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Lifecycle.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Widget.hs Hatter/ - cp ${hatterSrc}/src/Hatter/UIBridge.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Render.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Locale.hs Hatter/ - cp ${hatterSrc}/src/Hatter/I18n.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Permission.hs Hatter/ - cp ${hatterSrc}/src/Hatter/SecureStorage.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Ble.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Dialog.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Location.hs Hatter/ - cp ${hatterSrc}/src/Hatter/AuthSession.hs Hatter/ - cp ${hatterSrc}/src/Hatter/PlatformSignIn.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Camera.hs Hatter/ - cp ${hatterSrc}/src/Hatter/BottomSheet.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Http.hs Hatter/ - cp ${hatterSrc}/src/Hatter/NetworkStatus.hs Hatter/ - cp ${hatterSrc}/src/Hatter/AppContext.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Animation.hs Hatter/ - cp ${hatterSrc}/src/Hatter/FilesDir.hs Hatter/ - cp ${hatterSrc}/src/Hatter/DeviceInfo.hs Hatter/ - cp ${hatterSrc}/src/Hatter.hs . - - # Extra module copies - ${extraModuleCopy} - - cp ${mainModule} Main.hs - - # Copy C sources into writable build dir (GHC writes .o next to them) - mkdir -p cbits - cp ${hatterSrc}/cbits/platform_log.c cbits/ - cp ${hatterSrc}/cbits/ui_bridge.c cbits/ - cp ${hatterSrc}/cbits/run_main.c cbits/ - cp ${hatterSrc}/cbits/locale.c cbits/ - cp ${hatterSrc}/cbits/permission_bridge.c cbits/ - cp ${hatterSrc}/cbits/secure_storage_bridge.c cbits/ - cp ${hatterSrc}/cbits/ble_bridge.c cbits/ - cp ${hatterSrc}/cbits/dialog_bridge.c cbits/ - cp ${hatterSrc}/cbits/location_bridge.c cbits/ - cp ${hatterSrc}/cbits/auth_session_bridge.c cbits/ - cp ${hatterSrc}/cbits/platform_sign_in_bridge.c cbits/ - cp ${hatterSrc}/cbits/camera_bridge.c cbits/ - cp ${hatterSrc}/cbits/bottom_sheet_bridge.c cbits/ - cp ${hatterSrc}/cbits/http_bridge.c cbits/ - cp ${hatterSrc}/cbits/network_status_bridge.c cbits/ - cp ${hatterSrc}/cbits/animation_bridge.c cbits/ - cp ${hatterSrc}/cbits/redraw_bridge.c cbits/ - cp ${hatterSrc}/cbits/files_dir.c cbits/ - cp ${hatterSrc}/cbits/device_info.c cbits/ - - ghc -staticlib \ - -O2 \ - -o libHatter.a \ - -I${hatterSrc}/include \ - ${if crossDeps != null then "-package-db ${crossDeps}/pkgdb -i${crossDeps}/hi" else ""} \ - -optl-lffi \ - -optl-Wl,-u,_haskellRunMain \ - -optl-Wl,-u,_haskellOnLifecycle \ - -optl-Wl,-u,_haskellRenderUI \ - -optl-Wl,-u,_haskellOnUIEvent \ - -optl-Wl,-u,_haskellOnPermissionResult \ - -optl-Wl,-u,_haskellOnSecureStorageResult \ - -optl-Wl,-u,_haskellOnBleScanResult \ - -optl-Wl,-u,_haskellOnDialogResult \ - -optl-Wl,-u,_haskellOnLocationUpdate \ - -optl-Wl,-u,_haskellOnAuthSessionResult \ - -optl-Wl,-u,_haskellOnPlatformSignInResult \ - -optl-Wl,-u,_haskellOnCameraResult \ - -optl-Wl,-u,_haskellOnVideoFrame \ - -optl-Wl,-u,_haskellOnAudioChunk \ - -optl-Wl,-u,_haskellOnBottomSheetResult \ - -optl-Wl,-u,_haskellOnHttpResult \ - -optl-Wl,-u,_haskellOnNetworkStatusChange \ - -optl-Wl,-u,_haskellLogLocale \ - -optl-Wl,-u,_haskellLogDeviceInfo \ - cbits/platform_log.c \ - cbits/ui_bridge.c \ - cbits/run_main.c \ - cbits/locale.c \ - cbits/permission_bridge.c \ - cbits/secure_storage_bridge.c \ - cbits/ble_bridge.c \ - cbits/dialog_bridge.c \ - cbits/location_bridge.c \ - cbits/auth_session_bridge.c \ - cbits/platform_sign_in_bridge.c \ - cbits/camera_bridge.c \ - cbits/bottom_sheet_bridge.c \ - cbits/http_bridge.c \ - cbits/network_status_bridge.c \ - cbits/animation_bridge.c \ - cbits/redraw_bridge.c \ - cbits/files_dir.c \ - cbits/device_info.c \ - Main.hs \ - Hatter.hs - ''; - - installPhase = '' - mkdir -p $out/lib $out/include - - echo "Merging static archives into libHatter.a" - libtool -static -o libCombined.a libHatter.a \ - ${gmpStatic}/lib/libgmp.a \ - ${libffiStatic}/lib/libffi.a \ - ${if crossDeps != null then "${crossDeps}/lib/*.a" else ""} - mv libCombined.a libHatter.a - - ${mac2ios}/bin/mac2ios ${if simulator then "-s" else ""} libHatter.a - cp libHatter.a $out/lib/ - cp ${hatterSrc}/include/Hatter.h $out/include/Hatter.h - cp ${hatterSrc}/include/UIBridge.h $out/include/UIBridge.h - cp ${hatterSrc}/include/PermissionBridge.h $out/include/PermissionBridge.h - cp ${hatterSrc}/include/SecureStorageBridge.h $out/include/SecureStorageBridge.h - cp ${hatterSrc}/include/BleBridge.h $out/include/BleBridge.h - cp ${hatterSrc}/include/DialogBridge.h $out/include/DialogBridge.h - cp ${hatterSrc}/include/LocationBridge.h $out/include/LocationBridge.h - cp ${hatterSrc}/include/AuthSessionBridge.h $out/include/AuthSessionBridge.h - cp ${hatterSrc}/include/PlatformSignInBridge.h $out/include/PlatformSignInBridge.h - cp ${hatterSrc}/include/CameraBridge.h $out/include/CameraBridge.h - cp ${hatterSrc}/include/BottomSheetBridge.h $out/include/BottomSheetBridge.h - cp ${hatterSrc}/include/HttpBridge.h $out/include/HttpBridge.h - cp ${hatterSrc}/include/NetworkStatusBridge.h $out/include/NetworkStatusBridge.h - cp ${hatterSrc}/include/AnimationBridge.h $out/include/AnimationBridge.h - cp ${hatterSrc}/include/RedrawBridge.h $out/include/RedrawBridge.h - ''; - }; + mkIOSLib = args: mkAppleStaticLib (args // { platform = "ios"; }); # --------------------------------------------------------------------------- # mkSimulatorApp: Stage iOS sources + pre-built library for xcodebuild @@ -721,235 +673,20 @@ in { { iosLib , iosSrc , name ? "simulator-app" - , maxNodes ? 256 # static pool size (ignored when dynamicNodePool=true) - , dynamicNodePool ? false # use malloc/realloc instead of fixed array + , maxNodes ? 256 + , dynamicNodePool ? false }: - let - nodePoolCFlags = - if dynamicNodePool then ["-DDYNAMIC_NODE_POOL"] - else if maxNodes != 256 then ["-DMAX_NODES=${toString maxNodes}"] - else []; - # Inject OTHER_CFLAGS into project.yml when non-default pool settings used. - # Uses single-quoted -c and argv to avoid shell quoting issues. - flagYaml = ''[${builtins.concatStringsSep ", " (map (f: ''"${f}"'') nodePoolCFlags)}]''; - patchProjectYml = - if nodePoolCFlags == [] then "" - else '' - ${pkgs.python3}/bin/python3 -c ' -import sys -yml = open(sys.argv[1]).read() -yml = yml.replace( - "OTHER_LDFLAGS:", - "OTHER_CFLAGS: " + sys.argv[2] + "\n OTHER_LDFLAGS:" -) -open(sys.argv[1], "w").write(yml) -' "$out/share/ios/project.yml" '${flagYaml}' - ''; - in - pkgs.stdenv.mkDerivation { - inherit name; - - dontUnpack = true; - - buildPhase = '' - mkdir -p $out/share/ios/lib $out/share/ios/include - - cp -r ${iosSrc}/Hatter $out/share/ios/ - cp -r ${iosSrc}/HatterUITests $out/share/ios/ - cp ${iosSrc}/project.yml $out/share/ios/project.yml - chmod u+w $out/share/ios/project.yml - - cp ${iosLib}/lib/libHatter.a $out/share/ios/lib/ - cp ${iosLib}/include/Hatter.h $out/share/ios/include/ - cp ${iosLib}/include/UIBridge.h $out/share/ios/include/ - cp ${iosLib}/include/PermissionBridge.h $out/share/ios/include/ - cp ${iosLib}/include/SecureStorageBridge.h $out/share/ios/include/ - cp ${iosLib}/include/BleBridge.h $out/share/ios/include/ - cp ${iosLib}/include/DialogBridge.h $out/share/ios/include/ - cp ${iosLib}/include/LocationBridge.h $out/share/ios/include/ - cp ${iosLib}/include/AuthSessionBridge.h $out/share/ios/include/ - cp ${iosLib}/include/PlatformSignInBridge.h $out/share/ios/include/ - cp ${iosLib}/include/CameraBridge.h $out/share/ios/include/ - cp ${iosLib}/include/BottomSheetBridge.h $out/share/ios/include/ - cp ${iosLib}/include/HttpBridge.h $out/share/ios/include/ - cp ${iosLib}/include/NetworkStatusBridge.h $out/share/ios/include/ - cp ${iosLib}/include/AnimationBridge.h $out/share/ios/include/ - cp ${iosLib}/include/RedrawBridge.h $out/share/ios/include/ - ${patchProjectYml} - ''; - - installPhase = "true"; + mkAppleSimulatorApp { + platformLib = iosLib; + platformSrc = iosSrc; + platformName = "ios"; + inherit name maxNodes dynamicNodePool; }; # --------------------------------------------------------------------------- # mkWatchOSLib: Compile Haskell to static .a for watchOS (device or simulator) # --------------------------------------------------------------------------- - mkWatchOSLib = - { hatterSrc - , mainModule - , simulator ? false - , pname ? "hatter-watchos" - , extraModuleCopy ? "" - , crossDeps ? null # output of ios-deps.nix (lib/, hi/, pkgdb/) - }: - let - iosPkgs = import sources.nixpkgs {}; - iosGhc = iosPkgs.haskellPackages.ghc; - mac2watchos = import (hatterSrc + "/nix/mac2watchos.nix") { - inherit sources; pkgs = iosPkgs; - }; - gmpStatic = iosPkgs.gmp.overrideAttrs (old: { - dontDisableStatic = true; - }); - libffiStatic = iosPkgs.stdenv.mkDerivation { - pname = "libffi-static"; - version = "3.5.2"; - src = iosPkgs.fetchurl { - url = "https://github.com/libffi/libffi/releases/download/v3.5.2/libffi-3.5.2.tar.gz"; - hash = "sha256-86MIKiOzfCk6T80QUxR7Nx8v+R+n6hsqUuM1Z2usgtw="; - }; - configureFlags = [ "--enable-static" "--disable-shared" ]; - }; - in - iosPkgs.stdenv.mkDerivation { - inherit pname; - version = "0.1.0.0"; - - src = hatterSrc + "/src"; - - nativeBuildInputs = [ iosGhc iosPkgs.cctools ]; - buildInputs = [ libffiStatic gmpStatic ]; - - buildPhase = '' - mkdir -p Hatter - cp ${hatterSrc}/src/Hatter/Types.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Lifecycle.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Widget.hs Hatter/ - cp ${hatterSrc}/src/Hatter/UIBridge.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Render.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Locale.hs Hatter/ - cp ${hatterSrc}/src/Hatter/I18n.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Permission.hs Hatter/ - cp ${hatterSrc}/src/Hatter/SecureStorage.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Ble.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Dialog.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Location.hs Hatter/ - cp ${hatterSrc}/src/Hatter/AuthSession.hs Hatter/ - cp ${hatterSrc}/src/Hatter/PlatformSignIn.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Camera.hs Hatter/ - cp ${hatterSrc}/src/Hatter/BottomSheet.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Http.hs Hatter/ - cp ${hatterSrc}/src/Hatter/NetworkStatus.hs Hatter/ - cp ${hatterSrc}/src/Hatter/AppContext.hs Hatter/ - cp ${hatterSrc}/src/Hatter/Animation.hs Hatter/ - cp ${hatterSrc}/src/Hatter/FilesDir.hs Hatter/ - cp ${hatterSrc}/src/Hatter/DeviceInfo.hs Hatter/ - cp ${hatterSrc}/src/Hatter.hs . - - # Extra module copies - ${extraModuleCopy} - - cp ${mainModule} Main.hs - - # Copy C sources into writable build dir (GHC writes .o next to them) - mkdir -p cbits - cp ${hatterSrc}/cbits/platform_log.c cbits/ - cp ${hatterSrc}/cbits/ui_bridge.c cbits/ - cp ${hatterSrc}/cbits/run_main.c cbits/ - cp ${hatterSrc}/cbits/locale.c cbits/ - cp ${hatterSrc}/cbits/permission_bridge.c cbits/ - cp ${hatterSrc}/cbits/secure_storage_bridge.c cbits/ - cp ${hatterSrc}/cbits/ble_bridge.c cbits/ - cp ${hatterSrc}/cbits/dialog_bridge.c cbits/ - cp ${hatterSrc}/cbits/location_bridge.c cbits/ - cp ${hatterSrc}/cbits/auth_session_bridge.c cbits/ - cp ${hatterSrc}/cbits/platform_sign_in_bridge.c cbits/ - cp ${hatterSrc}/cbits/camera_bridge.c cbits/ - cp ${hatterSrc}/cbits/bottom_sheet_bridge.c cbits/ - cp ${hatterSrc}/cbits/http_bridge.c cbits/ - cp ${hatterSrc}/cbits/network_status_bridge.c cbits/ - cp ${hatterSrc}/cbits/animation_bridge.c cbits/ - cp ${hatterSrc}/cbits/redraw_bridge.c cbits/ - cp ${hatterSrc}/cbits/files_dir.c cbits/ - cp ${hatterSrc}/cbits/device_info.c cbits/ - - ghc -staticlib \ - -O2 \ - -o libHatter.a \ - -I${hatterSrc}/include \ - ${if crossDeps != null then "-package-db ${crossDeps}/pkgdb -i${crossDeps}/hi" else ""} \ - -optl-lffi \ - -optl-Wl,-u,_haskellRunMain \ - -optl-Wl,-u,_haskellOnLifecycle \ - -optl-Wl,-u,_haskellRenderUI \ - -optl-Wl,-u,_haskellOnUIEvent \ - -optl-Wl,-u,_haskellOnPermissionResult \ - -optl-Wl,-u,_haskellOnSecureStorageResult \ - -optl-Wl,-u,_haskellOnBleScanResult \ - -optl-Wl,-u,_haskellOnDialogResult \ - -optl-Wl,-u,_haskellOnLocationUpdate \ - -optl-Wl,-u,_haskellOnAuthSessionResult \ - -optl-Wl,-u,_haskellOnPlatformSignInResult \ - -optl-Wl,-u,_haskellOnCameraResult \ - -optl-Wl,-u,_haskellOnVideoFrame \ - -optl-Wl,-u,_haskellOnAudioChunk \ - -optl-Wl,-u,_haskellOnBottomSheetResult \ - -optl-Wl,-u,_haskellOnHttpResult \ - -optl-Wl,-u,_haskellOnNetworkStatusChange \ - -optl-Wl,-u,_haskellLogLocale \ - -optl-Wl,-u,_haskellLogDeviceInfo \ - cbits/platform_log.c \ - cbits/ui_bridge.c \ - cbits/run_main.c \ - cbits/locale.c \ - cbits/permission_bridge.c \ - cbits/secure_storage_bridge.c \ - cbits/ble_bridge.c \ - cbits/dialog_bridge.c \ - cbits/location_bridge.c \ - cbits/auth_session_bridge.c \ - cbits/platform_sign_in_bridge.c \ - cbits/camera_bridge.c \ - cbits/bottom_sheet_bridge.c \ - cbits/http_bridge.c \ - cbits/network_status_bridge.c \ - cbits/animation_bridge.c \ - cbits/redraw_bridge.c \ - cbits/files_dir.c \ - cbits/device_info.c \ - Main.hs \ - Hatter.hs - ''; - - installPhase = '' - mkdir -p $out/lib $out/include - - echo "Merging static archives into libHatter.a" - libtool -static -o libCombined.a libHatter.a \ - ${gmpStatic}/lib/libgmp.a \ - ${libffiStatic}/lib/libffi.a \ - ${if crossDeps != null then "${crossDeps}/lib/*.a" else ""} - mv libCombined.a libHatter.a - - ${mac2watchos}/bin/mac2watchos ${if simulator then "-s" else ""} libHatter.a - cp libHatter.a $out/lib/ - cp ${hatterSrc}/include/Hatter.h $out/include/Hatter.h - cp ${hatterSrc}/include/UIBridge.h $out/include/UIBridge.h - cp ${hatterSrc}/include/PermissionBridge.h $out/include/PermissionBridge.h - cp ${hatterSrc}/include/SecureStorageBridge.h $out/include/SecureStorageBridge.h - cp ${hatterSrc}/include/BleBridge.h $out/include/BleBridge.h - cp ${hatterSrc}/include/DialogBridge.h $out/include/DialogBridge.h - cp ${hatterSrc}/include/LocationBridge.h $out/include/LocationBridge.h - cp ${hatterSrc}/include/AuthSessionBridge.h $out/include/AuthSessionBridge.h - cp ${hatterSrc}/include/PlatformSignInBridge.h $out/include/PlatformSignInBridge.h - cp ${hatterSrc}/include/CameraBridge.h $out/include/CameraBridge.h - cp ${hatterSrc}/include/BottomSheetBridge.h $out/include/BottomSheetBridge.h - cp ${hatterSrc}/include/HttpBridge.h $out/include/HttpBridge.h - cp ${hatterSrc}/include/NetworkStatusBridge.h $out/include/NetworkStatusBridge.h - cp ${hatterSrc}/include/AnimationBridge.h $out/include/AnimationBridge.h - cp ${hatterSrc}/include/RedrawBridge.h $out/include/RedrawBridge.h - ''; - }; + mkWatchOSLib = args: mkAppleStaticLib (args // { platform = "watchos"; }); # --------------------------------------------------------------------------- # mkWatchOSSimulatorApp: Stage watchOS sources + pre-built library for xcodebuild @@ -959,37 +696,11 @@ open(sys.argv[1], "w").write(yml) , watchosSrc , name ? "watchos-simulator-app" }: - pkgs.stdenv.mkDerivation { + mkAppleSimulatorApp { + platformLib = watchosLib; + platformSrc = watchosSrc; + platformName = "watchos"; inherit name; - - dontUnpack = true; - - buildPhase = '' - mkdir -p $out/share/watchos/lib $out/share/watchos/include - - cp -r ${watchosSrc}/Hatter $out/share/watchos/ - cp -r ${watchosSrc}/HatterUITests $out/share/watchos/ - cp ${watchosSrc}/project.yml $out/share/watchos/project.yml - - cp ${watchosLib}/lib/libHatter.a $out/share/watchos/lib/ - cp ${watchosLib}/include/Hatter.h $out/share/watchos/include/ - cp ${watchosLib}/include/UIBridge.h $out/share/watchos/include/ - cp ${watchosLib}/include/PermissionBridge.h $out/share/watchos/include/ - cp ${watchosLib}/include/SecureStorageBridge.h $out/share/watchos/include/ - cp ${watchosLib}/include/BleBridge.h $out/share/watchos/include/ - cp ${watchosLib}/include/DialogBridge.h $out/share/watchos/include/ - cp ${watchosLib}/include/LocationBridge.h $out/share/watchos/include/ - cp ${watchosLib}/include/AuthSessionBridge.h $out/share/watchos/include/ - cp ${watchosLib}/include/PlatformSignInBridge.h $out/share/watchos/include/ - cp ${watchosLib}/include/CameraBridge.h $out/share/watchos/include/ - cp ${watchosLib}/include/BottomSheetBridge.h $out/share/watchos/include/ - cp ${watchosLib}/include/HttpBridge.h $out/share/watchos/include/ - cp ${watchosLib}/include/NetworkStatusBridge.h $out/share/watchos/include/ - cp ${watchosLib}/include/AnimationBridge.h $out/share/watchos/include/ - cp ${watchosLib}/include/RedrawBridge.h $out/share/watchos/include/ - ''; - - installPhase = "true"; }; } diff --git a/nix/watchos.nix b/nix/watchos.nix index 26991eb0..ff671a00 100644 --- a/nix/watchos.nix +++ b/nix/watchos.nix @@ -10,6 +10,7 @@ let lib = import ./lib.nix { inherit sources; }; iosDeps = import ./ios-deps.nix { inherit sources consumerCabalFile consumerCabal2Nix hpkgs; + hatterSrc = ../.; }; in lib.mkWatchOSLib {