{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
module Data.GI.CodeGen.API
( API(..)
, GIRInfo(..)
, loadGIRInfo
, loadRawGIRInfo
, GIRRule(..)
, GIRPath
, GIRNodeSpec(..)
, GIRNameTag(..)
, Name(..)
, Transfer(..)
, AllocationInfo(..)
, AllocationOp(..)
, unknownAllocationInfo
, Direction(..)
, Scope(..)
, DeprecationInfo
, EnumerationMember(..)
, PropertyFlag(..)
, MethodType(..)
, Constant(..)
, Arg(..)
, Callable(..)
, Function(..)
, Signal(..)
, Property(..)
, Field(..)
, Struct(..)
, Callback(..)
, Interface(..)
, Method(..)
, Object(..)
, Enumeration(..)
, Flags (..)
, Union (..)
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Monad ((>=>), foldM, forM, when)
import qualified Data.List as L
import qualified Data.Map as M
import Data.Maybe (mapMaybe, catMaybes)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import qualified Data.Set as S
import qualified Data.Text as T
import Data.Text (Text)
import Foreign.Ptr (Ptr)
import Foreign (peek)
import Foreign.C.Types (CUInt)
import Text.XML hiding (Name)
import qualified Text.XML as XML
import Text.Regex.TDFA ((=~))
import Data.GI.GIR.Alias (documentListAliases)
import Data.GI.GIR.Allocation (AllocationInfo(..), AllocationOp(..), unknownAllocationInfo)
import Data.GI.GIR.Arg (Arg(..), Direction(..), Scope(..))
import Data.GI.GIR.BasicTypes (Alias, Name(..), Transfer(..))
import Data.GI.GIR.Callable (Callable(..))
import Data.GI.GIR.Callback (Callback(..), parseCallback)
import Data.GI.GIR.Constant (Constant(..), parseConstant)
import Data.GI.GIR.Deprecation (DeprecationInfo)
import Data.GI.GIR.Enum (Enumeration(..), EnumerationMember(..), parseEnum)
import Data.GI.GIR.Field (Field(..))
import Data.GI.GIR.Flags (Flags(..), parseFlags)
import Data.GI.GIR.Function (Function(..), parseFunction)
import Data.GI.GIR.Interface (Interface(..), parseInterface)
import Data.GI.GIR.Method (Method(..), MethodType(..))
import Data.GI.GIR.Object (Object(..), parseObject)
import Data.GI.GIR.Parser (Parser, runParser)
import Data.GI.GIR.Property (Property(..), PropertyFlag(..))
import Data.GI.GIR.Repository (readGiRepository)
import Data.GI.GIR.Signal (Signal(..))
import Data.GI.GIR.Struct (Struct(..), parseStruct)
import Data.GI.GIR.Union (Union(..), parseUnion)
import Data.GI.GIR.XMLUtils (subelements, childElemsWithLocalName, lookupAttr,
lookupAttrWithNamespace, GIRXMLNamespace(..),
xmlLocalName)
import Data.GI.Base.BasicConversions (unpackStorableArrayWithLength)
import Data.GI.Base.BasicTypes (GType(..), CGType, gtypeName)
import Data.GI.Base.Utils (allocMem, freeMem)
import Data.GI.CodeGen.LibGIRepository (girRequire, Typelib, FieldInfo(..),
girStructFieldInfo, girUnionFieldInfo,
girLoadGType, girIsSymbolResolvable)
import Data.GI.CodeGen.GType (gtypeIsBoxed)
import Data.GI.CodeGen.Type (Type)
import Data.GI.CodeGen.Util (printWarning, terror, tshow)
data GIRInfo = GIRInfo {
GIRInfo -> [Text]
girPCPackages :: [Text],
GIRInfo -> Text
girNSName :: Text,
GIRInfo -> Text
girNSVersion :: Text,
GIRInfo -> [(Name, API)]
girAPIs :: [(Name, API)],
GIRInfo -> Map Text Name
girCTypes :: M.Map Text Name
} deriving Int -> GIRInfo -> ShowS
[GIRInfo] -> ShowS
GIRInfo -> String
(Int -> GIRInfo -> ShowS)
-> (GIRInfo -> String) -> ([GIRInfo] -> ShowS) -> Show GIRInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GIRInfo] -> ShowS
$cshowList :: [GIRInfo] -> ShowS
show :: GIRInfo -> String
$cshow :: GIRInfo -> String
showsPrec :: Int -> GIRInfo -> ShowS
$cshowsPrec :: Int -> GIRInfo -> ShowS
Show
data GIRNamespace = GIRNamespace {
GIRNamespace -> Text
nsName :: Text,
GIRNamespace -> Text
nsVersion :: Text,
GIRNamespace -> [(Name, API)]
nsAPIs :: [(Name, API)],
GIRNamespace -> [(Text, Name)]
nsCTypes :: [(Text, Name)]
} deriving (Int -> GIRNamespace -> ShowS
[GIRNamespace] -> ShowS
GIRNamespace -> String
(Int -> GIRNamespace -> ShowS)
-> (GIRNamespace -> String)
-> ([GIRNamespace] -> ShowS)
-> Show GIRNamespace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GIRNamespace] -> ShowS
$cshowList :: [GIRNamespace] -> ShowS
show :: GIRNamespace -> String
$cshow :: GIRNamespace -> String
showsPrec :: Int -> GIRNamespace -> ShowS
$cshowsPrec :: Int -> GIRNamespace -> ShowS
Show)
data GIRInfoParse = GIRInfoParse {
GIRInfoParse -> [Maybe Text]
girIPPackage :: [Maybe Text],
GIRInfoParse -> [Maybe (Text, Text)]
girIPIncludes :: [Maybe (Text, Text)],
GIRInfoParse -> [Maybe GIRNamespace]
girIPNamespaces :: [Maybe GIRNamespace]
} deriving (Int -> GIRInfoParse -> ShowS
[GIRInfoParse] -> ShowS
GIRInfoParse -> String
(Int -> GIRInfoParse -> ShowS)
-> (GIRInfoParse -> String)
-> ([GIRInfoParse] -> ShowS)
-> Show GIRInfoParse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GIRInfoParse] -> ShowS
$cshowList :: [GIRInfoParse] -> ShowS
show :: GIRInfoParse -> String
$cshow :: GIRInfoParse -> String
showsPrec :: Int -> GIRInfoParse -> ShowS
$cshowsPrec :: Int -> GIRInfoParse -> ShowS
Show)
type GIRPath = [GIRNodeSpec]
data GIRNodeSpec = GIRNamed GIRNameTag
| GIRType Text
| GIRTypedName Text GIRNameTag
deriving (Int -> GIRNodeSpec -> ShowS
[GIRNodeSpec] -> ShowS
GIRNodeSpec -> String
(Int -> GIRNodeSpec -> ShowS)
-> (GIRNodeSpec -> String)
-> ([GIRNodeSpec] -> ShowS)
-> Show GIRNodeSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GIRNodeSpec] -> ShowS
$cshowList :: [GIRNodeSpec] -> ShowS
show :: GIRNodeSpec -> String
$cshow :: GIRNodeSpec -> String
showsPrec :: Int -> GIRNodeSpec -> ShowS
$cshowsPrec :: Int -> GIRNodeSpec -> ShowS
Show)
data GIRNameTag = GIRPlainName Text
| GIRRegex Text
deriving (Int -> GIRNameTag -> ShowS
[GIRNameTag] -> ShowS
GIRNameTag -> String
(Int -> GIRNameTag -> ShowS)
-> (GIRNameTag -> String)
-> ([GIRNameTag] -> ShowS)
-> Show GIRNameTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GIRNameTag] -> ShowS
$cshowList :: [GIRNameTag] -> ShowS
show :: GIRNameTag -> String
$cshow :: GIRNameTag -> String
showsPrec :: Int -> GIRNameTag -> ShowS
$cshowsPrec :: Int -> GIRNameTag -> ShowS
Show)
data GIRRule = GIRSetAttr (GIRPath, XML.Name) Text
| GIRDeleteAttr GIRPath XML.Name
| GIRAddNode GIRPath XML.Name
| GIRDeleteNode GIRPath
deriving (Int -> GIRRule -> ShowS
[GIRRule] -> ShowS
GIRRule -> String
(Int -> GIRRule -> ShowS)
-> (GIRRule -> String) -> ([GIRRule] -> ShowS) -> Show GIRRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GIRRule] -> ShowS
$cshowList :: [GIRRule] -> ShowS
show :: GIRRule -> String
$cshow :: GIRRule -> String
showsPrec :: Int -> GIRRule -> ShowS
$cshowsPrec :: Int -> GIRRule -> ShowS
Show)
data API
= APIConst Constant
| APIFunction Function
| APICallback Callback
| APIEnum Enumeration
| APIFlags Flags
| APIInterface Interface
| APIObject Object
| APIStruct Struct
| APIUnion Union
deriving Int -> API -> ShowS
[API] -> ShowS
API -> String
(Int -> API -> ShowS)
-> (API -> String) -> ([API] -> ShowS) -> Show API
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [API] -> ShowS
$cshowList :: [API] -> ShowS
show :: API -> String
$cshow :: API -> String
showsPrec :: Int -> API -> ShowS
$cshowsPrec :: Int -> API -> ShowS
Show
parseAPI :: Text -> M.Map Alias Type -> Element -> (a -> API)
-> Parser (Name, a) -> (Name, API)
parseAPI :: Text
-> Map Alias Type
-> Element
-> (a -> API)
-> Parser (Name, a)
-> (Name, API)
parseAPI ns :: Text
ns aliases :: Map Alias Type
aliases element :: Element
element wrapper :: a -> API
wrapper parser :: Parser (Name, a)
parser =
case Text
-> Map Alias Type
-> Element
-> Parser (Name, a)
-> Either Text (Name, a)
forall a.
Text -> Map Alias Type -> Element -> Parser a -> Either Text a
runParser Text
ns Map Alias Type
aliases Element
element Parser (Name, a)
parser of
Left err :: Text
err -> String -> (Name, API)
forall a. HasCallStack => String -> a
error (String -> (Name, API)) -> String -> (Name, API)
forall a b. (a -> b) -> a -> b
$ "Parse error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
err
Right (n :: Name
n, a :: a
a) -> (Name
n, a -> API
wrapper a
a)
parseNSElement :: M.Map Alias Type -> GIRNamespace -> Element -> GIRNamespace
parseNSElement :: Map Alias Type -> GIRNamespace -> Element -> GIRNamespace
parseNSElement aliases :: Map Alias Type
aliases ns :: GIRNamespace
ns@GIRNamespace{..} element :: Element
element
| Name -> Element -> Maybe Text
lookupAttr "introspectable" Element
element Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just "0" = GIRNamespace
ns
| Bool
otherwise =
case Name -> Text
nameLocalName (Element -> Name
elementName Element
element) of
"alias" -> GIRNamespace
ns
"constant" -> (Constant -> API) -> Parser (Name, Constant) -> GIRNamespace
forall a. (a -> API) -> Parser (Name, a) -> GIRNamespace
parse Constant -> API
APIConst Parser (Name, Constant)
parseConstant
"enumeration" -> (Enumeration -> API) -> Parser (Name, Enumeration) -> GIRNamespace
forall a. (a -> API) -> Parser (Name, a) -> GIRNamespace
parse Enumeration -> API
APIEnum Parser (Name, Enumeration)
parseEnum
"bitfield" -> (Flags -> API) -> Parser (Name, Flags) -> GIRNamespace
forall a. (a -> API) -> Parser (Name, a) -> GIRNamespace
parse Flags -> API
APIFlags Parser (Name, Flags)
parseFlags
"function" -> (Function -> API) -> Parser (Name, Function) -> GIRNamespace
forall a. (a -> API) -> Parser (Name, a) -> GIRNamespace
parse Function -> API
APIFunction Parser (Name, Function)
parseFunction
"callback" -> (Callback -> API) -> Parser (Name, Callback) -> GIRNamespace
forall a. (a -> API) -> Parser (Name, a) -> GIRNamespace
parse Callback -> API
APICallback Parser (Name, Callback)
parseCallback
"record" -> (Struct -> API) -> Parser (Name, Struct) -> GIRNamespace
forall a. (a -> API) -> Parser (Name, a) -> GIRNamespace
parse Struct -> API
APIStruct Parser (Name, Struct)
parseStruct
"union" -> (Union -> API) -> Parser (Name, Union) -> GIRNamespace
forall a. (a -> API) -> Parser (Name, a) -> GIRNamespace
parse Union -> API
APIUnion Parser (Name, Union)
parseUnion
"class" -> (Object -> API) -> Parser (Name, Object) -> GIRNamespace
forall a. (a -> API) -> Parser (Name, a) -> GIRNamespace
parse Object -> API
APIObject Parser (Name, Object)
parseObject
"interface" -> (Interface -> API) -> Parser (Name, Interface) -> GIRNamespace
forall a. (a -> API) -> Parser (Name, a) -> GIRNamespace
parse Interface -> API
APIInterface Parser (Name, Interface)
parseInterface
"boxed" -> GIRNamespace
ns
"docsection" -> GIRNamespace
ns
n :: Text
n -> String -> GIRNamespace
forall a. HasCallStack => String -> a
error (String -> GIRNamespace)
-> (Text -> String) -> Text -> GIRNamespace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> GIRNamespace) -> Text -> GIRNamespace
forall a b. (a -> b) -> a -> b
$ "Unknown GIR element \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\" when processing namespace \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nsName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\", aborting."
where parse :: (a -> API) -> Parser (Name, a) -> GIRNamespace
parse :: (a -> API) -> Parser (Name, a) -> GIRNamespace
parse wrapper :: a -> API
wrapper parser :: Parser (Name, a)
parser =
let (n :: Name
n, api :: API
api) = Text
-> Map Alias Type
-> Element
-> (a -> API)
-> Parser (Name, a)
-> (Name, API)
forall a.
Text
-> Map Alias Type
-> Element
-> (a -> API)
-> Parser (Name, a)
-> (Name, API)
parseAPI Text
nsName Map Alias Type
aliases Element
element a -> API
wrapper Parser (Name, a)
parser
maybeCType :: Maybe Text
maybeCType = GIRXMLNamespace -> Name -> Element -> Maybe Text
lookupAttrWithNamespace GIRXMLNamespace
CGIRNS "type" Element
element
in GIRNamespace
ns { nsAPIs :: [(Name, API)]
nsAPIs = (Name
n, API
api) (Name, API) -> [(Name, API)] -> [(Name, API)]
forall a. a -> [a] -> [a]
: [(Name, API)]
nsAPIs,
nsCTypes :: [(Text, Name)]
nsCTypes = case Maybe Text
maybeCType of
Just ctype :: Text
ctype -> (Text
ctype, Name
n) (Text, Name) -> [(Text, Name)] -> [(Text, Name)]
forall a. a -> [a] -> [a]
: [(Text, Name)]
nsCTypes
Nothing -> [(Text, Name)]
nsCTypes
}
parseNamespace :: Element -> M.Map Alias Type -> Maybe GIRNamespace
parseNamespace :: Element -> Map Alias Type -> Maybe GIRNamespace
parseNamespace element :: Element
element aliases :: Map Alias Type
aliases = do
let attrs :: Map Name Text
attrs = Element -> Map Name Text
elementAttributes Element
element
Text
name <- Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup "name" Map Name Text
attrs
Text
version <- Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup "version" Map Name Text
attrs
let ns :: GIRNamespace
ns = GIRNamespace :: Text -> Text -> [(Name, API)] -> [(Text, Name)] -> GIRNamespace
GIRNamespace {
nsName :: Text
nsName = Text
name,
nsVersion :: Text
nsVersion = Text
version,
nsAPIs :: [(Name, API)]
nsAPIs = [],
nsCTypes :: [(Text, Name)]
nsCTypes = []
}
GIRNamespace -> Maybe GIRNamespace
forall (m :: * -> *) a. Monad m => a -> m a
return ((GIRNamespace -> Element -> GIRNamespace)
-> GIRNamespace -> [Element] -> GIRNamespace
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (Map Alias Type -> GIRNamespace -> Element -> GIRNamespace
parseNSElement Map Alias Type
aliases) GIRNamespace
ns (Element -> [Element]
subelements Element
element))
parseInclude :: Element -> Maybe (Text, Text)
parseInclude :: Element -> Maybe (Text, Text)
parseInclude element :: Element
element = do
Text
name <- Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup "name" Map Name Text
attrs
Text
version <- Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup "version" Map Name Text
attrs
(Text, Text) -> Maybe (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
name, Text
version)
where attrs :: Map Name Text
attrs = Element -> Map Name Text
elementAttributes Element
element
parsePackage :: Element -> Maybe Text
parsePackage :: Element -> Maybe Text
parsePackage element :: Element
element = Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup "name" (Element -> Map Name Text
elementAttributes Element
element)
parseRootElement :: M.Map Alias Type -> GIRInfoParse -> Element -> GIRInfoParse
parseRootElement :: Map Alias Type -> GIRInfoParse -> Element -> GIRInfoParse
parseRootElement aliases :: Map Alias Type
aliases info :: GIRInfoParse
info@GIRInfoParse{..} element :: Element
element =
case Name -> Text
nameLocalName (Element -> Name
elementName Element
element) of
"include" -> GIRInfoParse
info {girIPIncludes :: [Maybe (Text, Text)]
girIPIncludes = Element -> Maybe (Text, Text)
parseInclude Element
element Maybe (Text, Text) -> [Maybe (Text, Text)] -> [Maybe (Text, Text)]
forall a. a -> [a] -> [a]
: [Maybe (Text, Text)]
girIPIncludes}
"package" -> GIRInfoParse
info {girIPPackage :: [Maybe Text]
girIPPackage = Element -> Maybe Text
parsePackage Element
element Maybe Text -> [Maybe Text] -> [Maybe Text]
forall a. a -> [a] -> [a]
: [Maybe Text]
girIPPackage}
"namespace" -> GIRInfoParse
info {girIPNamespaces :: [Maybe GIRNamespace]
girIPNamespaces = Element -> Map Alias Type -> Maybe GIRNamespace
parseNamespace Element
element Map Alias Type
aliases Maybe GIRNamespace -> [Maybe GIRNamespace] -> [Maybe GIRNamespace]
forall a. a -> [a] -> [a]
: [Maybe GIRNamespace]
girIPNamespaces}
_ -> GIRInfoParse
info
emptyGIRInfoParse :: GIRInfoParse
emptyGIRInfoParse :: GIRInfoParse
emptyGIRInfoParse = GIRInfoParse :: [Maybe Text]
-> [Maybe (Text, Text)] -> [Maybe GIRNamespace] -> GIRInfoParse
GIRInfoParse {
girIPPackage :: [Maybe Text]
girIPPackage = [],
girIPIncludes :: [Maybe (Text, Text)]
girIPIncludes = [],
girIPNamespaces :: [Maybe GIRNamespace]
girIPNamespaces = []
}
parseGIRDocument :: M.Map Alias Type -> Document -> GIRInfoParse
parseGIRDocument :: Map Alias Type -> Document -> GIRInfoParse
parseGIRDocument aliases :: Map Alias Type
aliases doc :: Document
doc = (GIRInfoParse -> Element -> GIRInfoParse)
-> GIRInfoParse -> [Element] -> GIRInfoParse
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (Map Alias Type -> GIRInfoParse -> Element -> GIRInfoParse
parseRootElement Map Alias Type
aliases) GIRInfoParse
emptyGIRInfoParse (Element -> [Element]
subelements (Document -> Element
documentRoot Document
doc))
documentListIncludes :: Document -> S.Set (Text, Text)
documentListIncludes :: Document -> Set (Text, Text)
documentListIncludes doc :: Document
doc = [(Text, Text)] -> Set (Text, Text)
forall a. Ord a => [a] -> Set a
S.fromList ((Element -> Maybe (Text, Text)) -> [Element] -> [(Text, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Element -> Maybe (Text, Text)
parseInclude [Element]
includes)
where includes :: [Element]
includes = Text -> Element -> [Element]
childElemsWithLocalName "include" (Document -> Element
documentRoot Document
doc)
loadDependencies :: Bool
-> S.Set (Text, Text)
-> M.Map (Text, Text) Document
-> [FilePath]
-> [GIRRule]
-> IO (M.Map (Text, Text) Document)
loadDependencies :: Bool
-> Set (Text, Text)
-> Map (Text, Text) Document
-> [String]
-> [GIRRule]
-> IO (Map (Text, Text) Document)
loadDependencies verbose :: Bool
verbose requested :: Set (Text, Text)
requested loaded :: Map (Text, Text) Document
loaded extraPaths :: [String]
extraPaths rules :: [GIRRule]
rules
| Set (Text, Text) -> Bool
forall a. Set a -> Bool
S.null Set (Text, Text)
requested = Map (Text, Text) Document -> IO (Map (Text, Text) Document)
forall (m :: * -> *) a. Monad m => a -> m a
return Map (Text, Text) Document
loaded
| Bool
otherwise = do
let (name :: Text
name, version :: Text
version) = Int -> Set (Text, Text) -> (Text, Text)
forall a. Int -> Set a -> a
S.elemAt 0 Set (Text, Text)
requested
Document
doc <- [GIRRule] -> Document -> Document
overrideGIRDocument [GIRRule]
rules (Document -> Document) -> IO Document -> IO Document
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Bool -> Text -> Maybe Text -> [String] -> IO Document
readGiRepository Bool
verbose Text
name (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
version) [String]
extraPaths
let newLoaded :: Map (Text, Text) Document
newLoaded = (Text, Text)
-> Document
-> Map (Text, Text) Document
-> Map (Text, Text) Document
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Text
name, Text
version) Document
doc Map (Text, Text) Document
loaded
loadedSet :: Set (Text, Text)
loadedSet = [(Text, Text)] -> Set (Text, Text)
forall a. Ord a => [a] -> Set a
S.fromList (Map (Text, Text) Document -> [(Text, Text)]
forall k a. Map k a -> [k]
M.keys Map (Text, Text) Document
newLoaded)
newRequested :: Set (Text, Text)
newRequested = Set (Text, Text) -> Set (Text, Text) -> Set (Text, Text)
forall a. Ord a => Set a -> Set a -> Set a
S.union Set (Text, Text)
requested (Document -> Set (Text, Text)
documentListIncludes Document
doc)
notYetLoaded :: Set (Text, Text)
notYetLoaded = Set (Text, Text) -> Set (Text, Text) -> Set (Text, Text)
forall a. Ord a => Set a -> Set a -> Set a
S.difference Set (Text, Text)
newRequested Set (Text, Text)
loadedSet
Bool
-> Set (Text, Text)
-> Map (Text, Text) Document
-> [String]
-> [GIRRule]
-> IO (Map (Text, Text) Document)
loadDependencies Bool
verbose Set (Text, Text)
notYetLoaded Map (Text, Text) Document
newLoaded [String]
extraPaths [GIRRule]
rules
loadGIRFile :: Bool
-> Text
-> Maybe Text
-> [FilePath]
-> [GIRRule]
-> IO (Document,
M.Map (Text, Text) Document)
loadGIRFile :: Bool
-> Text
-> Maybe Text
-> [String]
-> [GIRRule]
-> IO (Document, Map (Text, Text) Document)
loadGIRFile verbose :: Bool
verbose name :: Text
name version :: Maybe Text
version extraPaths :: [String]
extraPaths rules :: [GIRRule]
rules = do
Document
doc <- [GIRRule] -> Document -> Document
overrideGIRDocument [GIRRule]
rules (Document -> Document) -> IO Document -> IO Document
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Bool -> Text -> Maybe Text -> [String] -> IO Document
readGiRepository Bool
verbose Text
name Maybe Text
version [String]
extraPaths
Map (Text, Text) Document
deps <- Bool
-> Set (Text, Text)
-> Map (Text, Text) Document
-> [String]
-> [GIRRule]
-> IO (Map (Text, Text) Document)
loadDependencies Bool
verbose (Document -> Set (Text, Text)
documentListIncludes Document
doc) Map (Text, Text) Document
forall k a. Map k a
M.empty
[String]
extraPaths [GIRRule]
rules
(Document, Map (Text, Text) Document)
-> IO (Document, Map (Text, Text) Document)
forall (m :: * -> *) a. Monad m => a -> m a
return (Document
doc, Map (Text, Text) Document
deps)
toGIRInfo :: GIRInfoParse -> Either Text GIRInfo
toGIRInfo :: GIRInfoParse -> Either Text GIRInfo
toGIRInfo info :: GIRInfoParse
info =
case [Maybe GIRNamespace] -> [GIRNamespace]
forall a. [Maybe a] -> [a]
catMaybes (GIRInfoParse -> [Maybe GIRNamespace]
girIPNamespaces GIRInfoParse
info) of
[ns :: GIRNamespace
ns] -> GIRInfo -> Either Text GIRInfo
forall a b. b -> Either a b
Right GIRInfo :: [Text] -> Text -> Text -> [(Name, API)] -> Map Text Name -> GIRInfo
GIRInfo {
girPCPackages :: [Text]
girPCPackages = ([Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text])
-> (GIRInfoParse -> [Text]) -> GIRInfoParse -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Text] -> [Text])
-> (GIRInfoParse -> [Maybe Text]) -> GIRInfoParse -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GIRInfoParse -> [Maybe Text]
girIPPackage) GIRInfoParse
info
, girNSName :: Text
girNSName = GIRNamespace -> Text
nsName GIRNamespace
ns
, girNSVersion :: Text
girNSVersion = GIRNamespace -> Text
nsVersion GIRNamespace
ns
, girAPIs :: [(Name, API)]
girAPIs = [(Name, API)] -> [(Name, API)]
forall a. [a] -> [a]
reverse (GIRNamespace -> [(Name, API)]
nsAPIs GIRNamespace
ns)
, girCTypes :: Map Text Name
girCTypes = [(Text, Name)] -> Map Text Name
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (GIRNamespace -> [(Text, Name)]
nsCTypes GIRNamespace
ns)
}
[] -> Text -> Either Text GIRInfo
forall a b. a -> Either a b
Left "Found no valid namespace."
_ -> Text -> Either Text GIRInfo
forall a b. a -> Either a b
Left "Found multiple namespaces."
loadRawGIRInfo :: Bool
-> Text
-> Maybe Text
-> [FilePath]
-> IO GIRInfo
loadRawGIRInfo :: Bool -> Text -> Maybe Text -> [String] -> IO GIRInfo
loadRawGIRInfo verbose :: Bool
verbose name :: Text
name version :: Maybe Text
version extraPaths :: [String]
extraPaths = do
Document
doc <- Bool -> Text -> Maybe Text -> [String] -> IO Document
readGiRepository Bool
verbose Text
name Maybe Text
version [String]
extraPaths
case GIRInfoParse -> Either Text GIRInfo
toGIRInfo (Map Alias Type -> Document -> GIRInfoParse
parseGIRDocument Map Alias Type
forall k a. Map k a
M.empty Document
doc) of
Left err :: Text
err -> String -> IO GIRInfo
forall a. HasCallStack => String -> a
error (String -> IO GIRInfo) -> (Text -> String) -> Text -> IO GIRInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> IO GIRInfo) -> Text -> IO GIRInfo
forall a b. (a -> b) -> a -> b
$ "Error when raw parsing \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
Right docGIR :: GIRInfo
docGIR -> GIRInfo -> IO GIRInfo
forall (m :: * -> *) a. Monad m => a -> m a
return GIRInfo
docGIR
fixupGIRInfos :: Bool -> M.Map Text Typelib -> GIRInfo -> [GIRInfo]
-> IO (GIRInfo, [GIRInfo])
fixupGIRInfos :: Bool
-> Map Text Typelib
-> GIRInfo
-> [GIRInfo]
-> IO (GIRInfo, [GIRInfo])
fixupGIRInfos verbose :: Bool
verbose typelibMap :: Map Text Typelib
typelibMap doc :: GIRInfo
doc deps :: [GIRInfo]
deps =
(((Name, API) -> IO (Name, API))
-> (GIRInfo, [GIRInfo]) -> IO (GIRInfo, [GIRInfo])
fixup (Map Text Typelib -> Map Text Name -> (Name, API) -> IO (Name, API)
fixupInterface Map Text Typelib
typelibMap Map Text Name
ctypes) ((GIRInfo, [GIRInfo]) -> IO (GIRInfo, [GIRInfo]))
-> ((GIRInfo, [GIRInfo]) -> IO (GIRInfo, [GIRInfo]))
-> (GIRInfo, [GIRInfo])
-> IO (GIRInfo, [GIRInfo])
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
((Name, API) -> IO (Name, API))
-> (GIRInfo, [GIRInfo]) -> IO (GIRInfo, [GIRInfo])
fixup (Map Text Typelib -> (Name, API) -> IO (Name, API)
fixupStruct Map Text Typelib
typelibMap) ((GIRInfo, [GIRInfo]) -> IO (GIRInfo, [GIRInfo]))
-> ((GIRInfo, [GIRInfo]) -> IO (GIRInfo, [GIRInfo]))
-> (GIRInfo, [GIRInfo])
-> IO (GIRInfo, [GIRInfo])
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
((Name, API) -> IO (Name, API))
-> (GIRInfo, [GIRInfo]) -> IO (GIRInfo, [GIRInfo])
fixup (Name, API) -> IO (Name, API)
fixupUnion ((GIRInfo, [GIRInfo]) -> IO (GIRInfo, [GIRInfo]))
-> ((GIRInfo, [GIRInfo]) -> IO (GIRInfo, [GIRInfo]))
-> (GIRInfo, [GIRInfo])
-> IO (GIRInfo, [GIRInfo])
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
((Name, API) -> IO (Name, API))
-> (GIRInfo, [GIRInfo]) -> IO (GIRInfo, [GIRInfo])
fixup (Bool -> Map Text Typelib -> (Name, API) -> IO (Name, API)
fixupMissingSymbols Bool
verbose Map Text Typelib
typelibMap)
) (GIRInfo
doc, [GIRInfo]
deps)
where fixup :: ((Name, API) -> IO (Name, API))
-> (GIRInfo, [GIRInfo]) -> IO (GIRInfo, [GIRInfo])
fixup :: ((Name, API) -> IO (Name, API))
-> (GIRInfo, [GIRInfo]) -> IO (GIRInfo, [GIRInfo])
fixup fixer :: (Name, API) -> IO (Name, API)
fixer (doc :: GIRInfo
doc, deps :: [GIRInfo]
deps) = do
GIRInfo
fixedDoc <- ((Name, API) -> IO (Name, API)) -> GIRInfo -> IO GIRInfo
fixAPIs (Name, API) -> IO (Name, API)
fixer GIRInfo
doc
[GIRInfo]
fixedDeps <- (GIRInfo -> IO GIRInfo) -> [GIRInfo] -> IO [GIRInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((Name, API) -> IO (Name, API)) -> GIRInfo -> IO GIRInfo
fixAPIs (Name, API) -> IO (Name, API)
fixer) [GIRInfo]
deps
(GIRInfo, [GIRInfo]) -> IO (GIRInfo, [GIRInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return (GIRInfo
fixedDoc, [GIRInfo]
fixedDeps)
fixAPIs :: ((Name, API) -> IO (Name, API))
-> GIRInfo -> IO GIRInfo
fixAPIs :: ((Name, API) -> IO (Name, API)) -> GIRInfo -> IO GIRInfo
fixAPIs fixer :: (Name, API) -> IO (Name, API)
fixer info :: GIRInfo
info = do
[(Name, API)]
fixedAPIs <- ((Name, API) -> IO (Name, API))
-> [(Name, API)] -> IO [(Name, API)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Name, API) -> IO (Name, API)
fixer (GIRInfo -> [(Name, API)]
girAPIs GIRInfo
info)
GIRInfo -> IO GIRInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (GIRInfo -> IO GIRInfo) -> GIRInfo -> IO GIRInfo
forall a b. (a -> b) -> a -> b
$ GIRInfo
info {girAPIs :: [(Name, API)]
girAPIs = [(Name, API)]
fixedAPIs}
ctypes :: M.Map Text Name
ctypes :: Map Text Name
ctypes = [Map Text Name] -> Map Text Name
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ((GIRInfo -> Map Text Name) -> [GIRInfo] -> [Map Text Name]
forall a b. (a -> b) -> [a] -> [b]
map GIRInfo -> Map Text Name
girCTypes (GIRInfo
docGIRInfo -> [GIRInfo] -> [GIRInfo]
forall a. a -> [a] -> [a]
:[GIRInfo]
deps))
foreign import ccall "g_type_interface_prerequisites" g_type_interface_prerequisites :: CGType -> Ptr CUInt -> IO (Ptr CGType)
gtypeInterfaceListPrereqs :: GType -> IO [Text]
gtypeInterfaceListPrereqs :: GType -> IO [Text]
gtypeInterfaceListPrereqs (GType cgtype :: CGType
cgtype) = do
Ptr CUInt
nprereqsPtr <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
Ptr CGType
ps <- CGType -> Ptr CUInt -> IO (Ptr CGType)
g_type_interface_prerequisites CGType
cgtype Ptr CUInt
nprereqsPtr
CUInt
nprereqs <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
nprereqsPtr
[CGType]
psCGTypes <- CUInt -> Ptr CGType -> IO [CGType]
forall a b. (Integral a, Storable b) => a -> Ptr b -> IO [b]
unpackStorableArrayWithLength CUInt
nprereqs Ptr CGType
ps
Ptr CGType -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CGType
ps
Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
nprereqsPtr
(CGType -> IO Text) -> [CGType] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((String -> Text) -> IO String -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (IO String -> IO Text)
-> (CGType -> IO String) -> CGType -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GType -> IO String
gtypeName (GType -> IO String) -> (CGType -> GType) -> CGType -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CGType -> GType
GType) [CGType]
psCGTypes
fixupInterface :: M.Map Text Typelib -> M.Map Text Name -> (Name, API)
-> IO (Name, API)
fixupInterface :: Map Text Typelib -> Map Text Name -> (Name, API) -> IO (Name, API)
fixupInterface typelibMap :: Map Text Typelib
typelibMap csymbolMap :: Map Text Name
csymbolMap (n :: Name
n@(Name ns :: Text
ns _), APIInterface iface :: Interface
iface) = do
[Name]
prereqs <- case Interface -> Maybe Text
ifTypeInit Interface
iface of
Nothing -> [Name] -> IO [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just ti :: Text
ti -> do
GType
gtype <- case Text -> Map Text Typelib -> Maybe Typelib
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
ns Map Text Typelib
typelibMap of
Just typelib :: Typelib
typelib -> Typelib -> Text -> IO GType
girLoadGType Typelib
typelib Text
ti
Nothing -> String -> IO GType
forall a. HasCallStack => String -> a
error (String -> IO GType) -> String -> IO GType
forall a b. (a -> b) -> a -> b
$ "fi: Typelib for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
ns String -> ShowS
forall a. [a] -> [a] -> [a]
++ " not loaded."
[Text]
prereqGTypes <- GType -> IO [Text]
gtypeInterfaceListPrereqs GType
gtype
[Text] -> (Text -> IO Name) -> IO [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Text]
prereqGTypes ((Text -> IO Name) -> IO [Name]) -> (Text -> IO Name) -> IO [Name]
forall a b. (a -> b) -> a -> b
$ \p :: Text
p -> do
case Text -> Map Text Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
p Map Text Name
csymbolMap of
Just pn :: Name
pn -> Name -> IO Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
pn
Nothing -> String -> IO Name
forall a. HasCallStack => String -> a
error (String -> IO Name) -> String -> IO Name
forall a b. (a -> b) -> a -> b
$ "Could not find prerequisite type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ " for interface " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
n
(Name, API) -> IO (Name, API)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, Interface -> API
APIInterface (Interface
iface {ifPrerequisites :: [Name]
ifPrerequisites = [Name]
prereqs}))
fixupInterface _ _ (n :: Name
n, api :: API
api) = (Name, API) -> IO (Name, API)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, API
api)
fixupStruct :: M.Map Text Typelib -> (Name, API)
-> IO (Name, API)
fixupStruct :: Map Text Typelib -> (Name, API) -> IO (Name, API)
fixupStruct typelibMap :: Map Text Typelib
typelibMap (n :: Name
n, APIStruct s :: Struct
s) = do
Struct
fixed <- (Map Text Typelib -> Name -> Struct -> IO Struct
fixupStructIsBoxed Map Text Typelib
typelibMap Name
n (Struct -> IO Struct)
-> (Struct -> IO Struct) -> Struct -> IO Struct
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Name -> Struct -> IO Struct
fixupStructSizeAndOffsets Name
n) Struct
s
(Name, API) -> IO (Name, API)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, Struct -> API
APIStruct Struct
fixed)
fixupStruct _ api :: (Name, API)
api = (Name, API) -> IO (Name, API)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name, API)
api
fixupStructIsBoxed :: M.Map Text Typelib -> Name -> Struct -> IO Struct
fixupStructIsBoxed :: Map Text Typelib -> Name -> Struct -> IO Struct
fixupStructIsBoxed _ (Name "GLib" "Variant") s :: Struct
s =
Struct -> IO Struct
forall (m :: * -> *) a. Monad m => a -> m a
return (Struct
s {structIsBoxed :: Bool
structIsBoxed = Bool
False})
fixupStructIsBoxed typelibMap :: Map Text Typelib
typelibMap (Name ns :: Text
ns _) s :: Struct
s = do
Bool
isBoxed <- case Struct -> Maybe Text
structTypeInit Struct
s of
Nothing -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just ti :: Text
ti -> do
GType
gtype <- case Text -> Map Text Typelib -> Maybe Typelib
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
ns Map Text Typelib
typelibMap of
Just typelib :: Typelib
typelib -> Typelib -> Text -> IO GType
girLoadGType Typelib
typelib Text
ti
Nothing -> String -> IO GType
forall a. HasCallStack => String -> a
error (String -> IO GType) -> String -> IO GType
forall a b. (a -> b) -> a -> b
$ "fsib: Typelib for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
ns String -> ShowS
forall a. [a] -> [a] -> [a]
++ " not loaded."
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (GType -> Bool
gtypeIsBoxed GType
gtype)
Struct -> IO Struct
forall (m :: * -> *) a. Monad m => a -> m a
return (Struct
s {structIsBoxed :: Bool
structIsBoxed = Bool
isBoxed})
fixupStructSizeAndOffsets :: Name -> Struct -> IO Struct
fixupStructSizeAndOffsets :: Name -> Struct -> IO Struct
fixupStructSizeAndOffsets (Name ns :: Text
ns n :: Text
n) s :: Struct
s = do
(size :: Int
size, infoMap :: Map Text FieldInfo
infoMap) <- Text -> Text -> IO (Int, Map Text FieldInfo)
girStructFieldInfo Text
ns Text
n
Struct -> IO Struct
forall (m :: * -> *) a. Monad m => a -> m a
return (Struct
s { structSize :: Int
structSize = Int
size
, structFields :: [Field]
structFields = (Field -> Field) -> [Field] -> [Field]
forall a b. (a -> b) -> [a] -> [b]
map (Map Text FieldInfo -> Field -> Field
fixupField Map Text FieldInfo
infoMap) (Struct -> [Field]
structFields Struct
s)})
fixupUnion :: (Name, API) -> IO (Name, API)
fixupUnion :: (Name, API) -> IO (Name, API)
fixupUnion (n :: Name
n, APIUnion u :: Union
u) = do
Union
fixed <- (Name -> Union -> IO Union
fixupUnionSizeAndOffsets Name
n) Union
u
(Name, API) -> IO (Name, API)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, Union -> API
APIUnion Union
fixed)
fixupUnion api :: (Name, API)
api = (Name, API) -> IO (Name, API)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name, API)
api
fixupUnionSizeAndOffsets :: Name -> Union -> IO Union
fixupUnionSizeAndOffsets :: Name -> Union -> IO Union
fixupUnionSizeAndOffsets (Name ns :: Text
ns n :: Text
n) u :: Union
u = do
(size :: Int
size, infoMap :: Map Text FieldInfo
infoMap) <- Text -> Text -> IO (Int, Map Text FieldInfo)
girUnionFieldInfo Text
ns Text
n
Union -> IO Union
forall (m :: * -> *) a. Monad m => a -> m a
return (Union
u { unionSize :: Int
unionSize = Int
size
, unionFields :: [Field]
unionFields = (Field -> Field) -> [Field] -> [Field]
forall a b. (a -> b) -> [a] -> [b]
map (Map Text FieldInfo -> Field -> Field
fixupField Map Text FieldInfo
infoMap) (Union -> [Field]
unionFields Union
u)})
fixupField :: M.Map Text FieldInfo -> Field -> Field
fixupField :: Map Text FieldInfo -> Field -> Field
fixupField offsetMap :: Map Text FieldInfo
offsetMap f :: Field
f =
Field
f {fieldOffset :: Int
fieldOffset = case Text -> Map Text FieldInfo -> Maybe FieldInfo
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Field -> Text
fieldName Field
f) Map Text FieldInfo
offsetMap of
Nothing -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ "Could not find field "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show (Field -> Text
fieldName Field
f)
Just o :: FieldInfo
o -> FieldInfo -> Int
fieldInfoOffset FieldInfo
o }
fixupMissingSymbols :: Bool -> M.Map Text Typelib -> (Name, API)
-> IO (Name, API)
fixupMissingSymbols :: Bool -> Map Text Typelib -> (Name, API) -> IO (Name, API)
fixupMissingSymbols verbose :: Bool
verbose typelibMap :: Map Text Typelib
typelibMap (n :: Name
n, APIStruct s :: Struct
s) = do
[Method]
fixedMethods <- Typelib -> [Method] -> Bool -> IO [Method]
fixupMethodMissingSymbols (Name -> Map Text Typelib -> Typelib
resolveTypelib Name
n Map Text Typelib
typelibMap)
(Struct -> [Method]
structMethods Struct
s) Bool
verbose
(Name, API) -> IO (Name, API)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, Struct -> API
APIStruct (Struct
s {structMethods :: [Method]
structMethods = [Method]
fixedMethods}))
fixupMissingSymbols verbose :: Bool
verbose typelibMap :: Map Text Typelib
typelibMap (n :: Name
n, APIUnion u :: Union
u) = do
[Method]
fixedMethods <- Typelib -> [Method] -> Bool -> IO [Method]
fixupMethodMissingSymbols (Name -> Map Text Typelib -> Typelib
resolveTypelib Name
n Map Text Typelib
typelibMap)
(Union -> [Method]
unionMethods Union
u) Bool
verbose
(Name, API) -> IO (Name, API)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, Union -> API
APIUnion (Union
u {unionMethods :: [Method]
unionMethods = [Method]
fixedMethods}))
fixupMissingSymbols verbose :: Bool
verbose typelibMap :: Map Text Typelib
typelibMap (n :: Name
n, APIObject o :: Object
o) = do
[Method]
fixedMethods <- Typelib -> [Method] -> Bool -> IO [Method]
fixupMethodMissingSymbols (Name -> Map Text Typelib -> Typelib
resolveTypelib Name
n Map Text Typelib
typelibMap)
(Object -> [Method]
objMethods Object
o) Bool
verbose
(Name, API) -> IO (Name, API)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, Object -> API
APIObject (Object
o {objMethods :: [Method]
objMethods = [Method]
fixedMethods}))
fixupMissingSymbols verbose :: Bool
verbose typelibMap :: Map Text Typelib
typelibMap (n :: Name
n, APIInterface i :: Interface
i) = do
[Method]
fixedMethods <- Typelib -> [Method] -> Bool -> IO [Method]
fixupMethodMissingSymbols (Name -> Map Text Typelib -> Typelib
resolveTypelib Name
n Map Text Typelib
typelibMap)
(Interface -> [Method]
ifMethods Interface
i) Bool
verbose
(Name, API) -> IO (Name, API)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, Interface -> API
APIInterface (Interface
i {ifMethods :: [Method]
ifMethods = [Method]
fixedMethods}))
fixupMissingSymbols verbose :: Bool
verbose typelibMap :: Map Text Typelib
typelibMap (n :: Name
n, APIFunction f :: Function
f) =
Map Text Typelib -> (Name, Function) -> Bool -> IO (Name, API)
fixupFunctionSymbols Map Text Typelib
typelibMap (Name
n, Function
f) Bool
verbose
fixupMissingSymbols _ _ (n :: Name
n, api :: API
api) = (Name, API) -> IO (Name, API)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, API
api)
resolveTypelib :: Name -> M.Map Text Typelib -> Typelib
resolveTypelib :: Name -> Map Text Typelib -> Typelib
resolveTypelib n :: Name
n typelibMap :: Map Text Typelib
typelibMap = case Text -> Map Text Typelib -> Maybe Typelib
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Name -> Text
namespace Name
n) Map Text Typelib
typelibMap of
Nothing -> Text -> Typelib
forall a. HasCallStack => Text -> a
terror (Text -> Typelib) -> Text -> Typelib
forall a b. (a -> b) -> a -> b
$ "Could not find typelib for “" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
namespace Name
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "”."
Just typelib :: Typelib
typelib -> Typelib
typelib
fixupMethodMissingSymbols :: Typelib -> [Method] -> Bool -> IO [Method]
fixupMethodMissingSymbols :: Typelib -> [Method] -> Bool -> IO [Method]
fixupMethodMissingSymbols typelib :: Typelib
typelib methods :: [Method]
methods verbose :: Bool
verbose = (Method -> IO Method) -> [Method] -> IO [Method]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Method -> IO Method
check [Method]
methods
where check :: Method -> IO Method
check :: Method -> IO Method
check method :: Method
method@Method{methodCallable :: Method -> Callable
methodCallable = Callable
callable} = do
Bool
resolvable <- Typelib -> Text -> IO Bool
girIsSymbolResolvable Typelib
typelib (Method -> Text
methodSymbol Method
method)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
verbose Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
resolvable) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> IO ()
printWarning (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Could not resolve the callable “"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Method -> Text
methodSymbol Method
method
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "” in the “" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Typelib -> Text
forall a. Show a => a -> Text
tshow Typelib
typelib
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "” typelib, ignoring."
let callable' :: Callable
callable' = Callable
callable{callableResolvable :: Maybe Bool
callableResolvable = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
resolvable}
Method -> IO Method
forall (m :: * -> *) a. Monad m => a -> m a
return (Method -> IO Method) -> Method -> IO Method
forall a b. (a -> b) -> a -> b
$ Method
method{methodCallable :: Callable
methodCallable = Callable
callable'}
fixupFunctionSymbols :: M.Map Text Typelib -> (Name, Function) -> Bool
-> IO (Name, API)
fixupFunctionSymbols :: Map Text Typelib -> (Name, Function) -> Bool -> IO (Name, API)
fixupFunctionSymbols typelibMap :: Map Text Typelib
typelibMap (n :: Name
n, f :: Function
f) verbose :: Bool
verbose = do
let typelib :: Typelib
typelib = Name -> Map Text Typelib -> Typelib
resolveTypelib Name
n Map Text Typelib
typelibMap
Bool
resolvable <- Typelib -> Text -> IO Bool
girIsSymbolResolvable Typelib
typelib (Function -> Text
fnSymbol Function
f)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
verbose Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
resolvable) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Text -> IO ()
printWarning (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Could not resolve the function “" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Function -> Text
fnSymbol Function
f
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "” in the “" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Typelib -> Text
forall a. Show a => a -> Text
tshow Typelib
typelib Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "” typelib, ignoring."
let callable' :: Callable
callable' = (Function -> Callable
fnCallable Function
f){callableResolvable :: Maybe Bool
callableResolvable = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
resolvable}
(Name, API) -> IO (Name, API)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
n, Function -> API
APIFunction (Function
f {fnCallable :: Callable
fnCallable = Callable
callable'}))
loadGIRInfo :: Bool
-> Text
-> Maybe Text
-> [FilePath]
-> [GIRRule]
-> IO (GIRInfo, [GIRInfo])
loadGIRInfo :: Bool
-> Text
-> Maybe Text
-> [String]
-> [GIRRule]
-> IO (GIRInfo, [GIRInfo])
loadGIRInfo verbose :: Bool
verbose name :: Text
name version :: Maybe Text
version extraPaths :: [String]
extraPaths rules :: [GIRRule]
rules = do
(doc :: Document
doc, deps :: Map (Text, Text) Document
deps) <- Bool
-> Text
-> Maybe Text
-> [String]
-> [GIRRule]
-> IO (Document, Map (Text, Text) Document)
loadGIRFile Bool
verbose Text
name Maybe Text
version [String]
extraPaths [GIRRule]
rules
let aliases :: Map Alias Type
aliases = [Map Alias Type] -> Map Alias Type
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ((Document -> Map Alias Type) -> [Document] -> [Map Alias Type]
forall a b. (a -> b) -> [a] -> [b]
map Document -> Map Alias Type
documentListAliases (Document
doc Document -> [Document] -> [Document]
forall a. a -> [a] -> [a]
: Map (Text, Text) Document -> [Document]
forall k a. Map k a -> [a]
M.elems Map (Text, Text) Document
deps))
parsedDoc :: Either Text GIRInfo
parsedDoc = GIRInfoParse -> Either Text GIRInfo
toGIRInfo (Map Alias Type -> Document -> GIRInfoParse
parseGIRDocument Map Alias Type
aliases Document
doc)
parsedDeps :: [Either Text GIRInfo]
parsedDeps = (Document -> Either Text GIRInfo)
-> [Document] -> [Either Text GIRInfo]
forall a b. (a -> b) -> [a] -> [b]
map (GIRInfoParse -> Either Text GIRInfo
toGIRInfo (GIRInfoParse -> Either Text GIRInfo)
-> (Document -> GIRInfoParse) -> Document -> Either Text GIRInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Alias Type -> Document -> GIRInfoParse
parseGIRDocument Map Alias Type
aliases) (Map (Text, Text) Document -> [Document]
forall k a. Map k a -> [a]
M.elems Map (Text, Text) Document
deps)
case Either Text GIRInfo
-> [Either Text GIRInfo] -> Either Text (GIRInfo, [GIRInfo])
combineErrors Either Text GIRInfo
parsedDoc [Either Text GIRInfo]
parsedDeps of
Left err :: Text
err -> String -> IO (GIRInfo, [GIRInfo])
forall a. HasCallStack => String -> a
error (String -> IO (GIRInfo, [GIRInfo]))
-> (Text -> String) -> Text -> IO (GIRInfo, [GIRInfo])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> IO (GIRInfo, [GIRInfo]))
-> Text -> IO (GIRInfo, [GIRInfo])
forall a b. (a -> b) -> a -> b
$ "Error when parsing \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err
Right (docGIR :: GIRInfo
docGIR, depsGIR :: [GIRInfo]
depsGIR) -> do
if GIRInfo -> Text
girNSName GIRInfo
docGIR Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name
then do
Map Text Typelib
typelibMap <- [(Text, Typelib)] -> Map Text Typelib
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Typelib)] -> Map Text Typelib)
-> IO [(Text, Typelib)] -> IO (Map Text Typelib)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([GIRInfo]
-> (GIRInfo -> IO (Text, Typelib)) -> IO [(Text, Typelib)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (GIRInfo
docGIR GIRInfo -> [GIRInfo] -> [GIRInfo]
forall a. a -> [a] -> [a]
: [GIRInfo]
depsGIR) ((GIRInfo -> IO (Text, Typelib)) -> IO [(Text, Typelib)])
-> (GIRInfo -> IO (Text, Typelib)) -> IO [(Text, Typelib)]
forall a b. (a -> b) -> a -> b
$ \info :: GIRInfo
info -> do
Typelib
typelib <- Text -> Text -> IO Typelib
girRequire (GIRInfo -> Text
girNSName GIRInfo
info) (GIRInfo -> Text
girNSVersion GIRInfo
info)
(Text, Typelib) -> IO (Text, Typelib)
forall (m :: * -> *) a. Monad m => a -> m a
return (GIRInfo -> Text
girNSName GIRInfo
info, Typelib
typelib))
(fixedDoc :: GIRInfo
fixedDoc, fixedDeps :: [GIRInfo]
fixedDeps) <- Bool
-> Map Text Typelib
-> GIRInfo
-> [GIRInfo]
-> IO (GIRInfo, [GIRInfo])
fixupGIRInfos Bool
verbose Map Text Typelib
typelibMap GIRInfo
docGIR [GIRInfo]
depsGIR
(GIRInfo, [GIRInfo]) -> IO (GIRInfo, [GIRInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return (GIRInfo
fixedDoc, [GIRInfo]
fixedDeps)
else String -> IO (GIRInfo, [GIRInfo])
forall a. HasCallStack => String -> a
error (String -> IO (GIRInfo, [GIRInfo]))
-> (Text -> String) -> Text -> IO (GIRInfo, [GIRInfo])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> IO (GIRInfo, [GIRInfo]))
-> Text -> IO (GIRInfo, [GIRInfo])
forall a b. (a -> b) -> a -> b
$ "Got unexpected namespace \""
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GIRInfo -> Text
girNSName GIRInfo
docGIR Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\" when parsing \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\"."
where combineErrors :: Either Text GIRInfo -> [Either Text GIRInfo]
-> Either Text (GIRInfo, [GIRInfo])
combineErrors :: Either Text GIRInfo
-> [Either Text GIRInfo] -> Either Text (GIRInfo, [GIRInfo])
combineErrors parsedDoc :: Either Text GIRInfo
parsedDoc parsedDeps :: [Either Text GIRInfo]
parsedDeps = do
GIRInfo
doc <- Either Text GIRInfo
parsedDoc
[GIRInfo]
deps <- [Either Text GIRInfo] -> Either Text [GIRInfo]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Either Text GIRInfo]
parsedDeps
(GIRInfo, [GIRInfo]) -> Either Text (GIRInfo, [GIRInfo])
forall (m :: * -> *) a. Monad m => a -> m a
return (GIRInfo
doc, [GIRInfo]
deps)
overrideGIRDocument :: [GIRRule] -> XML.Document -> XML.Document
overrideGIRDocument :: [GIRRule] -> Document -> Document
overrideGIRDocument rules :: [GIRRule]
rules doc :: Document
doc =
Document
doc {documentRoot :: Element
XML.documentRoot = [GIRRule] -> Element -> Element
overrideGIR [GIRRule]
rules (Document -> Element
XML.documentRoot Document
doc)}
overrideGIR :: [GIRRule] -> XML.Element -> XML.Element
overrideGIR :: [GIRRule] -> Element -> Element
overrideGIR rules :: [GIRRule]
rules elem :: Element
elem =
Element
elem {elementNodes :: [Node]
XML.elementNodes =
(Node -> Maybe Node) -> [Node] -> [Node]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\e :: Node
e -> (Node -> GIRRule -> Maybe Node) -> Node -> [GIRRule] -> Maybe Node
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Node -> GIRRule -> Maybe Node
applyGIRRule Node
e [GIRRule]
rules) (Element -> [Node]
XML.elementNodes Element
elem)}
where applyGIRRule :: XML.Node -> GIRRule -> Maybe XML.Node
applyGIRRule :: Node -> GIRRule -> Maybe Node
applyGIRRule n :: Node
n (GIRSetAttr (path :: [GIRNodeSpec]
path, attr :: Name
attr) newVal :: Text
newVal) =
Node -> Maybe Node
forall a. a -> Maybe a
Just (Node -> Maybe Node) -> Node -> Maybe Node
forall a b. (a -> b) -> a -> b
$ ([GIRNodeSpec], Name) -> Text -> Node -> Node
girSetAttr ([GIRNodeSpec]
path, Name
attr) Text
newVal Node
n
applyGIRRule n :: Node
n (GIRDeleteAttr path :: [GIRNodeSpec]
path attr :: Name
attr) =
Node -> Maybe Node
forall a. a -> Maybe a
Just (Node -> Maybe Node) -> Node -> Maybe Node
forall a b. (a -> b) -> a -> b
$ [GIRNodeSpec] -> Name -> Node -> Node
girDeleteAttr [GIRNodeSpec]
path Name
attr Node
n
applyGIRRule n :: Node
n (GIRAddNode path :: [GIRNodeSpec]
path new :: Name
new) =
Node -> Maybe Node
forall a. a -> Maybe a
Just (Node -> Maybe Node) -> Node -> Maybe Node
forall a b. (a -> b) -> a -> b
$ [GIRNodeSpec] -> Name -> Node -> Node
girAddNode [GIRNodeSpec]
path Name
new Node
n
applyGIRRule n :: Node
n (GIRDeleteNode path :: [GIRNodeSpec]
path) =
[GIRNodeSpec] -> Node -> Maybe Node
girDeleteNodes [GIRNodeSpec]
path Node
n
girSetAttr :: (GIRPath, XML.Name) -> Text -> XML.Node -> XML.Node
girSetAttr :: ([GIRNodeSpec], Name) -> Text -> Node -> Node
girSetAttr (spec :: GIRNodeSpec
spec:rest :: [GIRNodeSpec]
rest, attr :: Name
attr) newVal :: Text
newVal n :: Node
n@(XML.NodeElement elem :: Element
elem) =
if GIRNodeSpec -> Node -> Bool
specMatch GIRNodeSpec
spec Node
n
then case [GIRNodeSpec]
rest of
[] -> Element -> Node
XML.NodeElement (Element
elem {elementAttributes :: Map Name Text
XML.elementAttributes =
Name -> Text -> Map Name Text -> Map Name Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
attr Text
newVal
(Element -> Map Name Text
XML.elementAttributes Element
elem)})
_ -> Element -> Node
XML.NodeElement (Element
elem {elementNodes :: [Node]
XML.elementNodes =
(Node -> Node) -> [Node] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (([GIRNodeSpec], Name) -> Text -> Node -> Node
girSetAttr ([GIRNodeSpec]
rest, Name
attr) Text
newVal)
(Element -> [Node]
XML.elementNodes Element
elem)})
else Node
n
girSetAttr _ _ n :: Node
n = Node
n
girDeleteAttr :: GIRPath -> XML.Name -> XML.Node -> XML.Node
girDeleteAttr :: [GIRNodeSpec] -> Name -> Node -> Node
girDeleteAttr (spec :: GIRNodeSpec
spec:rest :: [GIRNodeSpec]
rest) attr :: Name
attr n :: Node
n@(XML.NodeElement elem :: Element
elem) =
if GIRNodeSpec -> Node -> Bool
specMatch GIRNodeSpec
spec Node
n
then case [GIRNodeSpec]
rest of
[] -> Element -> Node
XML.NodeElement (Element
elem {elementAttributes :: Map Name Text
XML.elementAttributes =
Name -> Map Name Text -> Map Name Text
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Name
attr
(Element -> Map Name Text
XML.elementAttributes Element
elem)})
_ -> Element -> Node
XML.NodeElement (Element
elem {elementNodes :: [Node]
XML.elementNodes =
(Node -> Node) -> [Node] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map ([GIRNodeSpec] -> Name -> Node -> Node
girDeleteAttr [GIRNodeSpec]
rest Name
attr)
(Element -> [Node]
XML.elementNodes Element
elem)})
else Node
n
girDeleteAttr _ _ n :: Node
n = Node
n
girAddNode :: GIRPath -> XML.Name -> XML.Node -> XML.Node
girAddNode :: [GIRNodeSpec] -> Name -> Node -> Node
girAddNode (spec :: GIRNodeSpec
spec:rest :: [GIRNodeSpec]
rest) newNode :: Name
newNode n :: Node
n@(XML.NodeElement element :: Element
element) =
if GIRNodeSpec -> Node -> Bool
specMatch GIRNodeSpec
spec Node
n
then case [GIRNodeSpec]
rest of
[] -> let newElement :: Element
newElement = Element :: Name -> Map Name Text -> [Node] -> Element
XML.Element { elementName :: Name
elementName = Name
newNode
, elementAttributes :: Map Name Text
elementAttributes = Map Name Text
forall k a. Map k a
M.empty
, elementNodes :: [Node]
elementNodes = [] }
nodeElementName :: Node -> Maybe Text
nodeElementName (XML.NodeElement e :: Element
e) =
(Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Element -> Text) -> Element -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
nameLocalName (Name -> Text) -> (Element -> Name) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Name
elementName) Element
e
nodeElementName _ = Maybe Text
forall a. Maybe a
Nothing
nodeNames :: [Text]
nodeNames = (Node -> Maybe Text) -> [Node] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node -> Maybe Text
nodeElementName (Element -> [Node]
XML.elementNodes Element
element)
in if Name -> Text
nameLocalName Name
newNode Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
nodeNames
then Node
n
else Element -> Node
XML.NodeElement (Element
element {elementNodes :: [Node]
XML.elementNodes =
Element -> [Node]
XML.elementNodes Element
element [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<>
[Element -> Node
XML.NodeElement Element
newElement]})
_ -> Element -> Node
XML.NodeElement (Element
element {elementNodes :: [Node]
XML.elementNodes =
(Node -> Node) -> [Node] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map ([GIRNodeSpec] -> Name -> Node -> Node
girAddNode [GIRNodeSpec]
rest Name
newNode)
(Element -> [Node]
XML.elementNodes Element
element)})
else Node
n
girAddNode _ _ n :: Node
n = Node
n
girDeleteNodes :: GIRPath -> XML.Node -> Maybe XML.Node
girDeleteNodes :: [GIRNodeSpec] -> Node -> Maybe Node
girDeleteNodes (spec :: GIRNodeSpec
spec:rest :: [GIRNodeSpec]
rest) n :: Node
n@(XML.NodeElement elem :: Element
elem) =
if GIRNodeSpec -> Node -> Bool
specMatch GIRNodeSpec
spec Node
n
then case [GIRNodeSpec]
rest of
[] -> Maybe Node
forall a. Maybe a
Nothing
_ -> Node -> Maybe Node
forall a. a -> Maybe a
Just (Node -> Maybe Node) -> Node -> Maybe Node
forall a b. (a -> b) -> a -> b
$ Element -> Node
XML.NodeElement (Element
elem {elementNodes :: [Node]
XML.elementNodes =
(Node -> Maybe Node) -> [Node] -> [Node]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([GIRNodeSpec] -> Node -> Maybe Node
girDeleteNodes [GIRNodeSpec]
rest)
(Element -> [Node]
XML.elementNodes Element
elem)})
else Node -> Maybe Node
forall a. a -> Maybe a
Just Node
n
girDeleteNodes _ n :: Node
n = Node -> Maybe Node
forall a. a -> Maybe a
Just Node
n
lookupAndMatch :: GIRNameTag -> M.Map XML.Name Text -> XML.Name -> Bool
lookupAndMatch :: GIRNameTag -> Map Name Text -> Name -> Bool
lookupAndMatch tag :: GIRNameTag
tag attrs :: Map Name Text
attrs attr :: Name
attr =
case Name -> Map Name Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
attr Map Name Text
attrs of
Just s :: Text
s -> case GIRNameTag
tag of
GIRPlainName pn :: Text
pn -> Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
pn
GIRRegex r :: Text
r -> Text -> String
T.unpack Text
s String -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> String
T.unpack Text
r
Nothing -> Bool
False
specMatch :: GIRNodeSpec -> XML.Node -> Bool
specMatch :: GIRNodeSpec -> Node -> Bool
specMatch (GIRType t :: Text
t) (XML.NodeElement elem :: Element
elem) =
Name -> Text
XML.nameLocalName (Element -> Name
XML.elementName Element
elem) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t
specMatch (GIRNamed name :: GIRNameTag
name) (XML.NodeElement elem :: Element
elem) =
GIRNameTag -> Map Name Text -> Name -> Bool
lookupAndMatch GIRNameTag
name (Element -> Map Name Text
XML.elementAttributes Element
elem) (Text -> Name
xmlLocalName "name")
specMatch (GIRTypedName t :: Text
t name :: GIRNameTag
name) (XML.NodeElement elem :: Element
elem) =
Name -> Text
XML.nameLocalName (Element -> Name
XML.elementName Element
elem) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t Bool -> Bool -> Bool
&&
GIRNameTag -> Map Name Text -> Name -> Bool
lookupAndMatch GIRNameTag
name (Element -> Map Name Text
XML.elementAttributes Element
elem) (Text -> Name
xmlLocalName "name")
specMatch _ _ = Bool
False