feat: more changes for disable-lens flag

Anut-py · Anut-py · commit 5ddf16741d7d · 2025-08-14T21:30:18.000-04:00
remove dependency on exceptions
disable linear when flag is true
add to github actions
diff --git a/.github/workflows/cabal-build.yml b/.github/workflows/cabal-build.yml
@@ -17,7 +17,8 @@ jobs:
       fail-fast: false
       matrix:
         os: [ubuntu-latest, windows-latest, macos-latest]
-        ghc-version: ["9.8", "9.6", "9.2"]
+        ghc-version: ["9.12", "9.10", "9.6", "9.2"]
+        lens: [true, false]
         exclude:
           - os: macos-latest
             ghc-version: "9.2"
@@ -43,33 +44,18 @@ jobs:
           sudo apt install -y x11proto-xext-dev libx11-dev xorg-dev freeglut3-dev
 
       - name: Configure the build
+        if: matrix.lens
         run: |
           cabal configure --enable-tests --enable-benchmarks --disable-documentation
           cabal build --dry-run
         # The last step generates dist-newstyle/cache/plan.json for the cache key.
 
-      # IMPT: Uncomment when adding steps after cabal build
-      # - name: Restore cached dependencies
-      #   uses: actions/cache/restore@v4
-      #   id: cache
-      #   env:
-      #     key: ${{ runner.os }}-ghc-${{ steps.setup.outputs.ghc-version }}-cabal-${{ steps.setup.outputs.cabal-version }}
-      #   with:
-      #     path: ${{ steps.setup.outputs.cabal-store }}
-      #     key: ${{ env.key }}-plan-${{ hashFiles('**/plan.json') }}
-      #     restore-keys: ${{ env.key }}-
-
-      # - name: Install dependencies
-      #   run: cabal build all --only-dependencies
-
-      # # Cache dependencies already here, so that we do not have to rebuild them should the subsequent steps fail.
-      # - name: Save cached dependencies
-      #   uses: actions/cache/save@v4
-      #   # Caches are immutable, trying to save with the same key would error.
-      #   if: ${{ steps.cache.outputs.cache-primary-key != steps.cache.outputs.cache-matched-key }}
-      #   with:
-      #     path: ${{ steps.setup.outputs.cabal-store }}
-      #     key: ${{ steps.cache.outputs.cache-primary-key }}
+      - name: Configure the build (no lens)
+        if: ${{ !matrix.lens }}
+        run: |
+          cabal configure --enable-tests --enable-benchmarks --disable-documentation -fdisable-lens
+          cabal build --dry-run
+        # The last step generates dist-newstyle/cache/plan.json for the cache key.
 
       - name: Build
         run: cabal build all
diff --git a/h-raylib.cabal b/h-raylib.cabal
@@ -254,14 +254,13 @@ library
     , base              >=4.0      && <4.22
     , bytestring        >=0.11.0   && <0.13
     , containers        >=0.6.0    && <0.9
-    , exceptions        >=0.10.4   && <0.11
-    , linear            >=1.22     && <1.24
     , template-haskell  >=2.16.0.0 && <2.24
     , text              >=2.0      && <2.2
   
   
   if !flag(disable-lens)
     build-depends:
+      , linear            >=1.22     && <1.24
       , lens              >=4.0      && <5.4
 
   hs-source-dirs:   src
@@ -379,3 +378,6 @@ library
 
   if flag(ghci)
     cpp-options: -DGHCI
+  
+  if flag(disable-lens)
+    cpp-options: -DDISABLE_LENS
diff --git a/src/Raylib/Internal/Foreign.hs b/src/Raylib/Internal/Foreign.hs
@@ -44,8 +44,13 @@ import qualified Data.Text.Encoding as TE
 import Foreign (FunPtr, Ptr, Storable (peek, peekByteOff, poke, sizeOf), allocaBytes, castPtr, malloc, newArray, nullPtr, peekArray, plusPtr, pokeArray0, with, withArray, withArrayLen)
 import Foreign.C (CFloat, CInt, CString, CUChar, CUInt, peekCString, withCString)
 import Foreign.C.Types (CBool, CChar, CShort, CUShort)
+
+#ifndef DISABLE_LENS
+
 import Linear (V2, V3, V4)
 
+#endif
+
 -- Internal utility functions
 
 #ifdef WEB_FFI
@@ -111,12 +116,16 @@ instance (Freeable a, Storable a) => Freeable [a] where
           let val = arr !! i in rlFreeDependents val (plusPtr ptr (i * sizeOf val))
       )
 
+#ifndef DISABLE_LENS
+
 instance Freeable (V2 a)
 
 instance Freeable (V3 a)
 
 instance Freeable (V4 a)
 
+#endif
+
 rlFreeMaybeArray :: (Freeable a, Storable a) => Maybe [a] -> Ptr a -> IO ()
 rlFreeMaybeArray Nothing _ = return ()
 rlFreeMaybeArray (Just arr) ptr = rlFree arr (castPtr ptr)
diff --git a/src/Raylib/Types/Core.hs b/src/Raylib/Types/Core.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE CPP #-}
 
 -- | Bindings for types used in all raylib modules
 module Raylib.Types.Core
@@ -140,10 +141,15 @@ import Foreign.C
     newCString,
     peekCString,
   )
-import Linear (V2(V2), V3(V3), V4(V4))
 import Raylib.Internal (Closeable(..), _unloadAutomationEventList, addAutomationEventList)
 import Raylib.Internal.Foreign (Freeable (rlFreeDependents), c'free, peekStaticArray, pokeStaticArray)
 
+#ifndef DISABLE_LENS
+
+import Linear (V2(V2), V3(V3), V4(V4))
+
+#endif
+
 
 ---------------------------------------
 -- core enums -------------------------
@@ -659,44 +665,106 @@ instance Enum Gesture where
 -- core structures --------------------
 ---------------------------------------
 
+pattern Vector2 :: Float -> Float -> Vector2
+pattern Vector3 :: Float -> Float -> Float -> Vector3
+pattern Vector4 :: Float -> Float -> Float -> Float -> Vector4
+
+#ifdef DISABLE_LENS
+
+data Vector2' = Vector2' Float Float deriving (Eq, Show, Freeable)
+instance Storable Vector2' where
+  sizeOf _ = 8
+  alignment _ = 4
+  peek _p = do
+    x <- realToFrac <$> peek (p'vector2'x _p)
+    y <- realToFrac <$> peek (p'vector2'y _p)
+    return $ Vector2' x y
+  poke _p (Vector2' x y) = do
+    poke (p'vector2'x _p) (realToFrac x)
+    poke (p'vector2'y _p) (realToFrac y)
+    return ()
+type Vector2 = Vector2'
+
+pattern Vector2
+  { vector2'x ,
+    vector2'y
+  } = Vector2' vector2'x vector2'y
+{-# COMPLETE Vector2 :: Vector2' #-}
+
+data Vector3' = Vector3' Float Float Float deriving (Eq, Show, Freeable)
+
+instance Storable Vector3' where
+  sizeOf _ = 12
+  alignment _ = 4
+  peek _p = do
+    x <- realToFrac <$> peek (p'vector3'x _p)
+    y <- realToFrac <$> peek (p'vector3'y _p)
+    z <- realToFrac <$> peek (p'vector3'z _p)
+    return $ Vector3' x y z
+  poke _p (Vector3' x y z) = do
+    poke (p'vector3'x _p) (realToFrac x)
+    poke (p'vector3'y _p) (realToFrac y)
+    poke (p'vector3'z _p) (realToFrac z)
+    return ()
+
+type Vector3 = Vector3'
+
+pattern Vector3
+  { vector3'x ,
+    vector3'y ,
+    vector3'z
+  } = Vector3' vector3'x vector3'y vector3'z
+{-# COMPLETE Vector3 :: Vector3' #-}
+
+data Vector4' = Vector4' Float Float Float Float deriving (Eq, Show, Freeable)
+
+instance Storable Vector4' where
+  sizeOf _ = 16
+  alignment _ = 4
+  peek _p = do
+    x <- realToFrac <$> peek (p'vector4'x _p)
+    y <- realToFrac <$> peek (p'vector4'y _p)
+    z <- realToFrac <$> peek (p'vector4'z _p)
+    w <- realToFrac <$> peek (p'vector4'w _p)
+    return $ Vector4' x y z w
+  poke _p (Vector4' x y z w) = do
+    poke (p'vector4'x _p) (realToFrac x)
+    poke (p'vector4'y _p) (realToFrac y)
+    poke (p'vector4'z _p) (realToFrac z)
+    poke (p'vector4'w _p) (realToFrac w)
+    return ()
+
+type Vector4 = Vector4'
+
+pattern Vector4
+  { vector4'x,
+    vector4'y,
+    vector4'z,
+    vector4'w
+  } = Vector4' vector4'x vector4'y vector4'z vector4'w
+{-# COMPLETE Vector4 :: Vector4' #-}
+
+#else
 
 type Vector2 = V2 Float
 
-pattern Vector2 :: Float -> Float -> Vector2
 pattern Vector2
   { vector2'x ,
     vector2'y
   } = V2 vector2'x vector2'y
 {-# COMPLETE Vector2 :: V2 #-}
 
-p'vector2'x :: Ptr Vector2 -> Ptr CFloat
-p'vector2'x = (`plusPtr` 0)
-
-p'vector2'y :: Ptr Vector2 -> Ptr CFloat
-p'vector2'y = (`plusPtr` 4)
-
 type Vector3 = V3 Float
 
-pattern Vector3 :: Float -> Float -> Float -> Vector3
 pattern Vector3
   { vector3'x ,
     vector3'y ,
     vector3'z
   } = V3 vector3'x vector3'y vector3'z
 {-# COMPLETE Vector3 :: V3 #-}
 
-p'vector3'x :: Ptr Vector3 -> Ptr CFloat
-p'vector3'x = (`plusPtr` 0)
-
-p'vector3'y :: Ptr Vector3 -> Ptr CFloat
-p'vector3'y = (`plusPtr` 4)
-
-p'vector3'z :: Ptr Vector3 -> Ptr CFloat
-p'vector3'z = (`plusPtr` 8)
-
 type Vector4 = V4 Float
 
-pattern Vector4 :: a -> a -> a -> a -> V4 a
 pattern Vector4
   { vector4'x,
     vector4'y,
@@ -705,6 +773,23 @@ pattern Vector4
   } = V4 vector4'x vector4'y vector4'z vector4'w
 {-# COMPLETE Vector4 :: V4 #-}
 
+#endif
+
+p'vector2'x :: Ptr Vector2 -> Ptr CFloat
+p'vector2'x = (`plusPtr` 0)
+
+p'vector2'y :: Ptr Vector2 -> Ptr CFloat
+p'vector2'y = (`plusPtr` 4)
+
+p'vector3'x :: Ptr Vector3 -> Ptr CFloat
+p'vector3'x = (`plusPtr` 0)
+
+p'vector3'y :: Ptr Vector3 -> Ptr CFloat
+p'vector3'y = (`plusPtr` 4)
+
+p'vector3'z :: Ptr Vector3 -> Ptr CFloat
+p'vector3'z = (`plusPtr` 8)
+
 vectorToColor :: Vector4 -> Color
 vectorToColor (Vector4 x y z w) = Color (round $ x * 255) (round $ y * 255) (round $ z * 255) (round $ w * 255)
 
diff --git a/src/Raylib/Util.hs b/src/Raylib/Util.hs
@@ -35,7 +35,6 @@ module Raylib.Util
 where
 
 import Control.Monad (void)
-import Control.Monad.Catch (MonadMask, bracket, bracket_)
 import Control.Monad.IO.Class (MonadIO (liftIO))
 import Raylib.Core (beginBlendMode, beginDrawing, beginMode2D, beginMode3D, beginScissorMode, beginShaderMode, beginTextureMode, beginVrStereoMode, closeWindow, endBlendMode, endDrawing, endMode2D, endMode3D, endScissorMode, endShaderMode, endTextureMode, endVrStereoMode, initWindow, setTargetFPS, windowShouldClose)
 import Raylib.Internal (WindowResources, Closeable (..), managed)
@@ -52,6 +51,7 @@ import Raylib.Types
     VrStereoConfig,
   )
 import Raylib.Util.Math (Vector (vectorNormalize, (|-|)))
+import Control.Exception (bracket, bracket_)
 
 #ifdef WEB_FFI
 
@@ -66,10 +66,11 @@ import Language.Haskell.TH.Syntax (Name (Name), OccName (OccName))
 
 #endif
 
+
+
 -- | NOTE: Only for native targets. If your program is intended to
 --         run on the web, use `raylibApplication` instead.
 withWindow ::
-  (MonadIO m, MonadMask m) =>
   -- | Window width
   Int ->
   -- | Window height
@@ -78,32 +79,32 @@ withWindow ::
   String ->
   -- | Target FPS
   Int ->
-  (WindowResources -> m b) ->
-  m b
+  (WindowResources -> IO b) ->
+  IO b
 withWindow w h title fps = bracket (liftIO $ initWindow w h title <* setTargetFPS fps) (liftIO . closeWindow . Just)
 
-drawing :: (MonadIO m, MonadMask m) => m b -> m b
+drawing :: IO b -> IO b
 drawing = bracket_ (liftIO beginDrawing) (liftIO endDrawing)
 
-mode2D :: (MonadIO m, MonadMask m) => Camera2D -> m b -> m b
+mode2D :: Camera2D -> IO b -> IO b
 mode2D camera = bracket_ (liftIO (beginMode2D camera)) (liftIO endMode2D)
 
-mode3D :: (MonadIO m, MonadMask m) => Camera3D -> m b -> m b
+mode3D :: Camera3D -> IO b -> IO b
 mode3D camera = bracket_ (liftIO (beginMode3D camera)) (liftIO endMode3D)
 
-textureMode :: (MonadIO m, MonadMask m) => RenderTexture -> m b -> m b
+textureMode :: RenderTexture -> IO b -> IO b
 textureMode rt = bracket_ (liftIO (beginTextureMode rt)) (liftIO endTextureMode)
 
-shaderMode :: (MonadIO m, MonadMask m) => Shader -> m b -> m b
+shaderMode :: Shader -> IO b -> IO b
 shaderMode shader = bracket_ (liftIO (beginShaderMode shader)) (liftIO endShaderMode)
 
-blendMode :: (MonadIO m, MonadMask m) => BlendMode -> m b -> m b
+blendMode :: BlendMode -> IO b -> IO b
 blendMode bm = bracket_ (liftIO (beginBlendMode bm)) (liftIO endBlendMode)
 
-scissorMode :: (MonadIO m, MonadMask m) => Int -> Int -> Int -> Int -> m b -> m b
+scissorMode :: Int -> Int -> Int -> Int -> IO b -> IO b
 scissorMode x y width height = bracket_ (liftIO (beginScissorMode x y width height)) (liftIO endScissorMode)
 
-vrStereoMode :: (MonadIO m, MonadMask m) => VrStereoConfig -> m b -> m b
+vrStereoMode :: VrStereoConfig -> IO b -> IO b
 vrStereoMode config = bracket_ (liftIO (beginVrStereoMode config)) (liftIO endVrStereoMode)
 
 -- | Gets the direction of a camera as a ray.
