haskell-gi 0.22.4 → 0.22.5

raw patch · 4 files changed

+107/−33 lines, 4 filesdep −semigroupsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: semigroups

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• haskell-gi.cabal +1/−3
• lib/Data/GI/CodeGen/CabalHooks.hs +92/−21
• lib/Data/GI/CodeGen/Overrides.hs +10/−9

@@ -1,3 +1,7 @@+### 0.22.5+++ Add support for inheriting overloading info.+ ### 0.22.4  + Do not generate bindings for struct/union fields pointing to private/class structs, which we do not bind.

@@ -1,5 +1,5 @@ name:                haskell-gi-version:             0.22.4+version:             0.22.5 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.@@ -42,8 +42,6 @@                        xml-conduit >= 1.3.0,                        regex-tdfa >= 1.2,                        text >= 1.0--  build-depends: semigroups == 0.18.*    extensions:          CPP, ForeignFunctionInterface, DoAndIfThenElse, LambdaCase, RankNTypes, OverloadedStrings   ghc-options:         -Wall -fwarn-incomplete-patterns -fno-warn-name-shadowing

@@ -2,7 +2,9 @@ -- bindings. module Data.GI.CodeGen.CabalHooks     ( setupHaskellGIBinding+    , setupBinding     , configureDryRun+    , TaggedOverride(..)     ) where  import qualified Distribution.ModuleName as MN@@ -14,40 +16,55 @@  import Data.GI.CodeGen.API (loadGIRInfo) import Data.GI.CodeGen.Code (genCode, writeModuleTree, listModuleTree,-                             ModuleInfo)+                             ModuleInfo, transitiveModuleDeps) import Data.GI.CodeGen.CodeGen (genModule) import Data.GI.CodeGen.Config (Config(..)) import Data.GI.CodeGen.LibGIRepository (setupTypelibSearchPath) import Data.GI.CodeGen.ModulePath (toModulePath)-import Data.GI.CodeGen.Overrides (parseOverridesFile, girFixups,+import Data.GI.CodeGen.Overrides (parseOverrides, girFixups,                                   filterAPIsAndDeps)+import Data.GI.CodeGen.Util (utf8ReadFile, utf8WriteFile, ucFirst) -import Control.Monad (void)+import System.Directory (createDirectoryIfMissing)+import System.FilePath (joinPath, takeDirectory) -import Data.Maybe (fromJust)+import Control.Monad (void, forM)++import Data.Maybe (fromJust, fromMaybe) import qualified Data.Map as M+import Data.Monoid ((<>))+import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T  type ConfHook = (GenericPackageDescription, HookedBuildInfo) -> ConfigFlags               -> IO LocalBuildInfo +-- | Included overrides file.+data TaggedOverride =+  TaggedOverride { overrideTag   :: Text+                   -- ^ Tag for the override, for error reporting purposes.+                 , overrideText  :: Text+                 }+ -- | Generate the code for the given module. genModuleCode :: Text -- ^ name               -> Text -- ^ version               -> Bool -- ^ verbose-              -> Maybe FilePath -- ^ overrides file+              -> [TaggedOverride] -- ^ Explicit overrides               -> IO ModuleInfo genModuleCode name version verbosity overrides = do   setupTypelibSearchPath [] -  ovs <- case overrides of-    Nothing -> return mempty-    Just fname -> parseOverridesFile fname >>= \case-         Left err -> error $ "Error when parsing overrides file: "-                     ++ T.unpack err-         Right ovs -> return ovs+  parsed <- forM overrides $ \(TaggedOverride tag ovText) -> do+    parseOverrides ovText >>= \case+      Left err -> error $ "Error when parsing overrides file \""+                  <> T.unpack tag <> "\":"+                  <> T.unpack err+      Right ovs -> return ovs +  let ovs = mconcat parsed+   (gir, girDeps) <- loadGIRInfo verbosity name (Just version) [] (girFixups ovs)   let (apis, deps) = filterAPIsAndDeps ovs gir girDeps       allAPIs = M.union apis deps@@ -57,20 +74,55 @@    return $ genCode cfg allAPIs (toModulePath name) (genModule apis) +-- | Write a module containing information about the configuration for+-- the package.+genConfigModule :: Maybe FilePath -> Text -> Maybe TaggedOverride -> IO ()+genConfigModule outputDir modName maybeGiven = do+  let fname = joinPath [ fromMaybe "" outputDir+                       , "GI"+                       , T.unpack (ucFirst modName)+                       , "Config.hs" ]+      dirname = takeDirectory fname++  createDirectoryIfMissing True dirname++  utf8WriteFile fname $ T.unlines+    [ "{-# LANGUAGE OverloadedStrings #-}"+    , "module GI." <> ucFirst modName <> ".Config ( overrides ) where"+    , ""+    , "import qualified Data.Text as T"+    , "import Data.Text (Text)"+    , ""+    , "overrides :: Text"+    , "overrides = T.unlines"+    , " [ " <> T.intercalate "\n , " (quoteOverrides maybeGiven) <> "]"+    ]++  where quoteOverrides :: Maybe TaggedOverride -> [Text]+        quoteOverrides Nothing = []+        quoteOverrides (Just (TaggedOverride _ ovText)) =+          map (T.pack . show) (T.lines ovText)+ -- | A convenience helper for `confHook`, such that bindings for the -- given module are generated in the @configure@ step of @cabal@. confCodeGenHook :: Text -- ^ name                 -> Text -- ^ version                 -> Bool -- ^ verbose                 -> Maybe FilePath -- ^ overrides file+                -> [TaggedOverride] -- ^ other overrides                 -> Maybe FilePath -- ^ output dir                 -> ConfHook -- ^ previous `confHook`                 -> ConfHook-confCodeGenHook name version verbosity overrides outputDir+confCodeGenHook name version verbosity overridesFile inheritedOverrides outputDir                 defaultConfHook (gpd, hbi) flags = do-  m <- genModuleCode name version verbosity overrides -  let em' = map (MN.fromString . T.unpack) (listModuleTree m)+  givenOvs <- traverse (\fname -> TaggedOverride (T.pack fname) <$> utf8ReadFile fname) overridesFile++  let ovs = maybe inheritedOverrides (:inheritedOverrides) givenOvs+  m <- genModuleCode name version verbosity ovs++  let buildInfo = MN.fromString . T.unpack $ "GI." <> ucFirst name <> ".Config"+      em' = buildInfo : map (MN.fromString . T.unpack) (listModuleTree m)       lib = ((condTreeData . fromJust . condLibrary) gpd)       bi = libBuildInfo lib #if MIN_VERSION_base(4,11,0)@@ -84,6 +136,8 @@    void $ writeModuleTree verbosity outputDir m +  genConfigModule outputDir name givenOvs+   lbi <- defaultConfHook (gpd', hbi) flags    return (lbi {withOptimization = NoOptimisation})@@ -96,18 +150,35 @@                       -> Maybe FilePath -- ^ output dir                       -> IO () setupHaskellGIBinding name version verbose overridesFile outputDir =+  setupBinding name version verbose overridesFile [] outputDir++-- | The entry point for @Setup.hs@ files in bindings.+setupBinding :: Text -- ^ name+             -> Text -- ^ version+             -> Bool -- ^ verbose+             -> Maybe FilePath -- ^ overrides file+             -> [TaggedOverride] -- ^ Explicit overrides+             -> Maybe FilePath -- ^ output dir+             -> IO ()+setupBinding name version verbose overridesFile overrides outputDir =     defaultMainWithHooks (simpleUserHooks {                             confHook = confCodeGenHook name version verbose-                                       overridesFile outputDir+                                       overridesFile overrides outputDir                                        (confHook simpleUserHooks)                           }) --- | Return the list of modules that `setupHaskellGIBinding` would create.+-- | Return the list of modules that `setupHaskellGIBinding` would+-- create, together with the set of dependencies loaded while+-- generating the code. configureDryRun :: Text -- ^ name                 -> Text -- ^ version-                -> Maybe FilePath-                -> IO [Text]-configureDryRun name version overrides = do-  m <- genModuleCode name version False overrides+                -> Maybe FilePath -- ^ Overrides file+                -> [TaggedOverride] -- ^ Other overrides to load+                -> IO ([Text], S.Set Text)+configureDryRun name version overridesFile inheritedOverrides = do+  givenOvs <- traverse (\fname -> TaggedOverride (T.pack fname) <$> utf8ReadFile fname) overridesFile -  return (listModuleTree m)+  let ovs = maybe inheritedOverrides (:inheritedOverrides) givenOvs+  m <- genModuleCode name version False ovs++  return (listModuleTree m, transitiveModuleDeps m)

@@ -2,7 +2,7 @@ module Data.GI.CodeGen.Overrides     ( Overrides(pkgConfigMap, cabalPkgVersion, nsChooseVersion, girFixups,                 onlineDocsMap)-    , parseOverridesFile+    , parseOverrides     , filterAPIsAndDeps     ) where @@ -132,12 +132,11 @@ -- encode this in a monad. type Parser a = WriterT Overrides (StateT ParserState (ExceptT Text IO)) a --- | Parse the given overrides file, filling in the configuration as+-- | Parse the given overrides, filling in the configuration as -- needed. In case the parsing fails we return a description of the -- error instead.-parseOverridesFile :: FilePath -> IO (Either Text Overrides)-parseOverridesFile fname = do-  overrides <- utf8ReadFile fname+parseOverrides :: Text -> IO (Either Text Overrides)+parseOverrides overrides = do   runExceptT $ flip evalStateT emptyParserState $ execWriterT $     mapM (parseOneLine . T.strip) (T.lines overrides) @@ -394,10 +393,12 @@  -- | Parse the given overrides file, and merge into the given context. parseInclude :: Text -> Parser ()-parseInclude fname = liftIO (parseOverridesFile $ T.unpack fname) >>= \case-  Left err -> throwError ("Error when parsing included '"-                         <> fname <> "': " <> err)-  Right ovs -> tell ovs+parseInclude fname = do+  includeText <- liftIO $ utf8ReadFile (T.unpack fname)+  liftIO (parseOverrides includeText) >>= \case+    Left err -> throwError ("Error when parsing included '"+                            <> fname <> "': " <> err)+    Right ovs -> tell ovs  -- | Filter a set of named objects based on a lookup list of names to -- ignore.