packages feed

sdl2-image 2.0.0 → 2.1.0.0

raw patch · 11 files changed

+330/−294 lines, 11 filesdep −transformersdep ~basedep ~sdl2setup-changednew-uploader

Dependencies removed: transformers

Dependency ranges changed: base, sdl2

Files

+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Changelog for sdl2-image++## v2.1.0.0++* Compatibility with GHC-9
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2015 Siniša Biđin+Copyright (c) 2015 Siniša Biđin, 2021 Daniel Firth  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the
+ README.md view
@@ -0,0 +1,19 @@+# sdl2-image++[![Hackage](https://img.shields.io/hackage/v/sdl2-image.svg)](https://hackage.haskell.org/package/sdl2-image)+[![GitLab](https://gitlab.homotopic.tech/haskell/sdl2-image/badges/master/pipeline.svg)](https://gitlab.homotopic.tech/haskell/sdl2-image)++Haskell bindings to SDL2_image. Provides both raw and high level bindings.++The+[original SDL2_image documentation](http://www.libsdl.org/projects/SDL_image/docs/SDL_image.html)+can also help, as the bindings are close to a direct mapping.++##### Example++A small example executable is included with the library. It loads and displays+a given image. You can find it in the `example` directory.++```bash+stack exec -- sdl2-image-example+```
− Setup.hs 
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
− example/Example.hs 
@@ -1,59 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE LambdaCase #-}--module Main where--import Control.Concurrent (threadDelay)-import Control.Monad      (forM_)-import Data.Text          (Text)-import Data.Text.IO       (putStrLn)-import Prelude     hiding (putStrLn)-import System.Environment (getArgs)-import System.Exit        (exitFailure)--import qualified SDL-import qualified SDL.Image---- A sequence of example actions to be perfomed and displayed.-examples :: [(Text, SDL.Window -> FilePath -> IO ())]-examples = [--  ("Loading as surface, blitting",-    \window path -> do-      image <- SDL.Image.load path-      screen <- SDL.getWindowSurface window-      SDL.surfaceBlit image Nothing screen Nothing-      SDL.updateWindowSurface window-      SDL.freeSurface image),--  ("Loading as texture, rendering",-    \window path -> do-       r <- SDL.createRenderer window (-1) SDL.defaultRenderer-       texture <- SDL.Image.loadTexture r path-       SDL.clear r-       SDL.copy r texture Nothing Nothing-       SDL.present r-       SDL.destroyTexture texture)]--main :: IO ()-main = do--  SDL.initialize [SDL.InitVideo]--  getArgs >>= \case--    [] -> do-      putStrLn "Usage: cabal run path/to/image.(png|jpg|...)"-      exitFailure--    (path:_) ->-      -- Run each of the examples within a newly-created window.-      forM_ examples $ \(name, action) -> do-        putStrLn name-        window <- SDL.createWindow name SDL.defaultWindow-        SDL.showWindow window-        action window path-        threadDelay 1000000-        SDL.destroyWindow window--  SDL.quit
+ example/Main.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++import Control.Concurrent (threadDelay)+import Control.Monad (forM_)+import Data.Text (Text)+import Data.Text.IO (putStrLn)+import qualified SDL+import qualified SDL.Image+import System.Environment (getArgs)+import System.Exit (exitFailure)+import Prelude hiding (putStrLn)++-- A sequence of example actions to be perfomed and displayed.+examples :: [(Text, SDL.Window -> FilePath -> IO ())]+examples =+  [ ( "Loading as surface, blitting",+      \window path -> do+        image <- SDL.Image.load path+        screen <- SDL.getWindowSurface window+        _ <- SDL.surfaceBlit image Nothing screen Nothing+        SDL.updateWindowSurface window+        SDL.freeSurface image+    ),+    ( "Loading as texture, rendering",+      \window path -> do+        r <- SDL.createRenderer window (-1) SDL.defaultRenderer+        texture <- SDL.Image.loadTexture r path+        SDL.clear r+        SDL.copy r texture Nothing Nothing+        SDL.present r+        SDL.destroyTexture texture+    )+  ]++main :: IO ()+main = do+  SDL.initialize [SDL.InitVideo]++  getArgs >>= \case+    [] -> do+      putStrLn "Usage: cabal run path/to/image.(png|jpg|...)"+      exitFailure+    (path : _) ->+      -- Run each of the examples within a newly-created window.+      forM_ examples $ \(name, action) -> do+        putStrLn name+        window <- SDL.createWindow name SDL.defaultWindow+        SDL.showWindow window+        action window path+        threadDelay 1000000+        SDL.destroyWindow window++  SDL.quit
sdl2-image.cabal view
@@ -1,64 +1,72 @@-name:          sdl2-image-version:       2.0.0-synopsis:      Bindings to SDL2_image.-description:   Haskell bindings to SDL2_image.-license:       MIT-license-file:  LICENSE-author:        Cai Lei <cailei@live.com>, Siniša Biđin <sinisa@bidin.eu>-maintainer:    Siniša Biđin <sinisa@bidin.eu>-copyright:     Copyright © 2014 Cai Lei, Copyright © 2015 Siniša Biđin-category:      Image, Graphics, Foreign-build-type:    Simple-cabal-version: >=1.10+cabal-version: 1.12 +-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           sdl2-image+version:        2.1.0.0+synopsis:       Haskell bindings to SDL2_image+category:       Graphics, Foreign, Image+bug-reports:    https://gitlab.homotopic.tech/haskell/sdl2-image/issues+author:         Cai Lei,+                Siniša Biđin,+                Daniel Firth+maintainer:     Siniša Biđin <sinisa@bidin.eu>,+                Daniel Firth <dan.firth@homotopic.tech>+copyright:      2014 Cal Lei,+                2015 Siniša Biđin,+                2021 Daniel Firth+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md+ source-repository head-  type:     git-  location: https://github.com/sbidin/sdl2-image.git+  type: git+  location: https://gitlab.homotopic.tech/haskell/sdl2-image  library-  ghc-options: -Wall-   exposed-modules:-    SDL.Image,-    SDL.Raw.Image-+      SDL.Image+      SDL.Raw.Helper+      SDL.Raw.Image   other-modules:-    SDL.ExceptionHelper,-    SDL.Raw.Helper-+      Paths_sdl2_image   hs-source-dirs:-    src-+      src+  ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-missing-import-lists -Wno-safe -Wno-unsafe+  extra-libraries:+      SDL2_image   pkgconfig-depends:-    sdl2 >= 2.0.3,-    SDL2_image >= 2.0.0-+      sdl2 >= 2.0.3+    , SDL2_image >= 1.0.1   build-depends:-    base             >= 4.7 && < 5,-    bytestring       >= 0.10.4.0,-    sdl2             >= 2.0,-    text             >= 1.1.0.0,-    template-haskell,-    transformers     >= 0.2--  default-language:-    Haskell2010--flag example-  description: Build the example executable-  default:     True+      base >=4.9 && <5+    , bytestring >=0.10.4.0+    , sdl2 >=2.0.0+    , template-haskell >=2.10+    , text >=1.1.0.0+  default-language: Haskell2010+  autogen-modules: Paths_sdl2_image  executable sdl2-image-example-  ghc-options: -Wall-  hs-source-dirs: example-  main-is: Example.hs+  main-is: Main.hs+  other-modules:+      Paths_sdl2_image+  hs-source-dirs:+      example+  ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-missing-import-lists -Wno-safe -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N+  extra-libraries:+      SDL2_image+  pkgconfig-depends:+      sdl2 >= 2.0.3+    , SDL2_image >= 1.0.1+  build-depends:+      base >=4.9 && <5+    , sdl2 >=2.0.0+    , sdl2-image+    , text >=1.1.0.0   default-language: Haskell2010--  if flag(example)-    build-depends:-      base       >= 4.7 && < 5,-      sdl2       >= 2.0,-      sdl2-image,-      text       >= 1.1.0.0-  else-    buildable: False
− src/SDL/ExceptionHelper.hs 
@@ -1,30 +0,0 @@-module SDL.ExceptionHelper where--import Control.Exception       (throwIO)-import Control.Monad           (when)-import Control.Monad.IO.Class  (MonadIO, liftIO)-import Data.ByteString         (packCString)-import Data.Text               (Text)-import Data.Text.Encoding      (decodeUtf8)-import Foreign.Ptr             (Ptr, nullPtr)-import SDL                     (SDLException(SDLCallFailed))-import SDL.Raw                 (getError)--throwIfNeg_ :: (MonadIO m, Num a, Ord a) => Text -> Text -> m a -> m ()-throwIfNeg_ = throwIf_ (< 0)--throwIfNull :: MonadIO m => Text -> Text -> m (Ptr a) -> m (Ptr a)-throwIfNull = throwIf (== nullPtr)--throwIf :: MonadIO m => (a -> Bool) -> Text -> Text -> m a -> m a-throwIf f caller rawf act = do-  result <- act-  liftIO $ when (f result) $ do-    err <- decodeUtf8 <$> (packCString =<< getError)-    throwIO $ SDLCallFailed caller rawf err-  return result--throwIf_ :: MonadIO m => (a -> Bool) -> Text -> Text -> m a -> m ()-throwIf_ f caller rawf act = do-  _ <- throwIf f caller rawf act-  return ()
src/SDL/Image.hs view
@@ -1,86 +1,86 @@-{-|--Module      : SDL.Image-Copyright   : (c) 2015 Siniša Biđin-License     : MIT-Maintainer  : sinisa@bidin.eu-Stability   : experimental--Bindings to the @SDL2_image@ library. These should allow you to load various-types of images as @SDL@ 'Surface's, as well as detect image formats.+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-} -You can safely assume that any monadic function listed here is capable of-throwing an 'SDLException' in case it encounters an error.+-- |+--+-- Module      : SDL.Image+-- Copyright   : (c) 2015 Siniša Biđin, 2021 Daniel Firth+-- License     : MIT+-- Maintainer  : sinisa@bidin.eu, dan.firth@homotopic.tech+-- Stability   : experimental+--+-- Bindings to the @SDL2_image@ library. These should allow you to load various+-- types of images as @SDL@ 'Surface's, as well as detect image formats.+--+-- You can safely assume that any monadic function listed here is capable of+-- throwing an 'SDLException' in case it encounters an error.+module SDL.Image+  ( -- * Loading images --}+    -- -{-# LANGUAGE DeriveGeneric         #-}-{-# LANGUAGE LambdaCase            #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings     #-}+    -- | Use the following functions to read any @PNG@, @JPG@, @TIF@, @GIF@,+    -- @WEBP@, @CUR@, @ICO@, @BMP@, @PNM@, @XPM@, @XCF@, @PCX@ and @XV@ formatted+    -- data.+    --+    -- If you have @TGA@-formatted data, you might wish to use the functions from+    -- the <#tga following section> instead.+    load,+    decode,+    loadTexture,+    decodeTexture, -module SDL.Image-  (+    -- * Loading TGA images -  -- * Loading images-  ---  -- | Use the following functions to read any @PNG@, @JPG@, @TIF@, @GIF@,-  -- @WEBP@, @CUR@, @ICO@, @BMP@, @PNM@, @XPM@, @XCF@, @PCX@ and @XV@ formatted-  -- data.-  ---  -- If you have @TGA@-formatted data, you might wish to use the functions from-  -- the <#tga following section> instead.-    load-  , decode-  , loadTexture-  , decodeTexture+    -- -  -- * Loading TGA images-  ---  -- | #tga# Since @TGA@ images don't contain a specific unique signature, the-  -- following functions might succeed even when given files not formatted as-  -- @TGA@ images.-  ---  -- Only use these functions if you're certain the inputs are @TGA@-formatted,-  -- otherwise they'll throw an exception.-  , loadTGA-  , decodeTGA-  , loadTextureTGA-  , decodeTextureTGA+    -- | #tga# Since @TGA@ images don't contain a specific unique signature, the+    -- following functions might succeed even when given files not formatted as+    -- @TGA@ images.+    --+    -- Only use these functions if you're certain the inputs are @TGA@-formatted,+    -- otherwise they'll throw an exception.+    loadTGA,+    decodeTGA,+    loadTextureTGA,+    decodeTextureTGA, -  -- * Format detection-  , formattedAs-  , format-  , Format(..)+    -- * Format detection+    formattedAs,+    format,+    Format (..), -   -- * Other-  , initialize-  , InitFlag(..)-  , version-  , quit-  ) where+    -- * Other+    initialize,+    InitFlag (..),+    version,+    quit,+  )+where -import Control.Exception      (bracket, throwIO)+import Control.Exception (bracket, throwIO) import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Bits              ((.|.))-import Data.ByteString        (ByteString)+import Data.Bits ((.|.))+import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Data.List              (find)-import Data.Text              (pack)-import Foreign.C.String       (withCString)-import Foreign.C.Types        (CInt)-import Foreign.Ptr            (Ptr, castPtr)-import Foreign.Storable       (peek)-import GHC.Generics           (Generic)-import SDL                    (Renderer, Texture, Surface(..), SDLException(..))-import SDL.ExceptionHelper    (throwIfNull, throwIf_)-import SDL.Raw.Filesystem     (rwFromFile, rwFromConstMem)-import SDL.Raw.Types          (RWops)-import System.IO.Unsafe       (unsafePerformIO)-+import Data.List (find)+import Data.Text (pack)+import Foreign.C.String (withCString)+import Foreign.C.Types (CInt)+import Foreign.Ptr (Ptr, castPtr)+import Foreign.Storable (peek)+import GHC.Generics (Generic)+import SDL (Renderer, SDLException (..), Surface (..), Texture) import qualified SDL+import SDL.Internal.Exception (throwIfNull, throwIf_) import qualified SDL.Raw+import SDL.Raw.Filesystem (rwFromConstMem, rwFromFile) import qualified SDL.Raw.Image+import SDL.Raw.Types (RWops)+import System.IO.Unsafe (unsafePerformIO)  -- | Initializes @SDL2_image@ by loading support for the chosen image formats. -- Explicit initialization is optional.@@ -104,18 +104,22 @@ -- -- Each designates early loading of support for a particular image format. data InitFlag-  = InitJPG  -- ^ Load support for reading @JPG@ files.-  | InitPNG  -- ^ Same, but for @PNG@ files.-  | InitTIF  -- ^ @TIF@ files.-  | InitWEBP -- ^ @WEBP@ files.-  deriving (Eq, Enum, Ord, Bounded, Generic, Read, Show)+  = -- | Load support for reading @JPG@ files.+    InitJPG+  | -- | Same, but for @PNG@ files.+    InitPNG+  | -- | @TIF@ files.+    InitTIF+  | -- | @WEBP@ files.+    InitWEBP+  deriving stock (Eq, Enum, Ord, Bounded, Generic, Read, Show)  flagToCInt :: InitFlag -> CInt flagToCInt =   \case-    InitJPG  -> SDL.Raw.Image.IMG_INIT_JPG-    InitPNG  -> SDL.Raw.Image.IMG_INIT_PNG-    InitTIF  -> SDL.Raw.Image.IMG_INIT_TIF+    InitJPG -> SDL.Raw.Image.IMG_INIT_JPG+    InitPNG -> SDL.Raw.Image.IMG_INIT_PNG+    InitTIF -> SDL.Raw.Image.IMG_INIT_TIF     InitWEBP -> SDL.Raw.Image.IMG_INIT_WEBP  -- | A helper for unmanaged 'Surface's, since it is not exposed by SDL itself.@@ -129,9 +133,10 @@ -- 'loadTGA' instead. load :: MonadIO m => FilePath -> m Surface load path =-  fmap unmanaged .-    throwIfNull "SDL.Image.load" "IMG_Load" .-      liftIO $ withCString path SDL.Raw.Image.load+  fmap unmanaged+    . throwIfNull "SDL.Image.load" "IMG_Load"+    . liftIO+    $ withCString path SDL.Raw.Image.load  -- | Same as 'load', but returning a 'Texture' instead. --@@ -146,12 +151,13 @@ -- This will work for all supported image types, __except TGA__. If you need to -- decode a @TGA@ 'ByteString', use 'decodeTGA' instead. decode :: MonadIO m => ByteString -> m Surface-decode bytes = liftIO .-  unsafeUseAsCStringLen bytes $ \(cstr, len) -> do+decode bytes = liftIO+  . unsafeUseAsCStringLen bytes+  $ \(cstr, len) -> do     rw <- rwFromConstMem (castPtr cstr) (fromIntegral len)-    fmap unmanaged .-      throwIfNull "SDL.Image.decode" "IMG_Load_RW" $-        SDL.Raw.Image.load_RW rw 0+    fmap unmanaged+      . throwIfNull "SDL.Image.decode" "IMG_Load_RW"+      $ SDL.Raw.Image.load_RW rw 0  -- | Same as 'decode', but returning a 'Texture' instead. --@@ -165,11 +171,12 @@ -- load them using this function. loadTGA :: MonadIO m => FilePath -> m Surface loadTGA path =-  fmap unmanaged .-    throwIfNull "SDL.Image.loadTGA" "IMG_LoadTGA_RW" .-      liftIO $ do-        rw <- withCString "rb" $ withCString path . flip rwFromFile-        SDL.Raw.Image.loadTGA_RW rw+  fmap unmanaged+    . throwIfNull "SDL.Image.loadTGA" "IMG_LoadTGA_RW"+    . liftIO+    $ do+      rw <- withCString "rb" $ withCString path . flip rwFromFile+      SDL.Raw.Image.loadTGA_RW rw  -- | Same as 'loadTGA', only returning a 'Texture' instead. loadTextureTGA :: MonadIO m => Renderer -> FilePath -> m Texture@@ -181,12 +188,13 @@ -- -- Assumes the input is a @TGA@-formatted image. decodeTGA :: MonadIO m => ByteString -> m Surface-decodeTGA bytes = liftIO .-  unsafeUseAsCStringLen bytes $ \(cstr, len) -> do+decodeTGA bytes = liftIO+  . unsafeUseAsCStringLen bytes+  $ \(cstr, len) -> do     rw <- rwFromConstMem (castPtr cstr) (fromIntegral len)-    fmap unmanaged .-      throwIfNull "SDL.Image.decodeTGA" "IMG_LoadTGA_RW" $-        SDL.Raw.Image.loadTGA_RW rw+    fmap unmanaged+      . throwIfNull "SDL.Image.decodeTGA" "IMG_LoadTGA_RW"+      $ SDL.Raw.Image.loadTGA_RW rw  -- | Same as 'decodeTGA', but returns a 'Texture' instead. decodeTextureTGA :: MonadIO m => Renderer -> ByteString -> m Texture@@ -196,8 +204,9 @@  -- | Tests whether a 'ByteString' contains an image of a given format. formattedAs :: Format -> ByteString -> Bool-formattedAs f bytes = unsafePerformIO .-  unsafeUseAsCStringLen bytes $ \(cstr, len) -> do+formattedAs f bytes = unsafePerformIO+  . unsafeUseAsCStringLen bytes+  $ \(cstr, len) -> do     rw <- rwFromConstMem (castPtr cstr) (fromIntegral len)     formatPredicate f rw >>= \case       1 -> return True@@ -215,7 +224,7 @@ format :: ByteString -> Maybe Format format bytes = fst <$> find snd attempts   where-    attempts = map (\f -> (f, formattedAs f bytes)) [minBound..]+    attempts = map (\f -> (f, formattedAs f bytes)) [minBound ..]  -- | Each of the supported image formats. data Format@@ -233,24 +242,24 @@   | PNG   | TIF   | WEBP-  deriving (Eq, Enum, Ord, Bounded, Generic, Read, Show)+  deriving stock (Eq, Enum, Ord, Bounded, Generic, Read, Show)  -- Given an image format, return its raw predicate function. formatPredicate :: MonadIO m => Format -> Ptr RWops -> m CInt formatPredicate = \case-  CUR  -> SDL.Raw.Image.isCUR-  ICO  -> SDL.Raw.Image.isICO-  BMP  -> SDL.Raw.Image.isBMP-  PNM  -> SDL.Raw.Image.isPNM-  XPM  -> SDL.Raw.Image.isXPM-  XCF  -> SDL.Raw.Image.isXCF-  PCX  -> SDL.Raw.Image.isPCX-  GIF  -> SDL.Raw.Image.isGIF-  LBM  -> SDL.Raw.Image.isLBM-  XV   -> SDL.Raw.Image.isXV-  JPG  -> SDL.Raw.Image.isJPG-  PNG  -> SDL.Raw.Image.isPNG-  TIF  -> SDL.Raw.Image.isTIF+  CUR -> SDL.Raw.Image.isCUR+  ICO -> SDL.Raw.Image.isICO+  BMP -> SDL.Raw.Image.isBMP+  PNM -> SDL.Raw.Image.isPNM+  XPM -> SDL.Raw.Image.isXPM+  XCF -> SDL.Raw.Image.isXCF+  PCX -> SDL.Raw.Image.isPCX+  GIF -> SDL.Raw.Image.isGIF+  LBM -> SDL.Raw.Image.isLBM+  XV -> SDL.Raw.Image.isXV+  JPG -> SDL.Raw.Image.isJPG+  PNG -> SDL.Raw.Image.isPNG+  TIF -> SDL.Raw.Image.isTIF   WEBP -> SDL.Raw.Image.isWEBP  -- | Gets the major, minor, patch versions of the linked @SDL2_image@ library.
src/SDL/Raw/Helper.hs view
@@ -1,25 +1,45 @@-{-|--Module      : SDL.Raw.Helper-Copyright   : (c) 2015 Siniša Biđin-License     : MIT-Maintainer  : sinisa@bidin.eu-Stability   : experimental--Exposes a way to automatically generate a foreign import alongside its lifted,-inlined MonadIO variant. Use this to simplify the package's SDL.Raw.* modules.---}--{-# LANGUAGE BangPatterns    #-}-{-# LANGUAGE LambdaCase      #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TemplateHaskell #-} +-- |+--+-- Module      : SDL.Raw.Helper+-- Copyright   : (c) 2015 Siniša Biđin, 2021 Daniel Firth+-- License     : MIT+-- Maintainer  : sinisa@bidin.eu, dan.firth@homotopic.tech+-- Stability   : experimental+--+-- Exposes a way to automatically generate a foreign import alongside its lifted,+-- inlined MonadIO variant. Use this to simplify the package's SDL.Raw.* modules. module SDL.Raw.Helper (liftF) where -import Control.Monad           (replicateM)-import Control.Monad.IO.Class  (MonadIO, liftIO)+import Control.Monad (replicateM)+import Control.Monad.IO.Class (MonadIO, liftIO) import Language.Haskell.TH+  ( Body (NormalB),+    Callconv (CCall),+    Clause (Clause),+    Dec (ForeignD, FunD, PragmaD, SigD),+    Exp (AppE, VarE),+    Foreign (ImportF),+    Inline (Inline),+    Name,+    Pat (VarP),+    Phases (AllPhases),+    Pragma (InlineP),+    Q,+    RuleMatch (FunLike),+    Safety (Safe),+    TyVarBndr (PlainTV),+    Type (AppT, ArrowT, ConT, ForallT, SigT, VarT),+    mkName,+    newName,+#if MIN_VERSION_template_haskell(2,17,0)+    Specificity(SpecifiedSpec)+#endif+  )  -- | Given a name @fname@, a name of a C function @cname@ and the desired -- Haskell type @ftype@, this function generates:@@ -29,8 +49,8 @@ liftF :: String -> String -> Q Type -> Q [Dec] liftF fname cname ftype = do   let f' = mkName $ fname ++ "'" -- Direct binding.-  let f  = mkName fname          -- Lifted.-  t' <- ftype                    -- Type of direct binding.+  let f = mkName fname -- Lifted.+  t' <- ftype -- Type of direct binding.    -- The generated function accepts n arguments.   args <- replicateM (countArgs t') $ newName "x"@@ -39,39 +59,42 @@   -- However, this fails to typecheck without an explicit type signature.   -- Therefore, we include one. TODO: Can we get rid of this?   sigd <- case args of-            [] -> ((:[]) . SigD f) `fmap` liftType t'-            _  -> return []+    [] -> ((: []) . SigD f) `fmap` liftType t'+    _ -> return [] -  return $ concat-    [-      [ ForeignD $ ImportF CCall Safe cname f' t'-      , PragmaD $ InlineP f Inline FunLike AllPhases-      ]-    , sigd-    , [ FunD f-        [ Clause-            (map VarP args)-            (NormalB $ 'liftIO `applyTo` [f' `applyTo` map VarE args])-            []+  return $+    concat+      [ [ ForeignD $ ImportF CCall Safe cname f' t',+          PragmaD $ InlineP f Inline FunLike AllPhases+        ],+        sigd,+        [ FunD+            f+            [ Clause+                (map VarP args)+                (NormalB $ 'liftIO `applyTo` [f' `applyTo` map VarE args])+                []+            ]         ]       ]-    ]  -- | How many arguments does a function of a given type take? countArgs :: Type -> Int countArgs = count 0   where+    count :: Num p => p -> Type -> p     count !n = \case-      (AppT (AppT ArrowT _) t) -> count (n+1) t+      (AppT (AppT ArrowT _) t) -> count (n + 1) t       (ForallT _ _ t) -> count n t-      (SigT t _)      -> count n t-      _               -> n+      (SigT t _) -> count n t+      _ -> n  -- | An expression where f is applied to n arguments. applyTo :: Name -> [Exp] -> Exp applyTo f [] = VarE f applyTo f es = loop (tail es) . AppE (VarE f) $ head es   where+    loop :: Foldable t => t Exp -> Exp -> Exp     loop as e = foldl AppE e as  -- | Fuzzily speaking, converts a given IO type into a MonadIO m one.@@ -81,7 +104,12 @@     m <- newName "m"     return $       ForallT+#if MIN_VERSION_template_haskell(2,17,0)+        [PlainTV m SpecifiedSpec]+#else         [PlainTV m]++#endif         [AppT (ConT ''MonadIO) $ VarT m]         (AppT (VarT m) t)   t -> return t
src/SDL/Raw/Image.hsc view
@@ -1,9 +1,9 @@ {-|  Module      : SDL.Raw.Image-Copyright   : (c) 2015 Siniša Biđin+Copyright   : (c) 2015 Siniša Biđin, 2021 Daniel Firth License     : MIT-Maintainer  : sinisa@bidin.eu+Maintainer  : sinisa@bidin.eu, dan.firth@homotopic.tech Stability   : experimental  Raw bindings to the @SDL2_image@ library. No error-handling is done here. For@@ -13,6 +13,10 @@ -}  {-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-missing-exported-signatures #-}+{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}+{-# OPTIONS_GHC -fno-warn-missing-local-signatures #-}+{-# OPTIONS_GHC -fno-warn-missing-pattern-synonym-signatures #-}  {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TemplateHaskell #-}