Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Nest
Overlay
Commits
735a10ff
Commit
735a10ff
authored
Feb 21, 2021
by
James T. Lee
Browse files
haskell: Patch haskell-gi for GHC 9
parent
785dd7a2
Pipeline
#544
passed with stage
in 22 seconds
Changes
3
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
1679 additions
and
0 deletions
+1679
-0
dev-haskell/haskell-gi/Manifest
dev-haskell/haskell-gi/Manifest
+3
-0
dev-haskell/haskell-gi/files/haskell-gi-0.24.7-ghc-9-compatibility.patch
...kell-gi/files/haskell-gi-0.24.7-ghc-9-compatibility.patch
+1629
-0
dev-haskell/haskell-gi/haskell-gi-0.24.7.ebuild
dev-haskell/haskell-gi/haskell-gi-0.24.7.ebuild
+47
-0
No files found.
dev-haskell/haskell-gi/Manifest
0 → 100644
View file @
735a10ff
AUX haskell-gi-0.24.7-ghc-9-compatibility.patch 68521 BLAKE2B 2560c73e77368569dce488e41f6ac3009d34ce3cbe92614118801a78cd576e128a053a368c9ea68cbd3fdd78f19cff7d854e2ff1f87db9ceecaed7ff935272ff SHA512 8bf532f94bac6a5e2405ddc9ee6c8568e59568c9cbc0f463508a12a3dcf25deb1962a8b6e71b5f64c825a62188070b519eeca5817e7c250608f057fcfe239412
DIST haskell-gi-0.24.7.tar.gz 135003 BLAKE2B d596273fc525181d2bb561b60c7292fa7c3320a932a1abef57a327cedea45c83059aeab9f4e301b6b21ce9225cfb96f623592e8c1c8c79e99363ddc4243d98e2 SHA512 0f5a1749f41cac8430dd8e0dc63aa69f248809ddadac88bba5d1db39e7cc8c0e25dde8a3ce6ca3627215bc584c68e8e0b70b32f50e11bb06fdbd504c26c4c61d
EBUILD haskell-gi-0.24.7.ebuild 1357 BLAKE2B 68c5a738b2fe87f11dc45a1a1758910841c61696cfa7b78cc26ca94fe37ec3ccef66777151cd0441a32e4b952b7d5d641fab0e3e7a582c9f94e84982a8ca429f SHA512 f81b391ff83b723e4cb6d4462cb46605df5a64ad11bd3ffe678da236d1b067ef4b51678e24ac8115ecfb8356b7bf19b383a8950307471d29e5ffa760ada274cd
dev-haskell/haskell-gi/files/haskell-gi-0.24.7-ghc-9-compatibility.patch
0 → 100644
View file @
735a10ff
diff -ur haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Cabal.hs haskell-gi-0.24.7/lib/Data/GI/CodeGen/Cabal.hs
--- haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Cabal.hs 2001-09-08 21:46:40.000000000 -0400
+++ haskell-gi-0.24.7/lib/Data/GI/CodeGen/Cabal.hs 2021-02-21 19:01:48.473707937 -0500
@@ -127,7 +127,7 @@
-- | Generate the cabal project.
genCabalProject :: (GIRInfo, PkgInfo) -> [(GIRInfo, PkgInfo)] ->
- [Text] -> BaseVersion -> CodeGen ()
+ [Text] -> BaseVersion -> CodeGen e ()
genCabalProject (gir, PkgInfo {pkgName = pcName, pkgMajor = major,
pkgMinor = minor})
deps exposedModules minBaseVersion = do
diff -ur haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Callable.hs haskell-gi-0.24.7/lib/Data/GI/CodeGen/Callable.hs
--- haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Callable.hs 2001-09-08 21:46:40.000000000 -0400
+++ haskell-gi-0.24.7/lib/Data/GI/CodeGen/Callable.hs 2021-02-21 19:01:48.473707937 -0500
@@ -68,7 +68,7 @@
-- | Generate a foreign import for the given C symbol. Return the name
-- of the corresponding Haskell identifier.
-mkForeignImport :: Text -> Callable -> CodeGen Text
+mkForeignImport :: Text -> Callable -> CodeGen e Text
mkForeignImport cSymbol callable = do
line first
indent $ do
@@ -96,7 +96,7 @@
-- | Make a wrapper for foreign `FunPtr`s of the given type. Return
-- the name of the resulting dynamic Haskell wrapper.
-mkDynamicImport :: Text -> CodeGen Text
+mkDynamicImport :: Text -> CodeGen e Text
mkDynamicImport typeSynonym = do
line $ "foreign import ccall \"dynamic\" " <> dynamic <> " :: FunPtr "
<> typeSynonym <> " -> " <> typeSynonym
@@ -108,7 +108,7 @@
-- sanity checking to make sure that the argument is actually nullable
-- (a relatively common annotation mistake is to mix up (optional)
-- with (nullable)).
-wrapMaybe :: Arg -> CodeGen Bool
+wrapMaybe :: Arg -> CodeGen e Bool
wrapMaybe arg = if mayBeNull arg
then typeIsNullable (argType arg)
else return False
@@ -310,7 +310,7 @@
return maybeName)
-- | Callbacks are a fairly special case, we treat them separately.
-prepareInCallback :: Arg -> Callback -> ExposeClosures -> CodeGen Text
+prepareInCallback :: Arg -> Callback -> ExposeClosures -> CodeGen e Text
prepareInCallback arg callback@(Callback {cbCallable = cb}) expose = do
let name = escapedArgName arg
ptrName = "ptr" <> name
@@ -765,7 +765,7 @@
forM hOutArgs (convertOutArg callable nameMap)
-- | Invoke the given C function, taking care of errors.
-invokeCFunction :: Callable -> ForeignSymbol -> [Text] -> CodeGen ()
+invokeCFunction :: Callable -> ForeignSymbol -> [Text] -> CodeGen e ()
invokeCFunction callable symbol argNames = do
let returnBind = case returnType callable of
Nothing -> ""
@@ -783,7 +783,7 @@
<> call <> (T.concat . map (" " <>)) argNames
-- | Return the result of the call, possibly including out arguments.
-returnResult :: Callable -> Text -> [Text] -> CodeGen ()
+returnResult :: Callable -> Text -> [Text] -> CodeGen e ()
returnResult callable result pps =
if skipRetVal callable || returnType callable == Nothing
then case pps of
@@ -911,7 +911,7 @@
}
-- | Some debug info for the callable.
-genCallableDebugInfo :: Callable -> CodeGen ()
+genCallableDebugInfo :: Callable -> CodeGen e ()
genCallableDebugInfo callable =
group $ do
commentShow "Args" (args callable)
@@ -922,7 +922,7 @@
when (skipReturn callable && returnType callable /= Just (TBasicType TBoolean)) $
do line "-- XXX return value ignored, but it is not a boolean."
line "-- This may be a memory leak?"
- where commentShow :: Show a => Text -> a -> CodeGen ()
+ where commentShow :: Show a => Text -> a -> CodeGen e ()
commentShow prefix s =
let padding = T.replicate (T.length prefix + 2) " "
padded = case T.lines (T.pack $ ppShow s) of
diff -ur haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/CodeGen.hs haskell-gi-0.24.7/lib/Data/GI/CodeGen/CodeGen.hs
--- haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/CodeGen.hs 2001-09-08 21:46:40.000000000 -0400
+++ haskell-gi-0.24.7/lib/Data/GI/CodeGen/CodeGen.hs 2021-02-21 19:04:09.870909564 -0500
@@ -43,7 +43,7 @@
import Data.GI.CodeGen.Type
import Data.GI.CodeGen.Util (tshow)
-genFunction :: Name -> Function -> CodeGen ()
+genFunction :: Name -> Function -> CodeGen e ()
genFunction n (Function symbol fnMovedTo callable) =
-- Only generate the function if it has not been moved.
when (Nothing == fnMovedTo) $
@@ -60,7 +60,7 @@
)
-- | Create the newtype wrapping the ManagedPtr for the given type.
-genNewtype :: Text -> CodeGen ()
+genNewtype :: Text -> CodeGen e ()
genNewtype name' = do
group $ do
bline $ "newtype " <> name' <> " = " <> name' <> " (SP.ManagedPtr " <> name' <> ")"
@@ -71,7 +71,7 @@
indent $ line $ "toManagedPtr (" <> name' <> " p) = p"
-- | Generate wrapper for structures.
-genStruct :: Name -> Struct -> CodeGen ()
+genStruct :: Name -> Struct -> CodeGen e ()
genStruct n s = unless (ignoreStruct n s) $ do
let Name _ name' = normalizedAPIName (APIStruct s) n
@@ -109,7 +109,7 @@
genMethodList n (catMaybes methods)
-- | Generated wrapper for unions.
-genUnion :: Name -> Union -> CodeGen ()
+genUnion :: Name -> Union -> CodeGen e ()
genUnion n u = do
let Name _ name' = normalizedAPIName (APIUnion u) n
@@ -224,7 +224,7 @@
genMethodInfo cn (m {methodCallable = c''})
-- | Generate the GValue instances for the given GObject.
-genGObjectGValueInstance :: Name -> Text -> CodeGen ()
+genGObjectGValueInstance :: Name -> Text -> CodeGen e ()
genGObjectGValueInstance n get_type_fn = do
let name' = upperName n
doc = "Convert '" <> name' <> "' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'."
@@ -244,7 +244,7 @@
line $ "B.ManagedPtr.newObject " <> name' <> " ptr"
-- Type casting with type checking
-genCasts :: Name -> Text -> [Name] -> CodeGen ()
+genCasts :: Name -> Text -> [Name] -> CodeGen e ()
genCasts n ti parents = do
isGO <- isGObject (TInterface n)
let name' = upperName n
@@ -312,7 +312,7 @@
-- | Wrap a given Object. We enforce that every Object that we wrap is a
-- GObject. This is the case for everything except the ParamSpec* set
-- of objects, we deal with these separately.
-genObject :: Name -> Object -> CodeGen ()
+genObject :: Name -> Object -> CodeGen e ()
genObject n o = do
let Name _ name' = normalizedAPIName (APIObject o) n
let t = TInterface n
@@ -362,7 +362,7 @@
genUnsupportedMethodInfo n f)
(genMethod n f)
-genInterface :: Name -> Interface -> CodeGen ()
+genInterface :: Name -> Interface -> CodeGen e ()
genInterface n iface = do
let Name _ name' = normalizedAPIName (APIInterface iface) n
@@ -440,7 +440,7 @@
-- "moved-to" annotation), we don't generate the method.
--
-- It may be more expedient to keep a map of symbol -> function.
-symbolFromFunction :: Text -> CodeGen Bool
+symbolFromFunction :: Text -> CodeGen e Bool
symbolFromFunction sym = do
apis <- getAPIs
return $ any (hasSymbol sym . snd) $ M.toList apis
@@ -450,7 +450,7 @@
sym1 == sym2 && movedTo == Nothing
hasSymbol _ _ = False
-genAPI :: Name -> API -> CodeGen ()
+genAPI :: Name -> API -> CodeGen e ()
genAPI n (APIConst c) = genConstant n c
genAPI n (APIFunction f) = genFunction n f
genAPI n (APIEnum e) = genEnum n e
@@ -462,10 +462,10 @@
genAPI n (APIInterface i) = genInterface n i
-- | Generate the code for a given API in the corresponding module.
-genAPIModule :: Name -> API -> CodeGen ()
+genAPIModule :: Name -> API -> CodeGen e ()
genAPIModule n api = submodule (submoduleLocation n api) $ genAPI n api
-genModule' :: M.Map Name API -> CodeGen ()
+genModule' :: M.Map Name API -> CodeGen e ()
genModule' apis = do
mapM_ (uncurry genAPIModule)
-- We provide these ourselves
@@ -496,7 +496,7 @@
handWritten (Name "GObject" "Closure", _) = True
handWritten _ = False
-genModule :: M.Map Name API -> CodeGen ()
+genModule :: M.Map Name API -> CodeGen e ()
genModule apis = do
-- Reexport Data.GI.Base for convenience (so it does not need to be
-- imported separately).
Only in haskell-gi-0.24.7/lib/Data/GI/CodeGen: CodeGen.hs.rej
diff -ur haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Code.hs haskell-gi-0.24.7/lib/Data/GI/CodeGen/Code.hs
--- haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Code.hs 2001-09-08 21:46:40.000000000 -0400
+++ haskell-gi-0.24.7/lib/Data/GI/CodeGen/Code.hs 2021-02-21 19:01:48.473707937 -0500
@@ -3,10 +3,9 @@
( Code
, ModuleInfo(moduleCode, sectionDocs)
, ModuleFlag(..)
- , BaseCodeGen
, CodeGen
, ExcCodeGen
- , CGError(..)
+ , CGError
, genCode
, evalCodeGen
@@ -259,25 +258,17 @@
, cgsNextAvailableTyvar = SingleCharTyvar 'a'
}
--- | The base type for the code generator monad.
-type BaseCodeGen excType a =
+-- | The base type for the code generator monad. Generators that
+-- cannot throw errors are parametric in the exception type 'excType'.
+type CodeGen excType a =
ReaderT CodeGenConfig (StateT (CGState, ModuleInfo) (Except excType)) a
--- | The code generator monad, for generators that cannot throw
--- errors. The fact that they cannot throw errors is encoded in the
--- forall, which disallows any operation on the error, except
--- discarding it or passing it along without inspecting. This last
--- operation is useful in order to allow embedding `CodeGen`
--- computations inside `ExcCodeGen` computations, while disallowing
--- the opposite embedding without explicit error handling.
-type CodeGen a = forall e. BaseCodeGen e a
-
-- | Code generators that can throw errors.
-type ExcCodeGen a = BaseCodeGen CGError a
+type ExcCodeGen a = CodeGen CGError a
-- | Run a `CodeGen` with given `Config` and initial state, returning
-- either the resulting exception, or the result and final module info.
-runCodeGen :: BaseCodeGen e a -> CodeGenConfig -> (CGState, ModuleInfo) ->
+runCodeGen :: CodeGen e a -> CodeGenConfig -> (CGState, ModuleInfo) ->
(Either e (a, ModuleInfo))
runCodeGen cg cfg state =
dropCGState <$> runExcept (runStateT (runReaderT cg cfg) state)
@@ -295,13 +286,13 @@
-- | Run the given code generator using the state and config of an
-- ambient CodeGen, but without adding the generated code to
-- `moduleCode`, instead returning it explicitly.
-recurseCG :: BaseCodeGen e a -> BaseCodeGen e (a, Code)
+recurseCG :: CodeGen e a -> CodeGen e (a, Code)
recurseCG = recurseWithState id
-- | Like `recurseCG`, but we allow for explicitly setting the state
-- of the inner code generator.
-recurseWithState :: (CGState -> CGState) -> BaseCodeGen e a
- -> BaseCodeGen e (a, Code)
+recurseWithState :: (CGState -> CGState) -> CodeGen e a
+ -> CodeGen e (a, Code)
recurseWithState cgsSet cg = do
cfg <- ask
(cgs, oldInfo) <- get
@@ -314,7 +305,7 @@
-- | Like `recurseCG`, giving explicitly the set of loaded APIs and C to
-- Haskell map for the subgenerator.
-recurseWithAPIs :: M.Map Name API -> CodeGen () -> CodeGen ()
+recurseWithAPIs :: M.Map Name API -> CodeGen e () -> CodeGen e ()
recurseWithAPIs apis cg = do
cfg <- ask
(cgs, oldInfo) <- get
@@ -363,7 +354,7 @@
-- current module. Note that we do not generate the submodule if the
-- code generator generated no code and the module does not have
-- submodules.
-submodule' :: Text -> BaseCodeGen e () -> BaseCodeGen e ()
+submodule' :: Text -> CodeGen e () -> CodeGen e ()
submodule' modName cg = do
cfg <- ask
(_, oldInfo) <- get
@@ -377,13 +368,13 @@
-- | Run the given CodeGen in order to generate a submodule (specified
-- an an ordered list) of the current module.
-submodule :: ModulePath -> BaseCodeGen e () -> BaseCodeGen e ()
+submodule :: ModulePath -> CodeGen e () -> CodeGen e ()
submodule (ModulePath []) cg = cg
submodule (ModulePath (m:ms)) cg = submodule' m (submodule (ModulePath ms) cg)
-- | Try running the given `action`, and if it fails run `fallback`
-- instead.
-handleCGExc :: (CGError -> CodeGen a) -> ExcCodeGen a -> CodeGen a
+handleCGExc :: (CGError -> CodeGen e a) -> ExcCodeGen a -> CodeGen e a
handleCGExc fallback
action = do
cfg <- ask
@@ -396,25 +387,25 @@
return r
-- | Return the currently loaded set of dependencies.
-getDeps :: CodeGen Deps
+getDeps :: CodeGen e Deps
getDeps = moduleDeps . snd <$> get
-- | Return the ambient configuration for the code generator.
-config :: CodeGen Config
+config :: CodeGen e Config
config = hConfig <$> ask
-- | Return the name of the current module.
-currentModule :: CodeGen Text
+currentModule :: CodeGen e Text
currentModule = do
(_, s) <- get
return (dotWithPrefix (modulePath s))
-- | Return the list of APIs available to the generator.
-getAPIs :: CodeGen (M.Map Name API)
+getAPIs :: CodeGen e (M.Map Name API)
getAPIs = loadedAPIs <$> ask
-- | Return the C -> Haskell available to the generator.
-getC2HMap :: CodeGen (M.Map CRef Hyperlink)
+getC2HMap :: CodeGen e (M.Map CRef Hyperlink)
getC2HMap = c2hMap <$> ask
-- | Due to the `forall` in the definition of `CodeGen`, if we want to
@@ -423,7 +414,7 @@
-- is perfectly safe, since there is no way to construct a computation
-- in the `CodeGen` monad that throws an exception, due to the higher
-- rank type.
-unwrapCodeGen :: CodeGen a -> CodeGenConfig -> (CGState, ModuleInfo)
+unwrapCodeGen :: CodeGen e a -> CodeGenConfig -> (CGState, ModuleInfo)
-> (a, ModuleInfo)
unwrapCodeGen cg cfg info =
case runCodeGen cg cfg info of
@@ -433,7 +424,7 @@
-- | Run a code generator, and return the information for the
-- generated module together with the return value of the generator.
evalCodeGen :: Config -> M.Map Name API ->
- ModulePath -> CodeGen a -> (a, ModuleInfo)
+ ModulePath -> CodeGen e a -> (a, ModuleInfo)
evalCodeGen cfg apis mPath cg =
let initialInfo = emptyModule mPath
cfg' = CodeGenConfig {hConfig = cfg, loadedAPIs = apis,
@@ -442,11 +433,11 @@
-- | Like `evalCodeGen`, but discard the resulting output value.
genCode :: Config -> M.Map Name API ->
- ModulePath -> CodeGen () -> ModuleInfo
+ ModulePath -> CodeGen e () -> ModuleInfo
genCode cfg apis mPath cg = snd $ evalCodeGen cfg apis mPath cg
-- | Mark the given dependency as used by the module.
-registerNSDependency :: Text -> CodeGen ()
+registerNSDependency :: Text -> CodeGen e ()
registerNSDependency name = do
deps <- getDeps
unless (Set.member name deps) $ do
@@ -462,7 +453,7 @@
-- | Given a module name and a symbol in the module (including a
-- proper namespace), return a qualified name for the symbol.
-qualified :: ModulePath -> Name -> CodeGen Text
+qualified :: ModulePath -> Name -> CodeGen e Text
qualified mp (Name ns s) = do
cfg <- config
-- Make sure the module is listed as a dependency.
@@ -478,7 +469,7 @@
-- | Import the given module name qualified (as a source import if the
-- namespace is the same as the current one), and return the name
-- under which the module was imported.
-qualifiedImport :: ModulePath -> CodeGen Text
+qualifiedImport :: ModulePath -> CodeGen e Text
qualifiedImport mp = do
modify' $ \(cgs, s) -> (cgs, s {qualifiedImports = Set.insert mp (qualifiedImports s)})
return (qualifiedModuleName mp)
@@ -500,7 +491,7 @@
: map minBaseVersion (M.elems $ submodules minfo))
-- | Print, as a comment, a friendly textual description of the error.
-printCGError :: CGError -> CodeGen ()
+printCGError :: CGError -> CodeGen e ()
printCGError (CGErrorNotImplemented e) = do
comment $ "Not implemented: " <> e
printCGError (CGErrorBadIntrospectionInfo e) =
@@ -518,7 +509,7 @@
missingInfoError s = throwError $ CGErrorMissingInfo s
-- | Get a type variable unused in the current scope.
-getFreshTypeVariable :: CodeGen Text
+getFreshTypeVariable :: CodeGen e Text
getFreshTypeVariable = do
(cgs@(CGState{cgsNextAvailableTyvar = available}), s) <- get
let (tyvar, next) =
@@ -535,23 +526,23 @@
-- | Introduce a new scope for type variable naming: the next fresh
-- variable will be called 'a'.
-resetTypeVariableScope :: CodeGen ()
+resetTypeVariableScope :: CodeGen e ()
resetTypeVariableScope =
modify' (\(cgs, s) -> (cgs {cgsNextAvailableTyvar = SingleCharTyvar 'a'}, s))
-- | Try to find the API associated with a given type, if known.
-findAPI :: HasCallStack => Type -> CodeGen (Maybe API)
+findAPI :: HasCallStack => Type -> CodeGen e (Maybe API)
findAPI (TInterface n) = Just <$> findAPIByName n
findAPI _ = return Nothing
-- | Find the API associated with a given type. If the API cannot be
-- found this raises an `error`.
-getAPI :: HasCallStack => Type -> CodeGen API
+getAPI :: HasCallStack => Type -> CodeGen e API
getAPI t = findAPI t >>= \case
Just a -> return a
Nothing -> terror ("Could not resolve type \"" <> tshow t <> "\".")
-findAPIByName :: HasCallStack => Name -> CodeGen API
+findAPIByName :: HasCallStack => Name -> CodeGen e API
findAPIByName n@(Name ns _) = do
apis <- getAPIs
case M.lookup n apis of
@@ -560,29 +551,29 @@
terror $ "couldn't find API description for " <> ns <> "." <> name n
-- | Add some code to the current generator.
-tellCode :: CodeToken -> CodeGen ()
+tellCode :: CodeToken -> CodeGen e ()
tellCode c = modify' (\(cgs, s) -> (cgs, s {moduleCode = moduleCode s <>
codeSingleton c}))
-- | Print out a (newline-terminated) line.
-line :: Text -> CodeGen ()
+line :: Text -> CodeGen e ()
line = tellCode . Line
-- | Print out the given line both to the normal module, and to the
-- HsBoot file.
-bline :: Text -> CodeGen ()
+bline :: Text -> CodeGen e ()
bline l = hsBoot (line l) >> line l
-- | A blank line
-blank :: CodeGen ()
+blank :: CodeGen e ()
blank = line ""
-- | A (possibly multi line) comment, separated by newlines
-comment :: Text -> CodeGen ()
+comment :: Text -> CodeGen e ()
comment = tellCode . Comment . T.lines
-- | Increase the indent level for code generation.
-indent :: BaseCodeGen e a -> BaseCodeGen e a
+indent :: CodeGen e a -> CodeGen e a
indent cg = do
(x, code) <- recurseCG cg
tellCode (Indent code)
@@ -590,11 +581,11 @@
-- | Increase the indentation level for the rest of the lines in the
-- current group.
-increaseIndent :: CodeGen ()
+increaseIndent :: CodeGen e ()
increaseIndent = tellCode IncreaseIndent
-- | Group a set of related code.
-group :: BaseCodeGen e a -> BaseCodeGen e a
+group :: CodeGen e a -> CodeGen e a
group cg = do
(x, code) <- recurseCG cg
tellCode (Group code)
@@ -602,7 +593,7 @@
return x
-- | Guard a block of code with @#if@.
-cppIfBlock :: Text -> BaseCodeGen e a -> BaseCodeGen e a
+cppIfBlock :: Text -> CodeGen e a -> CodeGen e a
cppIfBlock cond cg = do
(x, code) <- recurseWithState addConditional cg
tellCode (CPPBlock (CPPIf cond) code)
@@ -617,11 +608,11 @@
-- | Guard a code block with CPP code, such that it is included only
-- if the specified feature is enabled.
-cppIf :: CPPGuard -> BaseCodeGen e a -> BaseCodeGen e a
+cppIf :: CPPGuard -> CodeGen e a -> CodeGen e a
cppIf CPPOverloading = cppIfBlock "defined(ENABLE_OVERLOADING)"
-- | Write the given code into the .hs-boot file for the current module.
-hsBoot :: BaseCodeGen e a -> BaseCodeGen e a
+hsBoot :: CodeGen e a -> CodeGen e a
hsBoot cg = do
(x, code) <- recurseCG cg
modify' (\(cgs, s) -> (cgs, s{bootCode = bootCode s <>
@@ -632,52 +623,52 @@
addGuards (cond : conds) c = codeSingleton $ CPPBlock cond (addGuards conds c)
-- | Add a export to the current module.
-exportPartial :: ([CPPConditional] -> Export) -> CodeGen ()
+exportPartial :: ([CPPConditional] -> Export) -> CodeGen e ()
exportPartial partial =
modify' $ \(cgs, s) -> (cgs,
let e = partial $ cgsCPPConditionals cgs
in s{moduleExports = moduleExports s |> e})
-- | Reexport a whole module.
-exportModule :: SymbolName -> CodeGen ()
+exportModule :: SymbolName -> CodeGen e ()
exportModule m = exportPartial (Export ExportModule m)
-- | Add a type declaration-related export.
-exportDecl :: SymbolName -> CodeGen ()
+exportDecl :: SymbolName -> CodeGen e ()
exportDecl d = exportPartial (Export ExportTypeDecl d)
-- | Export a symbol in the given haddock subsection.
-export :: HaddockSection -> SymbolName -> CodeGen ()
+export :: HaddockSection -> SymbolName -> CodeGen e ()
export s n = exportPartial (Export (ExportSymbol s) n)
-- | Set the language pragmas for the current module.
-setLanguagePragmas :: [Text] -> CodeGen ()
+setLanguagePragmas :: [Text] -> CodeGen e ()
setLanguagePragmas ps =
modify' $ \(cgs, s) -> (cgs, s{modulePragmas = Set.fromList ps})
-- | Add a language pragma for the current module.
-addLanguagePragma :: Text -> CodeGen ()
+addLanguagePragma :: Text -> CodeGen e ()
addLanguagePragma p =
modify' $ \(cgs, s) -> (cgs, s{modulePragmas =
Set.insert p (modulePragmas s)})
-- | Set the GHC options for compiling this module (in a OPTIONS_GHC pragma).
-setGHCOptions :: [Text] -> CodeGen ()
+setGHCOptions :: [Text] -> CodeGen e ()
setGHCOptions opts =
modify' $ \(cgs, s) -> (cgs, s{moduleGHCOpts = Set.fromList opts})
-- | Set the given flags for the module.
-setModuleFlags :: [ModuleFlag] -> CodeGen ()
+setModuleFlags :: [ModuleFlag] -> CodeGen e ()
setModuleFlags flags =
modify' $ \(cgs, s) -> (cgs, s{moduleFlags = Set.fromList flags})
-- | Set the minimum base version supported by the current module.
-setModuleMinBase :: BaseVersion -> CodeGen ()
+setModuleMinBase :: BaseVersion -> CodeGen e ()
setModuleMinBase v =
modify' $ \(cgs, s) -> (cgs, s{moduleMinBase = max v (moduleMinBase s)})
-- | Add documentation for a given section.
-addSectionFormattedDocs :: HaddockSection -> Text -> CodeGen ()
+addSectionFormattedDocs :: HaddockSection -> Text -> CodeGen e ()
addSectionFormattedDocs section docs =
modify' $ \(cgs, s) -> (cgs, s{sectionDocs = M.insertWith (<>) section
docs (sectionDocs s)})
diff -ur haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Constant.hs haskell-gi-0.24.7/lib/Data/GI/CodeGen/Constant.hs
--- haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Constant.hs 2001-09-08 21:46:40.000000000 -0400
+++ haskell-gi-0.24.7/lib/Data/GI/CodeGen/Constant.hs 2021-02-21 19:01:48.474707932 -0500
@@ -29,7 +29,7 @@
type PSView = Text
type PSExpression = Text
-writePattern :: Text -> PatternSynonym -> CodeGen ()
+writePattern :: Text -> PatternSynonym -> CodeGen e ()
writePattern name (SimpleSynonym value t) = line $
"pattern " <> ucFirst name <> " = " <> value <> " :: " <> t
writePattern name (ExplicitSynonym view expression value t) = do
@@ -40,7 +40,7 @@
indent $ line $
ucFirst name <> " = " <> expression <> " " <> value <> " :: " <> t
-genConstant :: Name -> Constant -> CodeGen ()
+genConstant :: Name -> Constant -> CodeGen e ()
genConstant (Name _ name) c = group $ do
setLanguagePragmas ["PatternSynonyms", "ScopedTypeVariables", "ViewPatterns"]
deprecatedPragma name (constantDeprecated c)
diff -ur haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Conversions.hsc haskell-gi-0.24.7/lib/Data/GI/CodeGen/Conversions.hsc
--- haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Conversions.hsc 2001-09-08 21:46:40.000000000 -0400
+++ haskell-gi-0.24.7/lib/Data/GI/CodeGen/Conversions.hsc 2021-02-21 19:01:48.474707932 -0500
@@ -129,7 +129,7 @@
lambdaConvert :: Text -> Converter
lambdaConvert c = liftF $ LambdaConvert c ()
-genConversion :: Text -> Converter -> CodeGen Text
+genConversion :: Text -> Converter -> CodeGen e Text
genConversion l (Pure ()) = return l
genConversion l (Free k) = do
let l' = prime l
@@ -176,7 +176,7 @@
notImplementedError $ "computeArrayLength called on non-CArray type "
<> tshow t
-convert :: Text -> BaseCodeGen e Converter -> BaseCodeGen e Text
+convert :: Text -> CodeGen e Converter -> CodeGen e Text
convert l c = do
c' <- c
genConversion l c'
@@ -195,25 +195,25 @@
-- type.
else return $ M "unsafeManagedPtrCastPtr"
-hVariantToF :: Transfer -> CodeGen Constructor
+hVariantToF :: Transfer -> CodeGen e Constructor
hVariantToF transfer =
if transfer == TransferEverything
then return $ M "B.GVariant.disownGVariant"
else return $ M "unsafeManagedPtrGetPtr"
-hValueToF :: Transfer -> CodeGen Constructor
+hValueToF :: Transfer -> CodeGen e Constructor
hValueToF transfer =
if transfer == TransferEverything
then return $ M "B.GValue.disownGValue"
else return $ M "unsafeManagedPtrGetPtr"
-hParamSpecToF :: Transfer -> CodeGen Constructor
+hParamSpecToF :: Transfer -> CodeGen e Constructor
hParamSpecToF transfer =
if transfer == TransferEverything
then return $ M "B.GParamSpec.disownGParamSpec"
else return $ M "unsafeManagedPtrGetPtr"
-hClosureToF :: Transfer -> Maybe Type -> CodeGen Constructor
+hClosureToF :: Transfer -> Maybe Type -> CodeGen e Constructor
-- Untyped closures
hClosureToF transfer Nothing =
if transfer == TransferEverything
@@ -228,7 +228,7 @@
then return $ M "B.GClosure.disownGClosure"
else return $ M "unsafeManagedPtrGetPtr"
-hBoxedToF :: Transfer -> CodeGen Constructor
+hBoxedToF :: Transfer -> CodeGen e Constructor
hBoxedToF transfer =
if transfer == TransferEverything
then return $ M "B.ManagedPtr.disownBoxed"
@@ -420,13 +420,13 @@
constructor <- hToF' t a hType fType transfer
return $ apply constructor
-boxedForeignPtr :: Text -> Transfer -> CodeGen Constructor
+boxedForeignPtr :: Text -> Transfer -> CodeGen e Constructor
boxedForeignPtr constructor transfer = return $
case transfer of
TransferEverything -> M $ parenthesize $ "wrapBoxed " <> constructor
_ -> M $ parenthesize $ "newBoxed " <> constructor
-suForeignPtr :: Bool -> TypeRep -> Transfer -> CodeGen Constructor
+suForeignPtr :: Bool -> TypeRep -> Transfer -> CodeGen e Constructor
suForeignPtr isBoxed hType transfer = do
let constructor = typeConName hType
if isBoxed then
@@ -436,11 +436,11 @@
TransferEverything -> "wrapPtr " <> constructor
_ -> "newPtr " <> constructor
-structForeignPtr :: Struct -> TypeRep -> Transfer -> CodeGen Constructor
+structForeignPtr :: Struct -> TypeRep -> Transfer -> CodeGen e Constructor
structForeignPtr s =
suForeignPtr (structIsBoxed s)
-unionForeignPtr :: Union -> TypeRep -> Transfer -> CodeGen Constructor
+unionForeignPtr :: Union -> TypeRep -> Transfer -> CodeGen e Constructor
unionForeignPtr u =
suForeignPtr (unionIsBoxed u)
@@ -467,25 +467,25 @@
notImplementedError ("ForeignCallback with unsupported transfer type `"
<> tshow transfer <> "'")
-fVariantToH :: Transfer -> CodeGen Constructor
+fVariantToH :: Transfer -> CodeGen e Constructor
fVariantToH transfer =
return $ M $ case transfer of
TransferEverything -> "B.GVariant.wrapGVariantPtr"
_ -> "B.GVariant.newGVariantFromPtr"
-fValueToH :: Transfer -> CodeGen Constructor
+fValueToH :: Transfer -> CodeGen e Constructor
fValueToH transfer =
return $ M $ case transfer of
TransferEverything -> "B.GValue.wrapGValuePtr"
_ -> "B.GValue.newGValueFromPtr"
-fParamSpecToH :: Transfer -> CodeGen Constructor
+fParamSpecToH :: Transfer -> CodeGen e Constructor
fParamSpecToH transfer =
return $ M $ case transfer of
TransferEverything -> "B.GParamSpec.wrapGParamSpecPtr"
_ -> "B.GParamSpec.newGParamSpecFromPtr"
-fClosureToH :: Transfer -> Maybe Type -> CodeGen Constructor
+fClosureToH :: Transfer -> Maybe Type -> CodeGen e Constructor
-- Untyped closures
fClosureToH transfer Nothing =
return $ M $ case transfer of
@@ -654,7 +654,7 @@
transientToH t transfer = fToH t transfer
-- | Wrap the given transient.
-wrapTransient :: Type -> CodeGen Converter
+wrapTransient :: Type -> CodeGen e Converter
wrapTransient t = do
hCon <- typeConName <$> haskellType t
return $ lambdaConvert $ "B.ManagedPtr.withTransient " <> hCon
@@ -719,7 +719,7 @@
-- | Given a type find the typeclasses the type belongs to, and return
-- the representation of the type in the function signature and the
-- list of typeclass constraints for the type.
-argumentType :: Type -> ExposeClosures -> CodeGen (Text, [Text])
+argumentType :: Type -> ExposeClosures -> CodeGen e (Text, [Text])
argumentType (TGList a) expose = do
(name, constraints) <- argumentType a expose
return ("[" <> name <> "]", constraints)
@@ -789,7 +789,7 @@
haskellBasicType TUIntPtr = con0 "CUIntPtr"
-- | This translates GI types to the types used for generated Haskell code.
-haskellType :: Type -> CodeGen TypeRep
+haskellType :: Type -> CodeGen e TypeRep
haskellType (TBasicType bt) = return $ haskellBasicType bt
-- There is no great choice in this case, so we simply pass the
-- pointer along. This is useful for GdkPixbufNotify, for example.
@@ -847,7 +847,7 @@
callableHasClosures = any (/= -1) . map argClosure . args
-- | Check whether the given type corresponds to a callback.
-typeIsCallback :: Type -> CodeGen Bool
+typeIsCallback :: Type -> CodeGen e Bool
typeIsCallback t@(TInterface _) = do
api <- findAPI t
case api of
@@ -867,7 +867,7 @@
-- want this when they appear as arguments to callbacks/signals, or
-- return types of properties, as it would force the type synonym/type
-- family to depend on the type variable.
-isoHaskellType :: Type -> CodeGen TypeRep
+isoHaskellType :: Type -> CodeGen e TypeRep
isoHaskellType (TGClosure Nothing) =
return $ "GClosure" `con` [con0 "()"]
isoHaskellType t@(TInterface n) = do
@@ -893,7 +893,7 @@
foreignBasicType t = haskellBasicType t
-- This translates GI types to the types used in foreign function calls.
-foreignType :: Type -> CodeGen TypeRep
+foreignType :: Type -> CodeGen e TypeRep
foreignType (TBasicType t) = return $ foreignBasicType t
foreignType (TCArray _ _ _ TGValue) = return $ ptr ("B.GValue.GValue" `con` [])
foreignType (TCArray zt _ _ t) = do
@@ -946,7 +946,7 @@
return (ptr $ tname `con` [])
-- | Whether the give type corresponds to an enum or flag.
-typeIsEnumOrFlag :: Type -> CodeGen Bool
+typeIsEnumOrFlag :: Type -> CodeGen e Bool
typeIsEnumOrFlag t = do
a <- findAPI t
case a of
@@ -960,7 +960,7 @@
data TypeAllocInfo = TypeAlloc Text Int
-- | Information on how to allocate the given type, if known.
-typeAllocInfo :: Type -> CodeGen (Maybe TypeAllocInfo)
+typeAllocInfo :: Type -> CodeGen e (Maybe TypeAllocInfo)
typeAllocInfo TGValue =
let n = #{size GValue}
in return $ Just $ TypeAlloc ("SP.callocBytes " <> tshow n) n
@@ -986,7 +986,7 @@
-- | Returns whether the given type corresponds to a `ManagedPtr`
-- instance (a thin wrapper over a `ForeignPtr`).
-isManaged :: Type -> CodeGen Bool
+isManaged :: Type -> CodeGen e Bool
isManaged TError = return True
isManaged TVariant = return True
isManaged TGValue = return True
@@ -1004,7 +1004,7 @@
-- | Returns whether the given type is represented by a pointer on the
-- C side.
-typeIsPtr :: Type -> CodeGen Bool
+typeIsPtr :: Type -> CodeGen e Bool
typeIsPtr t = isJust <$> typePtrType t
-- | Distinct types of foreign pointers.
@@ -1013,7 +1013,7 @@
-- | For those types represented by pointers on the C side, return the
-- type of pointer which represents them on the Haskell FFI.
-typePtrType :: Type -> CodeGen (Maybe FFIPtrType)
+typePtrType :: Type -> CodeGen e (Maybe FFIPtrType)
typePtrType (TBasicType TPtr) = return (Just FFIPtr)
typePtrType (TBasicType TUTF8) = return (Just FFIPtr)
typePtrType (TBasicType TFileName) = return (Just FFIPtr)
@@ -1027,7 +1027,7 @@
-- | If the passed in type is nullable, return the conversion function
-- between the FFI pointer type (may be a `Ptr` or a `FunPtr`) and the
-- corresponding `Maybe` type.
-maybeNullConvert :: Type -> CodeGen (Maybe Text)
+maybeNullConvert :: Type -> CodeGen e (Maybe Text)
maybeNullConvert (TBasicType TPtr) = return Nothing
maybeNullConvert (TGList _) = return Nothing
maybeNullConvert (TGSList _) = return Nothing
@@ -1040,7 +1040,7 @@
-- | An appropriate NULL value for the given type, for types which are
-- represented by pointers on the C side.
-nullPtrForType :: Type -> CodeGen (Maybe Text)
+nullPtrForType :: Type -> CodeGen e (Maybe Text)
nullPtrForType t = do
pt <- typePtrType t
case pt of
@@ -1054,7 +1054,7 @@
-- G(S)Lists, for which NULL is a valid G(S)List, and raw pointers,
-- which we just pass through to the Haskell side. Notice that
-- introspection annotations can override this.
-typeIsNullable :: Type -> CodeGen Bool
+typeIsNullable :: Type -> CodeGen e Bool
typeIsNullable t = isJust <$> maybeNullConvert t
-- | If the given type maps to a list in Haskell, return the type of the
diff -ur haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/EnumFlags.hs haskell-gi-0.24.7/lib/Data/GI/CodeGen/EnumFlags.hs
--- haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/EnumFlags.hs 2001-09-08 21:46:40.000000000 -0400
+++ haskell-gi-0.24.7/lib/Data/GI/CodeGen/EnumFlags.hs 2021-02-21 19:01:48.474707932 -0500
@@ -87,7 +87,7 @@
maybe (return ()) (genErrorDomain docSection name') (enumErrorDomain e)
-genBoxedEnum :: Name -> Text -> CodeGen ()
+genBoxedEnum :: Name -> Text -> CodeGen e ()
genBoxedEnum n typeInit = do
let name' = upperName n
@@ -106,7 +106,7 @@
group $ do
bline $ "instance B.Types.BoxedEnum " <> name'
-genEnum :: Name -> Enumeration -> CodeGen ()
+genEnum :: Name -> Enumeration -> CodeGen e ()
genEnum n@(Name _ name) enum = do
line $ "-- Enum " <> name
@@ -119,7 +119,7 @@
Nothing -> return ()
Just ti -> genBoxedEnum n ti)
-genBoxedFlags :: Name -> Text -> CodeGen ()
+genBoxedFlags :: Name -> Text -> CodeGen e ()
genBoxedFlags n typeInit = do
let name' = upperName n
@@ -140,7 +140,7 @@
-- | Very similar to enums, but we also declare ourselves as members of
-- the IsGFlag typeclass.
-genFlags :: Name -> Flags -> CodeGen ()
+genFlags :: Name -> Flags -> CodeGen e ()
genFlags n@(Name _ name) (Flags enum) = do
line $ "-- Flags " <> name
@@ -159,7 +159,7 @@
group $ bline $ "instance IsGFlag " <> name')
-- | Support for enums encapsulating error codes.
-genErrorDomain :: HaddockSection -> Text -> Text -> CodeGen ()
+genErrorDomain :: HaddockSection -> Text -> Text -> CodeGen e ()
genErrorDomain docSection name' domain = do
group $ do
line $ "instance GErrorClass " <> name' <> " where"
diff -ur haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/GObject.hs haskell-gi-0.24.7/lib/Data/GI/CodeGen/GObject.hs
--- haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/GObject.hs 2001-09-08 21:46:40.000000000 -0400
+++ haskell-gi-0.24.7/lib/Data/GI/CodeGen/GObject.hs 2021-02-21 19:01:48.474707932 -0500
@@ -13,12 +13,12 @@
import Data.GI.CodeGen.Type
-- Returns whether the given type is a descendant of the given parent.
-typeDoParentSearch :: Name -> Type -> CodeGen Bool
+typeDoParentSearch :: Name -> Type -> CodeGen e Bool
typeDoParentSearch parent (TInterface n) = findAPIByName n >>=
apiDoParentSearch parent n
typeDoParentSearch _ _ = return False
-apiDoParentSearch :: Name -> Name -> API -> CodeGen Bool
+apiDoParentSearch :: Name -> Name -> API -> CodeGen e Bool
apiDoParentSearch parent n api
| parent == n = return True
| otherwise = case api of
@@ -33,13 +33,13 @@
_ -> return False
-- | Check whether the given type descends from GObject.
-isGObject :: Type -> CodeGen Bool
+isGObject :: Type -> CodeGen e Bool
isGObject = typeDoParentSearch $ Name "GObject" "Object"
-- | Check whether the given name descends from GObject.
-nameIsGObject :: Name -> CodeGen Bool
+nameIsGObject :: Name -> CodeGen e Bool
nameIsGObject n = findAPIByName n >>= apiIsGObject n
-- | Check whether the given API descends from GObject.
-apiIsGObject :: Name -> API -> CodeGen Bool
+apiIsGObject :: Name -> API -> CodeGen e Bool
apiIsGObject = apiDoParentSearch $ Name "GObject" "Object"
diff -ur haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Haddock.hs haskell-gi-0.24.7/lib/Data/GI/CodeGen/Haddock.hs
--- haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Haddock.hs 2001-09-08 21:46:40.000000000 -0400
+++ haskell-gi-0.24.7/lib/Data/GI/CodeGen/Haddock.hs 2021-02-21 19:01:48.474707932 -0500
@@ -189,7 +189,7 @@
-- | Get the base url for the online C language documentation for the
-- module being currently generated.
-getDocBase :: CodeGen Text
+getDocBase :: CodeGen e Text
getDocBase = do
mod <- modName <$> config
docsMap <- (onlineDocsMap . overrides) <$> config
@@ -200,7 +200,7 @@
-- | Write the deprecation pragma for the given `DeprecationInfo`, if
-- not `Nothing`.
-deprecatedPragma :: Text -> Maybe DeprecationInfo -> CodeGen ()
+deprecatedPragma :: Text -> Maybe DeprecationInfo -> CodeGen e ()
deprecatedPragma _ Nothing = return ()
deprecatedPragma name (Just info) = do
c2h <- getC2HMap
@@ -228,7 +228,7 @@
Just ver -> "\n\n/Since: " <> ver <> "/"
-- | Write the given documentation into generated code.
-writeDocumentation :: RelativeDocPosition -> Documentation -> CodeGen ()
+writeDocumentation :: RelativeDocPosition -> Documentation -> CodeGen e ()
writeDocumentation pos doc = do
c2h <- getC2HMap
docBase <- getDocBase
@@ -236,7 +236,7 @@
-- | Like `writeDocumentation`, but allows us to pass explicitly the
-- Haddock comment to write.
-writeHaddock :: RelativeDocPosition -> Text -> CodeGen ()
+writeHaddock :: RelativeDocPosition -> Text -> CodeGen e ()
writeHaddock pos haddock =
let marker = case pos of
DocBeforeSymbol -> "|"
@@ -247,7 +247,7 @@
in mapM_ line lines
-- | Write the documentation for the given argument.
-writeArgDocumentation :: Arg -> CodeGen ()
+writeArgDocumentation :: Arg -> CodeGen e ()
writeArgDocumentation arg =
case rawDocText (argDoc arg) of
Nothing -> return ()
@@ -259,7 +259,7 @@
writeHaddock DocAfterSymbol haddock
-- | Write the documentation for the given return value.
-writeReturnDocumentation :: Callable -> Bool -> CodeGen ()
+writeReturnDocumentation :: Callable -> Bool -> CodeGen e ()
writeReturnDocumentation callable skip = do
c2h <- getC2HMap
docBase <- getDocBase
@@ -278,7 +278,7 @@
writeHaddock DocAfterSymbol fullInfo
-- | Add the given text to the documentation for the section being generated.
-addSectionDocumentation :: HaddockSection -> Documentation -> CodeGen ()
+addSectionDocumentation :: HaddockSection -> Documentation -> CodeGen e ()
addSectionDocumentation section doc = do
c2h <- getC2HMap
docBase <- getDocBase
diff -ur haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Inheritance.hs haskell-gi-0.24.7/lib/Data/GI/CodeGen/Inheritance.hs
--- haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Inheritance.hs 2001-09-08 21:46:40.000000000 -0400
+++ haskell-gi-0.24.7/lib/Data/GI/CodeGen/Inheritance.hs 2021-02-21 19:01:48.474707932 -0500
@@ -34,7 +34,7 @@
getParent _ = Nothing
-- | Compute the (ordered) list of parents of the current object.
-instanceTree :: Name -> CodeGen [Name]
+instanceTree :: Name -> CodeGen e [Name]
instanceTree n = do
api <- findAPIByName n
case getParent api of
@@ -67,7 +67,7 @@
-- (including those defined by its ancestors and the interfaces it
-- implements), together with the name of the interface defining the
-- property.
-apiInheritables :: Inheritable i => Name -> CodeGen [(Name, i)]
+apiInheritables :: Inheritable i => Name -> CodeGen e [(Name, i)]
apiInheritables n = do
api <- findAPIByName n
case dropMovedItems api of
@@ -75,7 +75,7 @@
Just (APIObject object) -> return $ map ((,) n) (objInheritables object)
_ -> error $ "apiInheritables : Unexpected API : " ++ show n
-fullAPIInheritableList :: Inheritable i => Name -> CodeGen [(Name, i)]
+fullAPIInheritableList :: Inheritable i => Name -> CodeGen e [(Name, i)]
fullAPIInheritableList n = do
api <- findAPIByName n
case api of
@@ -84,14 +84,14 @@
_ -> error $ "FullAPIInheritableList : Unexpected API : " ++ show n
fullObjectInheritableList :: Inheritable i => Name -> Object ->
- CodeGen [(Name, i)]
+ CodeGen e [(Name, i)]
fullObjectInheritableList n obj = do
iT <- instanceTree n
(++) <$> (concat <$> mapM apiInheritables (n : iT))
<*> (concat <$> mapM apiInheritables (objInterfaces obj))
fullInterfaceInheritableList :: Inheritable i => Name -> Interface ->
- CodeGen [(Name, i)]
+ CodeGen e [(Name, i)]
fullInterfaceInheritableList n iface =
(++) (map ((,) n) (ifInheritables iface))
<$> (concat <$> mapM fullAPIInheritableList (ifPrerequisites iface))
@@ -103,13 +103,13 @@
-- setters/getters that we can call, but they are all isomorphic). If
-- they are not isomorphic we print a warning, and choose to use the
-- one closest to the leaves of the object hierarchy.
-removeDuplicates :: forall i. (Eq i, Show i, Inheritable i) =>
- Bool -> [(Name, i)] -> CodeGen [(Name, i)]
+removeDuplicates :: forall i e. (Eq i, Show i, Inheritable i) =>
+ Bool -> [(Name, i)] -> CodeGen e [(Name, i)]
removeDuplicates verbose inheritables =
(filterTainted . M.toList) <$> foldM filterDups M.empty inheritables
where
filterDups :: M.Map Text (Bool, Name, i) -> (Name, i) ->
- CodeGen (M.Map Text (Bool, Name, i))
+ CodeGen e (M.Map Text (Bool, Name, i))
filterDups m (name, prop) =
case M.lookup (iName prop) m of
Just (tainted, n, p)
@@ -129,36 +129,36 @@
-- | List all properties defined for an object, including those
-- defined by its ancestors.
-fullObjectPropertyList :: Name -> Object -> CodeGen [(Name, Property)]
+fullObjectPropertyList :: Name -> Object -> CodeGen e [(Name, Property)]
fullObjectPropertyList n o = fullObjectInheritableList n o >>=
removeDuplicates True
-- | List all properties defined for an interface, including those
-- defined by its prerequisites.
-fullInterfacePropertyList :: Name -> Interface -> CodeGen [(Name, Property)]
+fullInterfacePropertyList :: Name -> Interface -> CodeGen e [(Name, Property)]
fullInterfacePropertyList n i = fullInterfaceInheritableList n i >>=
removeDuplicates True
-- | List all signals defined for an object, including those
-- defined by its ancestors.
-fullObjectSignalList :: Name -> Object -> CodeGen [(Name, Signal)]
+fullObjectSignalList :: Name -> Object -> CodeGen e [(Name, Signal)]
fullObjectSignalList n o = fullObjectInheritableList n o >>=
removeDuplicates True
-- | List all signals defined for an interface, including those
-- defined by its prerequisites.
-fullInterfaceSignalList :: Name -> Interface -> CodeGen [(Name, Signal)]
+fullInterfaceSignalList :: Name -> Interface -> CodeGen e [(Name, Signal)]
fullInterfaceSignalList n i = fullInterfaceInheritableList n i >>=
removeDuplicates True
-- | List all methods defined for an object, including those defined
-- by its ancestors.
-fullObjectMethodList :: Name -> Object -> CodeGen [(Name, Method)]
+fullObjectMethodList :: Name -> Object -> CodeGen e [(Name, Method)]
fullObjectMethodList n o = fullObjectInheritableList n o >>=
removeDuplicates False
-- | List all methods defined for an interface, including those
-- defined by its prerequisites.
-fullInterfaceMethodList :: Name -> Interface -> CodeGen [(Name, Method)]
+fullInterfaceMethodList :: Name -> Interface -> CodeGen e [(Name, Method)]
fullInterfaceMethodList n i = fullInterfaceInheritableList n i >>=
removeDuplicates False
diff -ur haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/OverloadedLabels.hs haskell-gi-0.24.7/lib/Data/GI/CodeGen/OverloadedLabels.hs
--- haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/OverloadedLabels.hs 2001-09-08 21:46:40.000000000 -0400
+++ haskell-gi-0.24.7/lib/Data/GI/CodeGen/OverloadedLabels.hs 2021-02-21 19:01:48.474707932 -0500
@@ -21,10 +21,10 @@
-- | A list of all overloadable identifiers in the set of APIs (current
-- properties and methods).
-findOverloaded :: [(Name, API)] -> CodeGen [Text]
+findOverloaded :: [(Name, API)] -> CodeGen e [Text]
findOverloaded apis = S.toList <$> go apis S.empty
where
- go :: [(Name, API)] -> S.Set Text -> CodeGen (S.Set Text)
+ go :: [(Name, API)] -> S.Set Text -> CodeGen e (S.Set Text)
go [] set = return set
go ((_, api):apis) set =
case api of
@@ -75,14 +75,14 @@
filterFields = filter (\f -> fieldVisible f &&
(not . T.null . fieldName) f)
-genOverloadedLabel :: Text -> CodeGen ()
+genOverloadedLabel :: Text -> CodeGen e ()
genOverloadedLabel l = group $ do
line $ "_" <> l <> " :: IsLabelProxy \"" <> l <> "\" a => a"
line $ "_" <> l <> " = fromLabelProxy (Proxy :: Proxy \""
<> l <> "\")"
export ToplevelSection ("_" <> l)
-genOverloadedLabels :: [(Name, API)] -> CodeGen ()
+genOverloadedLabels :: [(Name, API)] -> CodeGen e ()
genOverloadedLabels allAPIs = do
setLanguagePragmas ["DataKinds", "FlexibleContexts", "CPP"]
setModuleFlags [ImplicitPrelude]
diff -ur haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/OverloadedMethods.hs haskell-gi-0.24.7/lib/Data/GI/CodeGen/OverloadedMethods.hs
--- haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/OverloadedMethods.hs 2001-09-08 21:46:40.000000000 -0400
+++ haskell-gi-0.24.7/lib/Data/GI/CodeGen/OverloadedMethods.hs 2021-02-21 19:01:48.474707932 -0500
@@ -20,14 +20,14 @@
import Data.GI.CodeGen.Util (ucFirst)
-- | Qualified name for the info for a given method.
-methodInfoName :: Name -> Method -> CodeGen Text
+methodInfoName :: Name -> Method -> CodeGen e Text
methodInfoName n method =
let infoName = upperName n <> (ucFirst . lowerName . methodName) method
<> "MethodInfo"
in qualifiedSymbol infoName n
-- | Appropriate instances so overloaded labels are properly resolved.
-genMethodResolver :: Text -> CodeGen ()
+genMethodResolver :: Text -> CodeGen e ()
genMethodResolver n = do
addLanguagePragma "TypeApplications"
group $ do
@@ -42,7 +42,7 @@
-- | Generate the `MethodList` instance given the list of methods for
-- the given named type.
-genMethodList :: Name -> [(Name, Method)] -> CodeGen ()
+genMethodList :: Name -> [(Name, Method)] -> CodeGen e ()
genMethodList n methods = do
let name = upperName n
let filteredMethods = filter isOrdinaryMethod methods
@@ -98,7 +98,7 @@
-- | Generate a method info that is not actually callable, but rather
-- gives a type error when trying to use it.
-genUnsupportedMethodInfo :: Name -> Method -> CodeGen ()
+genUnsupportedMethodInfo :: Name -> Method -> CodeGen e ()
genUnsupportedMethodInfo n m = do
infoName <- methodInfoName n m
line $ "-- XXX: Dummy instance, since code generation failed.\n"
diff -ur haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/OverloadedSignals.hs haskell-gi-0.24.7/lib/Data/GI/CodeGen/OverloadedSignals.hs
--- haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/OverloadedSignals.hs 2001-09-08 21:46:40.000000000 -0400
+++ haskell-gi-0.24.7/lib/Data/GI/CodeGen/OverloadedSignals.hs 2021-02-21 19:01:48.474707932 -0500
@@ -26,10 +26,10 @@
-- A list of distinct signal names for all GObjects appearing in the
-- given list of APIs.
-findSignalNames :: [(Name, API)] -> CodeGen [Text]
+findSignalNames :: [(Name, API)] -> CodeGen e [Text]
findSignalNames apis = S.toList <$> go apis S.empty
where
- go :: [(Name, API)] -> S.Set Text -> CodeGen (S.Set Text)
+ go :: [(Name, API)] -> S.Set Text -> CodeGen e (S.Set Text)
go [] set = return set
go ((_, api):apis) set =
case api of
@@ -43,7 +43,7 @@
insertSignals props set = foldr (S.insert . sigName) set props
-- | Generate the overloaded signal connectors: "Clicked", "ActivateLink", ...
-genOverloadedSignalConnectors :: [(Name, API)] -> CodeGen ()
+genOverloadedSignalConnectors :: [(Name, API)] -> CodeGen e ()
genOverloadedSignalConnectors allAPIs = do
setLanguagePragmas ["DataKinds", "PatternSynonyms", "CPP",
-- For ghc 7.8 support
@@ -63,7 +63,7 @@
exportDecl $ "pattern " <> camelName
-- | Signal instances for (GObject-derived) objects.
-genObjectSignals :: Name -> Object -> CodeGen ()
+genObjectSignals :: Name -> Object -> CodeGen e ()
genObjectSignals n o = do
let name = upperName n
isGO <- apiIsGObject n (APIObject o)
@@ -80,7 +80,7 @@
<> T.intercalate ", " infos <> "] :: [(Symbol, *)])"
-- | Signal instances for interfaces.
-genInterfaceSignals :: Name -> Interface -> CodeGen ()
+genInterfaceSignals :: Name -> Interface -> CodeGen e ()
genInterfaceSignals n iface = do
let name = upperName n
infos <- fullInterfaceSignalList n iface >>=
diff -ur haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Properties.hs haskell-gi-0.24.7/lib/Data/GI/CodeGen/Properties.hs
--- haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Properties.hs 2001-09-08 21:46:40.000000000 -0400
+++ haskell-gi-0.24.7/lib/Data/GI/CodeGen/Properties.hs 2021-02-21 19:01:48.475707926 -0500
@@ -92,7 +92,7 @@
_ -> notImplementedError $ "Don't know how to handle properties of type " <> tshow t
-- | The constraint for setting the given type in properties.
-propSetTypeConstraint :: Type -> CodeGen Text
+propSetTypeConstraint :: Type -> CodeGen e Text
propSetTypeConstraint (TGClosure Nothing) =
return $ "(~) " <> parenthesize (typeShow ("GClosure" `con` [con0 "()"]))
propSetTypeConstraint t = do
@@ -109,7 +109,7 @@
else hInType
-- | The constraint for transferring the given type into a property.
-propTransferTypeConstraint :: Type -> CodeGen Text
+propTransferTypeConstraint :: Type -> CodeGen e Text
propTransferTypeConstraint t = do
isGO <- isGObject t
if isGO
@@ -122,7 +122,7 @@
-- | The type of the return value of @attrTransfer@ for the given
-- type.
-propTransferType :: Type -> CodeGen Text
+propTransferType :: Type -> CodeGen e Text
propTransferType (TGClosure Nothing) =
return $ typeShow ("GClosure" `con` [con0 "()"])
propTransferType t = do
@@ -134,7 +134,7 @@
-- | Given a value "v" of the given Haskell type, satisfying the
-- constraint generated by 'propTransferTypeConstraint', convert it
-- (allocating memory is necessary) to the type given by 'propTransferType'.
-genPropTransfer :: Text -> Type -> CodeGen ()
+genPropTransfer :: Text -> Type -> CodeGen e ()
genPropTransfer var (TGClosure Nothing) = line $ "return " <> var
genPropTransfer var t = do
isGO <- isGObject t
@@ -157,7 +157,7 @@
-- | Given a property, return the set of constraints on the types, and
-- the type variables for the object and its value.
-attrType :: Property -> CodeGen ([Text], Text)
+attrType :: Property -> CodeGen e ([Text], Text)
attrType prop = do
resetTypeVariableScope
isCallback <- typeIsCallback (propType prop)
@@ -301,7 +301,7 @@
hPropName :: Property -> Text
hPropName = lcFirst . hyphensToCamelCase . propName
-genObjectProperties :: Name -> Object -> CodeGen ()
+genObjectProperties :: Name -> Object -> CodeGen e ()
genObjectProperties n o = do
isGO <- apiIsGObject n (APIObject o)
-- We do not generate bindings for objects not descending from GObject.
@@ -313,7 +313,7 @@
<> "\", " <> pi <> ")")
genProperties n (objProperties o) allProps
-genInterfaceProperties :: Name -> Interface -> CodeGen ()
+genInterfaceProperties :: Name -> Interface -> CodeGen e ()
genInterfaceProperties n iface = do
allProps <- fullInterfacePropertyList n iface >>=
mapM (\(owner, prop) -> do
@@ -325,7 +325,7 @@
-- If the given accesor is available (indicated by available == True),
-- generate a fully qualified accesor name, otherwise just return
-- "undefined". accessor is "get", "set" or "construct"
-accessorOrUndefined :: Bool -> Text -> Name -> Text -> CodeGen Text
+accessorOrUndefined :: Bool -> Text -> Name -> Text -> CodeGen e Text
accessorOrUndefined available accessor owner@(Name _ on) cName =
if not available
then return "undefined"
@@ -333,7 +333,7 @@
-- | The name of the type encoding the information for the property of
-- the object.
-infoType :: Name -> Property -> CodeGen Text
+infoType :: Name -> Property -> CodeGen e Text
infoType owner prop =
let infoType = upperName owner <> (hyphensToCamelCase . propName) prop
<> "PropertyInfo"
@@ -450,7 +450,7 @@
-- | Generate a placeholder property for those cases in which code
-- generation failed.
-genPlaceholderProperty :: Name -> Property -> CodeGen ()
+genPlaceholderProperty :: Name -> Property -> CodeGen e ()
genPlaceholderProperty owner prop = do
line $ "-- XXX Placeholder"
it <- infoType owner prop
@@ -474,7 +474,7 @@
line $ "attrClear = undefined"
line $ "attrTransfer = undefined"
-genProperties :: Name -> [Property] -> [Text] -> CodeGen ()
+genProperties :: Name -> [Property] -> [Text] -> CodeGen e ()
genProperties n ownedProps allProps = do
let name = upperName n
@@ -500,12 +500,12 @@
-- name clashes (an example is Auth::is_for_proxy method in libsoup,
-- and the corresponding Auth::is-for-proxy property). When there is a
-- clash we give priority to the method.
-genNamespacedPropLabels :: Name -> [Property] -> [Method] -> CodeGen ()
+genNamespacedPropLabels :: Name -> [Property] -> [Method] -> CodeGen e ()
genNamespacedPropLabels owner props methods =
let lName = lcFirst . hyphensToCamelCase . propName
in genNamespacedAttrLabels owner (map lName props) methods
-genNamespacedAttrLabels :: Name -> [Text] -> [Method] -> CodeGen ()
+genNamespacedAttrLabels :: Name -> [Text] -> [Method] -> CodeGen e ()
genNamespacedAttrLabels owner attrNames methods = do
let name = upperName owner
Only in haskell-gi-0.24.7/lib/Data/GI/CodeGen: Properties.hs.rej
diff -ur haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Signal.hs haskell-gi-0.24.7/lib/Data/GI/CodeGen/Signal.hs
--- haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Signal.hs 2001-09-08 21:46:40.000000000 -0400
+++ haskell-gi-0.24.7/lib/Data/GI/CodeGen/Signal.hs 2021-02-21 19:01:48.475707926 -0500
@@ -80,7 +80,7 @@
-- | Generate the type synonym for the prototype of the callback on
-- the C side. Returns the name given to the type synonym.
-genCCallbackPrototype :: Text -> Callable -> Text -> Bool -> CodeGen Text
+genCCallbackPrototype :: Text -> Callable -> Text -> Bool -> CodeGen e Text
genCCallbackPrototype subsec cb name' isSignal = group $ do
let ctypeName = callbackCType name'
@@ -110,7 +110,7 @@
ccallbackDoc = "Type for the callback on the (unwrapped) C side."
-- | Generator for wrappers callable from C
-genCallbackWrapperFactory :: Text -> Text -> CodeGen ()
+genCallbackWrapperFactory :: Text -> Text -> CodeGen e ()
genCallbackWrapperFactory subsec name' = group $ do
let factoryName = callbackWrapperAllocator name'
writeHaddock DocBeforeSymbol factoryDoc
@@ -125,7 +125,7 @@
-- | Wrap the Haskell `cb` callback into a foreign function of the
-- right type. Returns the name of the wrapped value.
-genWrappedCallback :: Callable -> Text -> Text -> Bool -> CodeGen Text
+genWrappedCallback :: Callable -> Text -> Text -> Bool -> CodeGen e Text
genWrappedCallback cb cbArg callback isSignal = do
drop <- if callableHasClosures cb
then do
@@ -141,7 +141,7 @@
return (prime drop)
-- | Generator of closures
-genClosure :: Text -> Callable -> Text -> Text -> Bool -> CodeGen ()
+genClosure :: Text -> Callable -> Text -> Text -> Bool -> CodeGen e ()
genClosure subsec cb callback name isSignal = group $ do
let closure = callbackClosureGenerator name
export (NamedSubsection SignalSection subsec) closure
@@ -160,7 +160,7 @@
-- Wrap a conversion of a nullable object into "Maybe" object, by
-- checking whether the pointer is NULL.
-convertNullable :: Text -> BaseCodeGen e Text -> BaseCodeGen e Text
+convertNullable :: Text -> CodeGen e Text -> CodeGen e Text
convertNullable aname c = do
line $ "maybe" <> ucFirst aname <> " <-"
indent $ do
@@ -241,7 +241,7 @@
line $ "poke " <> name <> " " <> name''
-- | A simple wrapper that drops every closure argument.
-genDropClosures :: Text -> Callable -> Text -> CodeGen ()
+genDropClosures :: Text -> Callable -> Text -> CodeGen e ()
genDropClosures subsec cb name' = group $ do
let dropper = callbackDropClosures name'
(inWithClosures, _) = callableHInArgs cb WithClosures
@@ -330,7 +330,7 @@
result' <- convert rname $ hToF r (returnTransfer cb)
line $ "return " <> result'
-genCallback :: Name -> Callback -> CodeGen ()
+genCallback :: Name -> Callback -> CodeGen e ()
genCallback n callback@(Callback {cbCallable = cb, cbDocumentation = cbDoc }) = do
let Name _ name' = normalizedAPIName (APICallback callback) n
cb' = fixupCallerAllocates cb
@@ -383,7 +383,7 @@
genCallbackWrapper name' cb' name' False
-- | Generate the given signal instance for the given API object.
-genSignalInfoInstance :: Name -> Signal -> CodeGen ()
+genSignalInfoInstance :: Name -> Signal -> CodeGen e ()
genSignalInfoInstance owner signal = group $ do
let name = upperName owner
let sn = (ucFirst . signalHaskellName . sigName) signal
@@ -400,7 +400,7 @@
-- | Write some simple debug message when signal generation fails, and
-- generate a placeholder SignalInfo instance.
-processSignalError :: Signal -> Name -> CGError -> CodeGen ()
+processSignalError :: Signal -> Name -> CGError -> CodeGen e ()
processSignalError signal owner err = do
let qualifiedSignalName = upperName owner <> "::" <> sigName signal
sn = (ucFirst . signalHaskellName . sigName) signal
@@ -422,7 +422,7 @@
export (NamedSubsection SignalSection $ lcFirst sn) si
-- | Generate a wrapper for a signal.
-genSignal :: Signal -> Name -> CodeGen ()
+genSignal :: Signal -> Name -> CodeGen e ()
genSignal s@(Signal { sigName = sn, sigCallable = cb }) on =
handleCGExc (processSignalError s on) $ do
let on' = upperName on
@@ -538,7 +538,7 @@
-> Text -- ^ Callback type
-> Text -- ^ SignalConnectBefore or SignalConnectAfter
-> Text -- ^ Detail
- -> CodeGen ()
+ -> CodeGen e ()
genSignalConnector (Signal {sigName = sn, sigCallable = cb}) cbType when detail = do
cb' <- genWrappedCallback cb "cb" cbType True
let cb'' = prime cb'
diff -ur haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Struct.hs haskell-gi-0.24.7/lib/Data/GI/CodeGen/Struct.hs
--- haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Struct.hs 2001-09-08 21:46:40.000000000 -0400
+++ haskell-gi-0.24.7/lib/Data/GI/CodeGen/Struct.hs 2021-02-21 19:01:48.475707926 -0500
@@ -42,7 +42,7 @@
(not $ structForceVisible s)
-- | Whether the given type corresponds to an ignored struct.
-isIgnoredStructType :: Type -> CodeGen Bool
+isIgnoredStructType :: Type -> CodeGen e Bool
isIgnoredStructType t =
case t of
TInterface n -> do
@@ -97,7 +97,7 @@
-- | The name of the type encoding the information for a field in a
-- struct/union.
-infoType :: Name -> Field -> CodeGen Text
+infoType :: Name -> Field -> CodeGen e Text
infoType owner field = do
let name = upperName owner
let fName = (underscoresToCamelCase . fieldName) field
@@ -256,7 +256,7 @@
-- | Return whether the given type corresponds to a callback that does
-- not throw exceptions. See [Note: Callables that throw] for the
-- reason why we do not try to wrap callbacks that throw exceptions.
-isRegularCallback :: Type -> CodeGen Bool
+isRegularCallback :: Type -> CodeGen e Bool
isRegularCallback t@(TInterface _) = do
api <- getAPI t
case api of
@@ -267,7 +267,7 @@
-- | The types accepted by the allocating set function
-- 'Data.GI.Base.Attributes.(:&=)'.
-fieldTransferTypeConstraint :: Type -> CodeGen Text
+fieldTransferTypeConstraint :: Type -> CodeGen e Text
fieldTransferTypeConstraint t = do
isPtr <- typeIsPtr t
isRegularCallback <- isRegularCallback t
@@ -281,7 +281,7 @@
-- | The type generated by 'Data.GI.Base.attrTransfer' for this
-- field. This type should satisfy the
-- 'Data.GI.Base.Attributes.AttrSetTypeConstraint' for the type.
-fieldTransferType :: Type -> CodeGen Text
+fieldTransferType :: Type -> CodeGen e Text
fieldTransferType t = do
isPtr <- typeIsPtr t
inType <- if isPtr
@@ -293,7 +293,7 @@
-- | Generate the field transfer function, which marshals Haskell
-- values to types that we can set, even if we need to allocate memory.
-genFieldTransfer :: Text -> Type -> CodeGen ()
+genFieldTransfer :: Text -> Type -> CodeGen e ()
genFieldTransfer var t@(TInterface tn@(Name _ n)) = do
isRegularCallback <- isRegularCallback t
if isRegularCallback
@@ -420,7 +420,7 @@
docSection = NamedSubsection PropertySection $ lcFirst $ fName field
-- | Generate code for the given list of fields.
-genStructOrUnionFields :: Name -> [Field] -> CodeGen ()
+genStructOrUnionFields :: Name -> [Field] -> CodeGen e ()
genStructOrUnionFields n fields = do
let name' = upperName n
@@ -443,7 +443,7 @@
-- | Generate a constructor for a zero-filled struct/union of the given
-- type, using the boxed (or GLib, for unboxed types) allocator.
-genZeroSU :: Name -> Int -> Bool -> CodeGen ()
+genZeroSU :: Name -> Int -> Bool -> CodeGen e ()
genZeroSU n size isBoxed = group $ do
let name = upperName n
let builder = "newZero" <> name
@@ -472,28 +472,28 @@
line $ "return o"
-- | Specialization for structs of `genZeroSU`.
-genZeroStruct :: Name -> Struct -> CodeGen ()
+genZeroStruct :: Name -> Struct -> CodeGen e ()
genZeroStruct n s =
when (allocCalloc (structAllocationInfo s) /= AllocationOp "none" &&
structSize s /= 0) $
genZeroSU n (structSize s) (structIsBoxed s)
-- | Specialization for unions of `genZeroSU`.
-genZeroUnion :: Name -> Union -> CodeGen ()
+genZeroUnion :: Name -> Union -> CodeGen e ()
genZeroUnion n u =
when (allocCalloc (unionAllocationInfo u ) /= AllocationOp "none" &&
unionSize u /= 0) $
genZeroSU n (unionSize u) (unionIsBoxed u)
-- | Construct a import with the given prefix.
-prefixedForeignImport :: Text -> Text -> Text -> CodeGen Text
+prefixedForeignImport :: Text -> Text -> Text -> CodeGen e Text
prefixedForeignImport prefix symbol prototype = group $ do
line $ "foreign import ccall \"" <> symbol <> "\" " <> prefix <> symbol
<> " :: " <> prototype
return (prefix <> symbol)
-- | Generate a GValue instance for @GBoxed@ objects.
-genBoxedGValueInstance :: Name -> Text -> CodeGen ()
+genBoxedGValueInstance :: Name -> Text -> CodeGen e ()
genBoxedGValueInstance n get_type_fn = do
let name' = upperName n
doc = "Convert '" <> name' <> "' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'."
@@ -514,7 +514,7 @@
-- | Allocation and deallocation for types registered as `GBoxed` in
-- the GLib type system.
-genBoxed :: Name -> Text -> CodeGen ()
+genBoxed :: Name -> Text -> CodeGen e ()
genBoxed n typeInit = do
let name' = upperName n
get_type_fn = "c_" <> typeInit
@@ -539,7 +539,7 @@
-- | Generate the typeclass with information for how to
-- allocate/deallocate a given type which is not a `GBoxed`.
-genWrappedPtr :: Name -> AllocationInfo -> Int -> CodeGen ()
+genWrappedPtr :: Name -> AllocationInfo -> Int -> CodeGen e ()
genWrappedPtr n info size = group $ do
let prefix = \op -> "_" <> name' <> "_" <> op <> "_"
@@ -586,7 +586,7 @@
where name' = upperName n
- callocInstance :: Text -> CodeGen()
+ callocInstance :: Text -> CodeGen e ()
callocInstance calloc = group $ do
bline $ "instance CallocPtr " <> name' <> " where"
indent $ do
diff -ur haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/SymbolNaming.hs haskell-gi-0.24.7/lib/Data/GI/CodeGen/SymbolNaming.hs
--- haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/SymbolNaming.hs 2001-09-08 21:46:40.000000000 -0400
+++ haskell-gi-0.24.7/lib/Data/GI/CodeGen/SymbolNaming.hs 2021-02-21 19:05:16.527533913 -0500
@@ -43,12 +43,12 @@
-- | Return a qualified form of the constraint for the given name
-- (which should correspond to a valid `TInterface`).
-classConstraint :: Name -> CodeGen Text
+classConstraint :: Name -> CodeGen e Text
classConstraint n@(Name _ s) = qualifiedSymbol ("Is" <> s) n
-- | Same as `classConstraint`, but applicable directly to a type. The
-- type should be a `TInterface`, otherwise an error will be raised.
-typeConstraint :: Type -> CodeGen Text
+typeConstraint :: Type -> CodeGen e Text
typeConstraint (TInterface n) = classConstraint n
typeConstraint t = error $ "Class constraint for non-interface type: " <> show t
@@ -161,13 +161,13 @@
-- | Return an identifier for the given interface type valid in the current
-- module.
-qualifiedAPI :: API -> Name -> CodeGen Text
+qualifiedAPI :: API -> Name -> CodeGen e Text
qualifiedAPI api n@(Name ns _) =
let normalized = normalizedAPIName api n
in qualified (toModulePath (ucFirst ns) <> submoduleLocation n api) normalized
-- | Construct an identifier for the given symbol in the given API.
-qualifiedSymbol :: Text -> Name -> CodeGen Text
+qualifiedSymbol :: Text -> Name -> CodeGen e Text
qualifiedSymbol s n@(Name ns _) = do
api <- getAPI (TInterface n)
qualified (toModulePath (ucFirst ns) <> submoduleLocation n api) (Name ns s)
@@ -243,7 +243,7 @@
| otherwise = s
-- | Qualified name for the "(sigName, info)" tag for a given signal.
-signalInfoName :: Name -> Signal -> CodeGen Text
+signalInfoName :: Name -> Signal -> CodeGen e Text
signalInfoName n signal = do
let infoName = upperName n <> (ucFirst . signalHaskellName . sigName) signal
<> "SignalInfo"
Only in haskell-gi-0.24.7/lib/Data/GI/CodeGen: SymbolNaming.hs.rej
diff -ur haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Transfer.hs haskell-gi-0.24.7/lib/Data/GI/CodeGen/Transfer.hs
--- haskell-gi-0.24.7.old/lib/Data/GI/CodeGen/Transfer.hs 2001-09-08 21:46:40.000000000 -0400
+++ haskell-gi-0.24.7/lib/Data/GI/CodeGen/Transfer.hs 2021-02-21 19:01:48.475707926 -0500
@@ -51,7 +51,7 @@
-- run in the exception handler, so any type which we ref/allocate
-- with the expectation that the called function will consume it (on
-- TransferEverything) should be freed here.
-basicFreeFnOnError :: Type -> Transfer -> CodeGen (Maybe Text)
+basicFreeFnOnError :: Type -> Transfer -> CodeGen e (Maybe Text)
basicFreeFnOnError (TBasicType TUTF8) _ = return $ Just "freeMem"
basicFreeFnOnError (TBasicType TFileName) _ = return $ Just "freeMem"
basicFreeFnOnError (TBasicType _) _ = return Nothing
@@ -119,7 +119,7 @@
basicFreeFnOnError (TError) _ = return Nothing
-- Free just the container, but not the elements.
-freeContainer :: Type -> Text -> CodeGen [Text]
+freeContainer :: Type -> Text -> CodeGen e [Text]
freeContainer t label =
case basicFreeFn t of
Nothing -> return []
@@ -228,7 +228,7 @@
<> label
freeInGHashTable TransferNothing label = return ["unrefGHashTable " <> label]
-freeOut :: Text -> CodeGen [Text]
+freeOut :: Text -> CodeGen e [Text]
freeOut label = return ["freeMem " <> label]
-- | Given an input argument to a C callable, and its label in the code,
dev-haskell/haskell-gi/haskell-gi-0.24.7.ebuild
0 → 100644
View file @
735a10ff
# Copyright 1999-2020 Gentoo Authors
# Distributed under the terms of the GNU General Public License v2
EAPI
=
7
# ebuild generated by hackport 0.6.6.9999
CABAL_FEATURES
=
"lib profile haddock hoogle hscolour test-suite"
inherit haskell-cabal
DESCRIPTION
=
"Generate Haskell bindings for GObject Introspection capable libraries"
HOMEPAGE
=
"https://github.com/haskell-gi/haskell-gi"
SRC_URI
=
"https://hackage.haskell.org/package/
${
P
}
/
${
P
}
.tar.gz"
LICENSE
=
"LGPL-2.1"
SLOT
=
"0/
${
PV
}
"
KEYWORDS
=
"~amd64 ~x86"
IUSE
=
""
RESTRICT
=
test
# doctests tests fail
RDEPEND
=
">=dev-haskell/ansi-terminal-0.10:=[profile?]
>=dev-haskell/attoparsec-0.13:=[profile?]
>=dev-haskell/cabal-1.24:=[profile?]
>=dev-haskell/haskell-gi-base-0.24.5:=[profile?] <dev-haskell/haskell-gi-base-0.25:=[profile?]
>=dev-haskell/mtl-2.2:=[profile?]
dev-haskell/pretty-show:=[profile?]
>=dev-haskell/regex-tdfa-1.2:=[profile?]
dev-haskell/safe:=[profile?]
>=dev-haskell/text-1.0:=[profile?]
dev-haskell/xdg-basedir:=[profile?]
>=dev-haskell/xml-conduit-1.3:=[profile?]
>=dev-lang/ghc-8.0.1:=
dev-libs/glib:2
dev-libs/gobject-introspection
"
DEPEND
=
"
${
RDEPEND
}
>=dev-haskell/cabal-2.0
>=dev-haskell/cabal-doctest-1 <dev-haskell/cabal-doctest-1.1
virtual/pkgconfig
test? ( >=dev-haskell/doctest-0.8 )
"
src_prepare
()
{
default
eapply
"
${
FILESDIR
}
/
${
P
}
-ghc-9-compatibility.patch"
}
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment
