summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorinaki <>2018-04-16 07:41:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-04-16 07:41:00 (GMT)
commit2e6c53787758dc90f57d94e706a152c37b67a39a (patch)
tree82f8b4626f951796c4923f087d5c9503f8023b6b
parent29e49fd6b9ecd14e0db4a5f15d9fc31796ddf0e2 (diff)
version 0.21.10.21.1
-rw-r--r--haskell-gi.cabal6
-rw-r--r--lib/Data/GI/CodeGen/API.hs72
-rw-r--r--lib/Data/GI/CodeGen/Overrides.hs25
-rw-r--r--lib/Data/GI/GIR/Allocation.hs1
4 files changed, 85 insertions, 19 deletions
diff --git a/haskell-gi.cabal b/haskell-gi.cabal
index 3047163..c18556f 100644
--- a/haskell-gi.cabal
+++ b/haskell-gi.cabal
@@ -1,5 +1,5 @@
name: haskell-gi
-version: 0.21.0
+version: 0.21.1
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.
@@ -14,7 +14,7 @@ maintainer: Iñaki García Etxebarria (garetxe@gmail.com)
stability: Experimental
category: Development
build-type: Simple
-tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1
+tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1, GHC == 8.4.1
cabal-version: >=1.8
extra-source-files: ChangeLog.md
@@ -27,7 +27,7 @@ Library
pkgconfig-depends: gobject-introspection-1.0 >= 1.32, gobject-2.0 >= 2.32
build-depends: base >= 4.7 && < 5,
haskell-gi-base == 0.21.*,
- Cabal >= 1.20,
+ Cabal >= 1.24,
attoparsec == 0.13.*,
containers,
directory,
diff --git a/lib/Data/GI/CodeGen/API.hs b/lib/Data/GI/CodeGen/API.hs
index f120348..e58ff82 100644
--- a/lib/Data/GI/CodeGen/API.hs
+++ b/lib/Data/GI/CodeGen/API.hs
@@ -58,7 +58,7 @@ module Data.GI.CodeGen.API
import Control.Applicative ((<$>))
#endif
-import Control.Monad ((>=>), forM, forM_)
+import Control.Monad ((>=>), foldM, forM, forM_)
import qualified Data.List as L
import qualified Data.Map as M
import Data.Maybe (mapMaybe, catMaybes)
@@ -149,7 +149,11 @@ data GIRNameTag = GIRPlainName Text
-- | A rule for modifying the GIR file.
data GIRRule = GIRSetAttr (GIRPath, XML.Name) Text -- ^ (Path to element,
- -- attrName), newValue
+ -- attrName), newValue.
+ | GIRAddNode GIRPath XML.Name -- ^ Add a child node at
+ -- the given selector.
+ | GIRDeleteNode GIRPath -- ^ Delete any nodes matching
+ -- the given selector.
deriving (Show)
data API
@@ -456,28 +460,66 @@ fixupGIRDocument rules doc =
-- otherwise return the element ummodified.
fixupGIR :: [GIRRule] -> XML.Element -> XML.Element
fixupGIR rules elem =
- elem {XML.elementNodes = map (\e -> foldr applyGIRRule e rules)
- (XML.elementNodes elem)}
- where applyGIRRule :: GIRRule -> XML.Node -> XML.Node
- applyGIRRule (GIRSetAttr (path, attr) newVal) n =
- girSetAttr (path, attr) newVal n
+ elem {XML.elementNodes =
+ mapMaybe (\e -> foldM applyGIRRule e rules) (XML.elementNodes elem)}
+ where applyGIRRule :: XML.Node -> GIRRule -> Maybe XML.Node
+ applyGIRRule n (GIRSetAttr (path, attr) newVal) =
+ Just $ girSetAttr (path, attr) newVal n
+ applyGIRRule n (GIRAddNode path new) =
+ Just $ girAddNode path new n
+ applyGIRRule n (GIRDeleteNode path) =
+ girDeleteNodes path n
-- | Set an attribute for the child element specified by the given
-- path.
girSetAttr :: (GIRPath, XML.Name) -> Text -> XML.Node -> XML.Node
girSetAttr (spec:rest, attr) newVal n@(XML.NodeElement elem) =
if specMatch spec n
- then if null rest -- Matched the full path, apply
- then XML.NodeElement (elem {XML.elementAttributes =
- M.insert attr newVal
- (XML.elementAttributes elem)})
- -- Still some selectors to apply
- else XML.NodeElement (elem {XML.elementNodes =
- map (girSetAttr (rest, attr) newVal)
- (XML.elementNodes elem)})
+ then case rest of
+ -- Matched the full path, apply
+ [] -> XML.NodeElement (elem {XML.elementAttributes =
+ M.insert attr newVal
+ (XML.elementAttributes elem)})
+ -- Still some selectors to apply
+ _ -> XML.NodeElement (elem {XML.elementNodes =
+ map (girSetAttr (rest, attr) newVal)
+ (XML.elementNodes elem)})
else n
girSetAttr _ _ n = n
+-- | Add the given subnode to any nodes matching the given path
+girAddNode :: GIRPath -> XML.Name -> XML.Node -> XML.Node
+girAddNode (spec:rest) newNode n@(XML.NodeElement elem) =
+ if specMatch spec n
+ then case rest of
+ -- Matched the full path, add the new child node.
+ [] -> let newElement = XML.Element { elementName = newNode
+ , elementAttributes = M.empty
+ , elementNodes = [] }
+ in XML.NodeElement (elem {XML.elementNodes =
+ XML.elementNodes elem <>
+ [XML.NodeElement newElement]})
+ -- Still some selectors to apply.
+ _ -> XML.NodeElement (elem {XML.elementNodes =
+ map (girAddNode rest newNode)
+ (XML.elementNodes elem)})
+ else n
+girAddNode _ _ n = n
+
+-- | Delete any nodes matching the given path.
+girDeleteNodes :: GIRPath -> XML.Node -> Maybe XML.Node
+girDeleteNodes (spec:rest) n@(XML.NodeElement elem) =
+ if specMatch spec n
+ then case rest of
+ -- Matched the full path, discard the node
+ [] -> Nothing
+ -- More selectors to apply
+ _ -> Just $ XML.NodeElement (elem {XML.elementNodes =
+ mapMaybe (girDeleteNodes rest)
+ (XML.elementNodes elem)})
+ else Just n
+girDeleteNodes _ n = Just n
+
-- | Lookup the given attribute and if present see if it matches the
-- given regex.
lookupAndMatch :: GIRNameTag -> M.Map XML.Name Text -> XML.Name -> Bool
diff --git a/lib/Data/GI/CodeGen/Overrides.hs b/lib/Data/GI/CodeGen/Overrides.hs
index e97e2b8..668bee8 100644
--- a/lib/Data/GI/CodeGen/Overrides.hs
+++ b/lib/Data/GI/CodeGen/Overrides.hs
@@ -162,6 +162,10 @@ parseOneLine (T.stripPrefix "namespace-version " -> Just s) =
withFlags $ parseNsVersion s
parseOneLine (T.stripPrefix "set-attr " -> Just s) =
withFlags $ parseSetAttr s
+parseOneLine (T.stripPrefix "add-node " -> Just s) =
+ withFlags $ parseAdd s
+parseOneLine (T.stripPrefix "delete-node " -> Just s) =
+ withFlags $ parseDelete s
parseOneLine (T.stripPrefix "C-docs-url " -> Just u) =
withFlags $ parseDocsUrl u
parseOneLine (T.stripPrefix "if " -> Just s) = parseIf s
@@ -255,6 +259,27 @@ parseSetAttr t =
"\t\"set-attr nodePath attrName newValue\"\n" <>
"Got \"set-attr " <> t <> "\" instead.")
+-- | Add the given child node to all nodes matching the path.
+parseAdd :: Text -> Parser ()
+parseAdd (T.words -> [path, name]) = do
+ pathSpec <- parsePathSpec path
+ parsedName <- parseXMLName name
+ tell $ defaultOverrides {girFixups = [GIRAddNode pathSpec parsedName]}
+parseAdd t =
+ throwError ("add-node syntax is of the form\n" <>
+ "\t\"add-node nodePath newName\"\n" <>
+ "Got \"add-node " <> t <> "\" instead.")
+
+-- | Delete all nodes matching the given path.
+parseDelete :: Text -> Parser ()
+parseDelete (T.words -> [path]) = do
+ pathSpec <- parsePathSpec path
+ tell $ defaultOverrides {girFixups = [GIRDeleteNode pathSpec]}
+parseDelete t =
+ throwError ("delete-node syntax is of the form\n" <>
+ "\t\"delete-node nodePath\"\n" <>
+ "Got \"delete-node " <> t <> "\" instead.")
+
-- | Parse a documentation URL for the given module.
parseDocsUrl :: Text -> Parser ()
parseDocsUrl (T.words -> [ns, url]) = do
diff --git a/lib/Data/GI/GIR/Allocation.hs b/lib/Data/GI/GIR/Allocation.hs
index 586d2a5..dfbfdac 100644
--- a/lib/Data/GI/GIR/Allocation.hs
+++ b/lib/Data/GI/GIR/Allocation.hs
@@ -27,5 +27,4 @@ unknownAllocationInfo = AllocationInfo {
allocCalloc = AllocationOpUnknown
, allocCopy = AllocationOpUnknown
, allocFree = AllocationOpUnknown
-
}