haskell-gi 0.26.8 → 0.26.9

raw patch · 6 files changed

+161/−36 lines, 6 filesdep ~haskell-gi-basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: haskell-gi-base

API changes (from Hackage documentation)

Files

• haskell-gi.cabal +2/−2
• lib/Data/GI/CodeGen/Code.hs +61/−11
• lib/Data/GI/CodeGen/Constant.hs +11/−0
• lib/Data/GI/CodeGen/Conversions.hsc +62/−2
• lib/Data/GI/GIR/BasicTypes.hs +11/−0
• lib/Data/GI/GIR/Type.hs +14/−21

@@ -1,5 +1,5 @@ name:                haskell-gi-version:             0.26.8+version:             0.26.9 synopsis:            Generate Haskell bindings for GObject Introspection capable libraries description:         Generate Haskell bindings for GObject Introspection capable libraries. This includes most notably                      Gtk+, but many other libraries in the GObject ecosystem provide introspection data too.@@ -31,7 +31,7 @@   default-language:    Haskell2010   pkgconfig-depends:   gobject-introspection-1.0 >= 1.32, gobject-2.0 >= 2.32   build-depends:       base >= 4.11 && < 5,-                       haskell-gi-base >= 0.26.4 && <0.27,+                       haskell-gi-base >= 0.26.5 && <0.27,                        Cabal >= 1.24,                        attoparsec >= 0.13,                        containers,

@@ -78,7 +78,7 @@ import Control.Monad.State.Strict import Control.Monad.Except import qualified Data.Foldable as F-import Data.Maybe (fromMaybe, catMaybes)+import Data.Maybe (fromMaybe, catMaybes, mapMaybe) #if !MIN_VERSION_base(4,13,0) import Data.Monoid ((<>), mempty) #endif@@ -922,7 +922,6 @@ -- this prefix will be imported as {-# SOURCE #-}, and otherwise will -- be imported normally. importDeps :: ModulePath -> [ModulePath] -> Text-importDeps _ [] = "" importDeps (ModulePath prefix) deps = T.unlines . map toImport $ deps     where toImport :: ModulePath -> Text           toImport dep = let impSt = if importSource dep@@ -963,7 +962,11 @@                 , "import qualified Data.Map as Map"                 , "import qualified Foreign.Ptr as FP"                 , "import qualified GHC.OverloadedLabels as OL"-                , "import qualified GHC.Records as R" ]+                , "import qualified GHC.Records as R"+                , "import qualified Data.Word as DW"+                , "import qualified Data.Int as DI"+                , "import qualified System.Posix.Types as SPT"+                , "import qualified Foreign.C.Types as FCT"]  -- | Like `dotModulePath`, but add a "GI." prefix. dotWithPrefix :: ModulePath -> Text@@ -972,8 +975,9 @@ -- | Write to disk the code for a module, under the given base -- directory. Does not write submodules recursively, for that use -- `writeModuleTree`.-writeModuleInfo :: Bool -> Maybe FilePath -> ModuleInfo -> IO ()-writeModuleInfo verbose dirPrefix minfo = do+writeModuleInfo :: Bool -> Maybe FilePath -> ModuleInfo ->+                   M.Map ModulePath ModuleInfo -> IO ()+writeModuleInfo verbose dirPrefix minfo treeMap = do   let submodulePaths = map (modulePath) (M.elems (submodules minfo))       -- We reexport any submodules.       submoduleExports = map dotWithPrefix submodulePaths@@ -990,7 +994,18 @@                 then ""                 else moduleImports       pkgRoot = ModulePath (take 1 (modulePathToList $ modulePath minfo))-      deps = importDeps pkgRoot (Set.toList $ qualifiedImports minfo)+      allImports = transitiveImports minfo treeMap+      minimalImports = qualifiedImports minfo+      allDeps = importDeps pkgRoot (Set.toList allImports)+      minimalDeps = importDeps pkgRoot (Set.toList minimalImports)+      deps = T.unlines [+        "-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392",+        "#if MIN_VERSION_base(4,18,0)",+        allDeps,+        "#else",+        minimalDeps,+        "#endif"+        ]       haddock = moduleHaddock (M.lookup ToplevelSection (sectionDocs minfo))    when verbose $ putStrLn ((T.unpack . dotWithPrefix . modulePath) minfo@@ -1002,6 +1017,33 @@     let bootFName = modulePathToFilePath dirPrefix (modulePath minfo) ".hs-boot"     utf8WriteFile bootFName (genHsBoot minfo) +-- | Collect the transitive set of imports for this module. In+-- principle just importing the set of strictly necessary imports (via+-- qualifiedImports) should be sufficient; the following is a+-- workaround for a GHC bug:+-- https://gitlab.haskell.org/ghc/ghc/-/issues/23392+transitiveImports :: ModuleInfo -> M.Map ModulePath ModuleInfo+                  -> Set.Set ModulePath+transitiveImports root treeMap = collectImports root Set.empty+  where+    collectImports :: ModuleInfo -> Set.Set ModulePath -> Set.Set ModulePath+    collectImports minfo deps = let+      isCallbacks (ModulePath [_, "Callbacks"]) = True+      isCallbacks _ = False++      -- Deps that we haven't analysed yet.+      unseenDeps = Set.filter (\e -> Set.notMember e deps) (qualifiedImports minfo)+      -- Make sure we don't try to import ourselves+      unrooted = Set.filter (\mp -> mp /= modulePath root) unseenDeps+      unseenModules = mapMaybe (\d -> M.lookup d treeMap) (Set.toList unrooted)+      -- We don't collect implicit deps from the callbacks module,+      -- which is always imported normally (not just the hs-boot)+      notCallbacks = filter (not . isCallbacks . modulePath) unseenModules++      -- Imports in unseenDeps+      depImports = map (\m -> collectImports m (Set.union deps unseenDeps)) notCallbacks+      in Set.unions (unrooted : depImports)+ -- | Generate the .hs-boot file for the given module. genHsBoot :: ModuleInfo -> Text genHsBoot minfo =@@ -1018,11 +1060,19 @@ -- | Write down the code for a module and its submodules to disk under -- the given base directory. It returns the list of written modules. writeModuleTree :: Bool -> Maybe FilePath -> ModuleInfo -> IO [Text]-writeModuleTree verbose dirPrefix minfo = do-  submodulePaths <- concat <$> forM (M.elems (submodules minfo))-                                    (writeModuleTree verbose dirPrefix)-  writeModuleInfo verbose dirPrefix minfo-  return $ (dotWithPrefix (modulePath minfo) : submodulePaths)+writeModuleTree verbose dirPrefix root = doWriteModuleTree root++  where+    doWriteModuleTree :: ModuleInfo -> IO [Text]+    doWriteModuleTree minfo = do+      submodulePaths <- concat <$> forM (M.elems (submodules minfo)) doWriteModuleTree+      writeModuleInfo verbose dirPrefix minfo treeMap+      return $ (dotWithPrefix (modulePath minfo) : submodulePaths)++    treeMap = M.fromList (gatherSubmodules root)+    gatherSubmodules :: ModuleInfo -> [(ModulePath, ModuleInfo)]+    gatherSubmodules minfo = (modulePath minfo, minfo) :+      concatMap gatherSubmodules (M.elems $ submodules minfo)  -- | Return the list of modules `writeModuleTree` would write, without -- actually writing anything to disk.

@@ -106,5 +106,16 @@ showBasicType TGType   gtype   = return $ "GType " <> gtype showBasicType TIntPtr  ptr     = return ptr showBasicType TUIntPtr ptr     = return ptr+showBasicType TShort   s       = return s+showBasicType TUShort  u       = return u+showBasicType TSSize   s       = return s+showBasicType TSize    s       = return s+showBasicType Ttime_t  t       = return t+showBasicType Toff_t   o       = return o+showBasicType Tdev_t   d       = return d+showBasicType Tgid_t   g       = return g+showBasicType Tpid_t   p       = return p+showBasicType Tsocklen_t l     = return l+showBasicType Tuid_t   u       = return u -- We take care of this one separately above showBasicType TPtr    _        = notImplementedError $ "Cannot directly show a pointer"

@@ -777,8 +777,8 @@                                4 -> con0 "Word32"                                n -> error ("Unsupported `guint' length: " ++                                            show n)-haskellBasicType TLong     = con0 "CLong"-haskellBasicType TULong    = con0 "CULong"+haskellBasicType TLong     = con0 "FCT.CLong"+haskellBasicType TULong    = con0 "FCT.CULong" haskellBasicType TInt8     = con0 "Int8" haskellBasicType TUInt8    = con0 "Word8" haskellBasicType TInt16    = con0 "Int16"@@ -795,6 +795,66 @@ haskellBasicType TFileName = con0 "[Char]" haskellBasicType TIntPtr   = con0 "CIntPtr" haskellBasicType TUIntPtr  = con0 "CUIntPtr"+haskellBasicType TShort    = con0 "FCT.CShort"+haskellBasicType TUShort   = con0 "FCT.CUShort"+haskellBasicType TSSize    =+#if defined(HTYPE_SSIZE_T)+    con0 "SPT.CSsize"+#else+    int #{size gsize}+#endif+haskellBasicType TSize = con0 "FCT.CSize"+haskellBasicType Ttime_t = con0 "FCT.CTime"+haskellBasicType Toff_t =+#if defined(HTYPE_OFF_T)+  con0 "SPT.COff"+#else+  -- If the type is not defined there's not much we can do, other than+  -- guessing. The values below are correct on Linux amd64. In+  -- practice it will hopefully not be much of an issue with newer+  -- versions of GHC, since platforms lacking the definition will+  -- (hopefully) also not have the relevant types in the available+  -- APIs. The same remark applies to the types below.+  int 8+#endif+haskellBasicType Tdev_t =+#if defined(HTYPE_DEV_T)+  con0 "SPT.CDev"+#else+  uint 8+#endif+haskellBasicType Tgid_t =+#if defined(HTYPE_GID_T)+  con0 "SPT.CGid"+#else+  uint 4+#endif+haskellBasicType Tpid_t =+#if defined(HTYPE_PID_T)+  con0 "SPT.CPid"+#else+  int 4+#endif+haskellBasicType Tsocklen_t =+#if defined(HTYPE_SOCKLEN_T)+  con0 "SPT.CSocklen"+#else+  uint 4+#endif+haskellBasicType Tuid_t =+#if defined(HTYPE_UID_T)+  con0 "SPT.CUid"+#else+  uint 4+#endif++-- | Return the unsigned int type with the given amount of bytes.+uint :: Int -> TypeRep+uint n = con0 ("DW.Word" <> tshow (n*8))++-- | Return the (signed) int type with the given amount of bytes.+int :: Int -> TypeRep+int n = con0 ("DI.Int" <> tshow (n*8))  -- | This translates GI types to the types used for generated Haskell code. haskellType :: Type -> CodeGen e TypeRep

@@ -46,6 +46,17 @@                | TPtr             -- ^ gpointer                | TIntPtr          -- ^ gintptr                | TUIntPtr         -- ^ guintptr+               | TShort           -- ^ gshort+               | TUShort          -- ^ gushort+               | TSize            -- ^ gsize+               | TSSize           -- ^ gssize+               | Ttime_t          -- ^ time_t+               | Toff_t           -- ^ off_t+               | Tdev_t           -- ^ dev_t+               | Tgid_t           -- ^ gid_t+               | Tpid_t           -- ^ pid_t+               | Tsocklen_t       -- ^ socklen_t+               | Tuid_t           -- ^ uid_t                  deriving (Eq, Show, Ord)  -- | This type represents the types found in GObject Introspection

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards, PatternGuards #-} -- | Parsing type information from GIR files. module Data.GI.GIR.Type@@ -8,15 +9,14 @@     , parseOptionalType     ) where +#include "HsBaseConfig.h"+ import Data.Maybe (catMaybes) #if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>)) #endif import Data.Text (Text) import qualified Data.Text as T-import Foreign.Storable (sizeOf)-import Foreign.C (CShort, CUShort, CSize)-import System.Posix.Types (CSsize)  import Data.GI.GIR.BasicTypes (Type(..), BasicType(..)) import Data.GI.GIR.Parser@@ -47,24 +47,17 @@ nameToBasicType "filename" = Just TFileName nameToBasicType "gintptr"  = Just TIntPtr nameToBasicType "guintptr" = Just TUIntPtr-nameToBasicType "gshort"   = case sizeOf (0 :: CShort) of-                               2 -> Just TInt16-                               4 -> Just TInt32-                               8 -> Just TInt64-                               n -> error $ "Unexpected short size: " ++ show n-nameToBasicType "gushort"  = case sizeOf (0 :: CUShort) of-                               2 -> Just TUInt16-                               4 -> Just TUInt32-                               8 -> Just TUInt64-                               n -> error $ "Unexpected ushort size: " ++ show n-nameToBasicType "gssize"   = case sizeOf (0 :: CSsize) of-                               4 -> Just TInt32-                               8 -> Just TInt64-                               n -> error $ "Unexpected ssize length: " ++ show n-nameToBasicType "gsize"    = case sizeOf (0 :: CSize) of-                               4 -> Just TUInt32-                               8 -> Just TUInt64-                               n -> error $ "Unexpected size length: " ++ show n+nameToBasicType "gshort"   = Just TShort+nameToBasicType "gushort"  = Just TUShort+nameToBasicType "gssize"   = Just TSSize+nameToBasicType "gsize"    = Just TSize+nameToBasicType "time_t"   = Just Ttime_t+nameToBasicType "off_t"    = Just Toff_t+nameToBasicType "dev_t"    = Just Tdev_t+nameToBasicType "gid_t"    = Just Tgid_t+nameToBasicType "pid_t"    = Just Tpid_t+nameToBasicType "socklen_t" = Just Tsocklen_t+nameToBasicType "uid_t"    = Just Tuid_t nameToBasicType _          = Nothing  -- | The different array types.