    {-# LANGUAGE RecordWildCards, NamedFieldPuns #-}

    module Data.GI.CodeGen.API
        ( API(..)
        , GIRInfo(..)
        , loadGIRInfo
        , loadRawGIRInfo

        , GIRRule(..)
        , GIRPath
        , GIRNodeSpec(..)
        , GIRNameTag(..)

        -- Reexported from Data.GI.GIR.BasicTypes
        , Name(..)
        , Transfer(..)

        -- Reexported from Data.GI.GIR.Allocation
        , AllocationInfo(..)
        , AllocationOp(..)
        , unknownAllocationInfo

        -- Reexported from Data.GI.GIR.Arg
        , Direction(..)
        , Scope(..)

        -- Reexported from Data.GI.GIR.Deprecation
        , DeprecationInfo

        -- Reexported from Data.GI.GIR.Enumeration
        , EnumerationMember(..)

        -- Reexported from Data.GI.GIR.Property
        , PropertyFlag(..)

        -- Reexported from Data.GI.GIR.Method
        , MethodType(..)

        -- Reexported from the corresponding Data.GI.GIR modules
        , 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
    $cshowsPrec :: Int -> GIRInfo -> ShowS
    showsPrec :: Int -> GIRInfo -> ShowS
    $cshow :: GIRInfo -> String
    show :: GIRInfo -> String
    $cshowList :: [GIRInfo] -> ShowS
    showList :: [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
    $cshowsPrec :: Int -> GIRNamespace -> ShowS
    showsPrec :: Int -> GIRNamespace -> ShowS
    $cshow :: GIRNamespace -> String
    show :: GIRNamespace -> String
    $cshowList :: [GIRNamespace] -> ShowS
    showList :: [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
    $cshowsPrec :: Int -> GIRInfoParse -> ShowS
    showsPrec :: Int -> GIRInfoParse -> ShowS
    $cshow :: GIRInfoParse -> String
    show :: GIRInfoParse -> String
    $cshowList :: [GIRInfoParse] -> ShowS
    showList :: [GIRInfoParse] -> ShowS
    Show)

    -- | Path to a node in the GIR file, starting from the document root
    -- of the GIR file. This is a very simplified version of something
    -- like XPath.
    type GIRPath = [GIRNodeSpec]

    -- | Node selector for a path in the GIR file.
    data GIRNodeSpec = GIRNamed GIRNameTag  -- ^ Node with the given "name" attr.
                     | GIRType Text         -- ^ Node of the given type.
                     | GIRTypedName Text GIRNameTag -- ^ Combination of the above.
                       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
    $cshowsPrec :: Int -> GIRNodeSpec -> ShowS
    showsPrec :: Int -> GIRNodeSpec -> ShowS
    $cshow :: GIRNodeSpec -> String
    show :: GIRNodeSpec -> String
    $cshowList :: [GIRNodeSpec] -> ShowS
    showList :: [GIRNodeSpec] -> ShowS
    Show)

    -- | A name tag, which is either a name or a regular expression.
    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
    $cshowsPrec :: Int -> GIRNameTag -> ShowS
    showsPrec :: Int -> GIRNameTag -> ShowS
    $cshow :: GIRNameTag -> String
    show :: GIRNameTag -> String
    $cshowList :: [GIRNameTag] -> ShowS
    showList :: [GIRNameTag] -> ShowS
    Show)

    -- | A rule for modifying the GIR file.
    data GIRRule = GIRSetAttr (GIRPath, XML.Name) Text -- ^ (Path to element,
                                                       -- attrName), newValue.
                 | GIRDeleteAttr GIRPath XML.Name
                 -- ^ Delete the given attribute
                 | GIRAddNode GIRPath XML.Name -- ^ Add a child node at
                                               -- the given selector.
                 | GIRDeleteNode GIRPath -- ^ Delete any nodes matching
                                         -- the given selector.
                 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
    $cshowsPrec :: Int -> GIRRule -> ShowS
    showsPrec :: Int -> GIRRule -> ShowS
    $cshow :: GIRRule -> String
    show :: GIRRule -> String
    $cshowList :: [GIRRule] -> ShowS
    showList :: [GIRRule] -> ShowS
    Show)

    -- | An element in the exposed API
    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
    $cshowsPrec :: Int -> API -> ShowS
    showsPrec :: Int -> API -> ShowS
    $cshow :: API -> String
    show :: API -> String
    $cshowList :: [API] -> ShowS
    showList :: [API] -> ShowS
    Show

    parseAPI :: Text -> M.Map Alias Type -> Element -> (a -> API)
             -> Parser (Name, a) -> (Name, API)
    parseAPI :: forall a.
    Text
    -> Map Alias Type
    -> Element
    -> (a -> API)
    -> Parser (Name, a)
    -> (Name, API)
    parseAPI Text
    ns Map Alias Type
    aliases Element
    element a -> API
    wrapper 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 Text
    err -> String -> (Name, API)
    forall a. HasCallStack => String -> a
    error (String -> (Name, API)) -> String -> (Name, API)
    forall a b. (a -> b) -> a -> b
    $ String
    "Parse error: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    T.unpack Text
    err
          Right (Name
    n, 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 Map Alias Type
    aliases ns :: GIRNamespace
    ns@GIRNamespace{[(Text, Name)]
    [(Name, API)]
    Text
    nsName :: GIRNamespace -> Text
    nsVersion :: GIRNamespace -> Text
    nsAPIs :: GIRNamespace -> [(Name, API)]
    nsCTypes :: GIRNamespace -> [(Text, Name)]
    nsName :: Text
    nsVersion :: Text
    nsAPIs :: [(Name, API)]
    nsCTypes :: [(Text, Name)]
    ..} Element
    element
        | Name -> Element -> Maybe Text
    lookupAttr Name
    "introspectable" Element
    element Maybe Text -> Maybe Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "0" = GIRNamespace
    ns
        | Bool
    otherwise =
            case Name -> Text
    nameLocalName (Element -> Name
    elementName Element
    element) of
              Text
    "alias" -> GIRNamespace
    ns     -- Processed separately
              Text
    "constant" -> (Constant -> API) -> Parser (Name, Constant) -> GIRNamespace
    forall a. (a -> API) -> Parser (Name, a) -> GIRNamespace
    parse Constant -> API
    APIConst Parser (Name, Constant)
    parseConstant
              Text
    "enumeration" -> (Enumeration -> API) -> Parser (Name, Enumeration) -> GIRNamespace
    forall a. (a -> API) -> Parser (Name, a) -> GIRNamespace
    parse Enumeration -> API
    APIEnum Parser (Name, Enumeration)
    parseEnum
              Text
    "bitfield" -> (Flags -> API) -> Parser (Name, Flags) -> GIRNamespace
    forall a. (a -> API) -> Parser (Name, a) -> GIRNamespace
    parse Flags -> API
    APIFlags Parser (Name, Flags)
    parseFlags
              Text
    "function" -> (Function -> API) -> Parser (Name, Function) -> GIRNamespace
    forall a. (a -> API) -> Parser (Name, a) -> GIRNamespace
    parse Function -> API
    APIFunction Parser (Name, Function)
    parseFunction
              Text
    "callback" -> (Callback -> API) -> Parser (Name, Callback) -> GIRNamespace
    forall a. (a -> API) -> Parser (Name, a) -> GIRNamespace
    parse Callback -> API
    APICallback Parser (Name, Callback)
    parseCallback
              Text
    "record" -> (Struct -> API) -> Parser (Name, Struct) -> GIRNamespace
    forall a. (a -> API) -> Parser (Name, a) -> GIRNamespace
    parse Struct -> API
    APIStruct Parser (Name, Struct)
    parseStruct
              Text
    "union" -> (Union -> API) -> Parser (Name, Union) -> GIRNamespace
    forall a. (a -> API) -> Parser (Name, a) -> GIRNamespace
    parse Union -> API
    APIUnion Parser (Name, Union)
    parseUnion
              Text
    "class" -> (Object -> API) -> Parser (Name, Object) -> GIRNamespace
    forall a. (a -> API) -> Parser (Name, a) -> GIRNamespace
    parse Object -> API
    APIObject Parser (Name, Object)
    parseObject
              Text
    "interface" -> (Interface -> API) -> Parser (Name, Interface) -> GIRNamespace
    forall a. (a -> API) -> Parser (Name, a) -> GIRNamespace
    parse Interface -> API
    APIInterface Parser (Name, Interface)
    parseInterface
              Text
    "boxed" -> GIRNamespace
    ns -- Unsupported
              Text
    "docsection" -> GIRNamespace
    ns -- Ignored for now, see https://github.com/haskell-gi/haskell-gi/issues/318
              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
    $ Text
    "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
    <> Text
    "\" 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
    <> Text
    "\", aborting."
        where parse :: (a -> API) -> Parser (Name, a) -> GIRNamespace
              parse :: forall a. (a -> API) -> Parser (Name, a) -> GIRNamespace
    parse a -> API
    wrapper Parser (Name, a)
    parser =
                  let (Name
    n, 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 Name
    "type" Element
    element
                  in GIRNamespace
    ns { nsAPIs = (n, api) : nsAPIs,
                          nsCTypes = case maybeCType of
                                       Just Text
    ctype -> (Text
    ctype, Name
    n) (Text, Name) -> [(Text, Name)] -> [(Text, Name)]
    forall a. a -> [a] -> [a]
    : [(Text, Name)]
    nsCTypes
                                       Maybe Text
    Nothing -> [(Text, Name)]
    nsCTypes
                        }

    parseNamespace :: Element -> M.Map Alias Type -> Maybe GIRNamespace
    parseNamespace :: Element -> Map Alias Type -> Maybe GIRNamespace
    parseNamespace Element
    element Map Alias Type
    aliases = do
      let attrs :: Map Name Text
    attrs = Element -> Map Name Text
    elementAttributes Element
    element
      name <- Name -> Map Name Text -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Name
    "name" Map Name Text
    attrs
      version <- M.lookup "version" attrs
      let ns = GIRNamespace {
                 nsName :: Text
    nsName         = Text
    name,
                 nsVersion :: Text
    nsVersion      = Text
    version,
                 nsAPIs :: [(Name, API)]
    nsAPIs         = [],
                 nsCTypes :: [(Text, Name)]
    nsCTypes       = []
               }
      return (L.foldl' (parseNSElement aliases) ns (subelements element))

    parseInclude :: Element -> Maybe (Text, Text)
    parseInclude :: Element -> Maybe (Text, Text)
    parseInclude Element
    element = do
      name <- Name -> Map Name Text -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Name
    "name" Map Name Text
    attrs
      version <- M.lookup "version" attrs
      return (name, 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 = Name -> Map Name Text -> Maybe Text
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Name
    "name" (Element -> Map Name Text
    elementAttributes Element
    element)

    parseRootElement :: M.Map Alias Type -> GIRInfoParse -> Element -> GIRInfoParse
    parseRootElement :: Map Alias Type -> GIRInfoParse -> Element -> GIRInfoParse
    parseRootElement Map Alias Type
    aliases info :: GIRInfoParse
    info@GIRInfoParse{[Maybe (Text, Text)]
    [Maybe Text]
    [Maybe GIRNamespace]
    girIPPackage :: GIRInfoParse -> [Maybe Text]
    girIPIncludes :: GIRInfoParse -> [Maybe (Text, Text)]
    girIPNamespaces :: GIRInfoParse -> [Maybe GIRNamespace]
    girIPPackage :: [Maybe Text]
    girIPIncludes :: [Maybe (Text, Text)]
    girIPNamespaces :: [Maybe GIRNamespace]
    ..} Element
    element =
        case Name -> Text
    nameLocalName (Element -> Name
    elementName Element
    element) of
          Text
    "include" -> GIRInfoParse
    info {girIPIncludes = parseInclude element : girIPIncludes}
          Text
    "package" -> GIRInfoParse
    info {girIPPackage = parsePackage element : girIPPackage}
          Text
    "namespace" -> GIRInfoParse
    info {girIPNamespaces = parseNamespace element aliases : girIPNamespaces}
          Text
    _ -> GIRInfoParse
    info

    emptyGIRInfoParse :: GIRInfoParse
    emptyGIRInfoParse :: GIRInfoParse
    emptyGIRInfoParse = 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 Map Alias Type
    aliases Document
    doc = (GIRInfoParse -> Element -> GIRInfoParse)
    -> GIRInfoParse -> [Element] -> GIRInfoParse
    forall b a. (b -> a -> b) -> b -> [a] -> b
    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))

    -- | Parse the list of includes in a given document.
    documentListIncludes :: Document -> S.Set (Text, Text)
    documentListIncludes :: Document -> Set (Text, Text)
    documentListIncludes 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 Text
    "include" (Document -> Element
    documentRoot Document
    doc)

    -- | Load a set of dependencies, recursively.
    loadDependencies :: Bool                              -- ^ Verbose
                     -> S.Set (Text, Text)                -- ^ Requested
                     -> M.Map (Text, Text) Document       -- ^ Loaded so far
                     -> [FilePath]                        -- ^ extra path to search
                     -> [GIRRule]                         -- ^ fixups
                     -> IO (M.Map (Text, Text) Document)  -- ^ New loaded set
    loadDependencies :: Bool
    -> Set (Text, Text)
    -> Map (Text, Text) Document
    -> [String]
    -> [GIRRule]
    -> IO (Map (Text, Text) Document)
    loadDependencies Bool
    verbose Set (Text, Text)
    requested Map (Text, Text) Document
    loaded [String]
    extraPaths [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 a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Map (Text, Text) Document
    loaded
            | Bool
    otherwise = do
      let (Text
    name, Text
    version) = Int -> Set (Text, Text) -> (Text, Text)
    forall a. Int -> Set a -> a
    S.elemAt Int
    0 Set (Text, Text)
    requested
      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 = (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 = [(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) -> 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) -> 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
      loadDependencies verbose notYetLoaded newLoaded extraPaths rules

    -- | Load a given GIR file and recursively its dependencies
    loadGIRFile :: Bool             -- ^ verbose
                -> Text             -- ^ name
                -> Maybe Text       -- ^ version
                -> [FilePath]       -- ^ extra paths to search
                -> [GIRRule]        -- ^ overrides
                -> IO (Document,
                       M.Map (Text, Text) Document) -- ^ (loaded doc, dependencies)
    loadGIRFile :: Bool
    -> Text
    -> Maybe Text
    -> [String]
    -> [GIRRule]
    -> IO (Document, Map (Text, Text) Document)
    loadGIRFile Bool
    verbose Text
    name Maybe Text
    version [String]
    extraPaths [GIRRule]
    rules = do
      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
      deps <- loadDependencies verbose (documentListIncludes doc) M.empty
              extraPaths rules
      return (doc, deps)

    -- | Turn a GIRInfoParse into a proper GIRInfo, doing some sanity
    -- checking along the way.
    toGIRInfo :: GIRInfoParse -> Either Text GIRInfo
    toGIRInfo :: GIRInfoParse -> Either Text GIRInfo
    toGIRInfo GIRInfoParse
    info =
        case [Maybe GIRNamespace] -> [GIRNamespace]
    forall a. [Maybe a] -> [a]
    catMaybes (GIRInfoParse -> [Maybe GIRNamespace]
    girIPNamespaces GIRInfoParse
    info) of
          [GIRNamespace
    ns] -> GIRInfo -> Either Text GIRInfo
    forall a b. b -> Either a b
    Right 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 Text
    "Found no valid namespace."
          [GIRNamespace]
    _  -> Text -> Either Text GIRInfo
    forall a b. a -> Either a b
    Left Text
    "Found multiple namespaces."

    -- | Bare minimum loading and parsing of a single repository, without
    -- loading or parsing its dependencies, resolving aliases, or fixing
    -- up structs or interfaces.
    loadRawGIRInfo :: Bool          -- ^ verbose
                   -> Text          -- ^ name
                   -> Maybe Text    -- ^ version
                   -> [FilePath]    -- ^ extra paths to search
                   -> IO GIRInfo    -- ^ bare parsed document
    loadRawGIRInfo :: Bool -> Text -> Maybe Text -> [String] -> IO GIRInfo
    loadRawGIRInfo Bool
    verbose Text
    name Maybe Text
    version [String]
    extraPaths = do
      doc <- Bool -> Text -> Maybe Text -> [String] -> IO Document
    readGiRepository Bool
    verbose Text
    name Maybe Text
    version [String]
    extraPaths
      case toGIRInfo (parseGIRDocument M.empty doc) of
        Left 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
    $ Text
    "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 -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    err
        Right GIRInfo
    docGIR -> GIRInfo -> IO GIRInfo
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return GIRInfo
    docGIR

    -- | Fixup parsed GIRInfos: some of the required information is not
    -- found in the GIR files themselves, or does not accurately reflect
    -- the content in the dynamic library itself, but this can be
    -- corrected by checking the typelib.
    fixupGIRInfos :: Bool -> M.Map Text Typelib -> GIRInfo -> [GIRInfo]
                  -> IO (GIRInfo, [GIRInfo])
    fixupGIRInfos :: Bool
    -> Map Text Typelib
    -> GIRInfo
    -> [GIRInfo]
    -> IO (GIRInfo, [GIRInfo])
    fixupGIRInfos Bool
    verbose Map Text Typelib
    typelibMap GIRInfo
    doc [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 (Name, API) -> IO (Name, API)
    fixer (GIRInfo
    doc, [GIRInfo]
    deps) = do
              fixedDoc <- ((Name, API) -> IO (Name, API)) -> GIRInfo -> IO GIRInfo
    fixAPIs (Name, API) -> IO (Name, API)
    fixer GIRInfo
    doc
              fixedDeps <- mapM (fixAPIs fixer) deps
              return (fixedDoc, fixedDeps)

            fixAPIs :: ((Name, API) -> IO (Name, API))
                    -> GIRInfo -> IO GIRInfo
            fixAPIs :: ((Name, API) -> IO (Name, API)) -> GIRInfo -> IO GIRInfo
    fixAPIs (Name, API) -> IO (Name, API)
    fixer GIRInfo
    info = do
              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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Name, API) -> IO (Name, API)
    fixer (GIRInfo -> [(Name, API)]
    girAPIs GIRInfo
    info)
              return $ info {girAPIs = 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)

    -- | List the prerequisites for a 'GType' corresponding to an interface.
    gtypeInterfaceListPrereqs :: GType -> IO [Text]
    gtypeInterfaceListPrereqs :: GType -> IO [Text]
    gtypeInterfaceListPrereqs (GType CGType
    cgtype) = do
      nprereqsPtr <- IO (Ptr CUInt)
    forall a. Storable a => IO (Ptr a)
    allocMem :: IO (Ptr CUInt)
      ps <- g_type_interface_prerequisites cgtype nprereqsPtr
      nprereqs <- peek nprereqsPtr
      psCGTypes <- unpackStorableArrayWithLength nprereqs ps
      freeMem ps
      freeMem nprereqsPtr
      mapM (fmap T.pack . gtypeName . GType) psCGTypes

    -- | The list of prerequisites in GIR files is not always
    -- accurate. Instead of relying on this, we instantiate the 'GType'
    -- associated to the interface, and listing the interfaces from there.
    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 Map Text Typelib
    typelibMap Map Text Name
    csymbolMap (n :: Name
    n@(Name Text
    ns Text
    _), APIInterface Interface
    iface) = do
      prereqs <- case Interface -> Maybe Text
    ifTypeInit Interface
    iface of
                   Maybe Text
    Nothing -> [Name] -> IO [Name]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
                   Just Text
    ti -> do
                     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 -> Text -> IO GType
    girLoadGType Typelib
    typelib Text
    ti
                                Maybe Typelib
    Nothing -> String -> IO GType
    forall a. HasCallStack => String -> a
    error (String -> IO GType) -> String -> IO GType
    forall a b. (a -> b) -> a -> b
    $ String
    "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]
    ++ String
    " not loaded."
                     prereqGTypes <- gtypeInterfaceListPrereqs gtype
                     forM prereqGTypes $ \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 Name
    pn -> Name -> IO Name
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    pn
                         Maybe Name
    Nothing -> String -> IO Name
    forall a. HasCallStack => String -> a
    error (String -> IO Name) -> String -> IO Name
    forall a b. (a -> b) -> a -> b
    $ String
    "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]
    ++ String
    " for interface " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    forall a. Show a => a -> String
    show Name
    n
      return (n, APIInterface (iface {ifPrerequisites = prereqs}))
    fixupInterface Map Text Typelib
    _ Map Text Name
    _ (Name
    n, API
    api) = (Name, API) -> IO (Name, API)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name
    n, API
    api)

    -- | There is not enough info in the GIR files to determine whether a
    -- struct is boxed. We find out by instantiating the 'GType'
    -- corresponding to the struct (if known) and checking whether it
    -- descends from the boxed GType. Similarly, the size of the struct
    -- and offset of the fields is hard to compute from the GIR data, we
    -- simply reuse the machinery in libgirepository.
    fixupStruct :: M.Map Text Typelib -> (Name, API)
                -> IO (Name, API)
    fixupStruct :: Map Text Typelib -> (Name, API) -> IO (Name, API)
    fixupStruct Map Text Typelib
    typelibMap (Name
    n, APIStruct Struct
    s) = do
      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
      return (n, APIStruct fixed)
    fixupStruct Map Text Typelib
    _ (Name, API)
    api = (Name, API) -> IO (Name, API)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name, API)
    api

    -- | Find out whether the struct is boxed.
    fixupStructIsBoxed :: M.Map Text Typelib -> Name -> Struct -> IO Struct
    -- The type for "GVariant" is marked as "intern", we wrap
    -- this one natively.
    fixupStructIsBoxed :: Map Text Typelib -> Name -> Struct -> IO Struct
    fixupStructIsBoxed Map Text Typelib
    _ (Name Text
    "GLib" Text
    "Variant") Struct
    s =
        Struct -> IO Struct
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Struct
    s {structIsBoxed = False})
    fixupStructIsBoxed Map Text Typelib
    typelibMap (Name Text
    ns Text
    _) Struct
    s = do
      isBoxed <- case Struct -> Maybe Text
    structTypeInit Struct
    s of
                   Maybe Text
    Nothing -> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
                   Just Text
    ti -> do
                     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 -> Text -> IO GType
    girLoadGType Typelib
    typelib Text
    ti
                       Maybe Typelib
    Nothing -> String -> IO GType
    forall a. HasCallStack => String -> a
    error (String -> IO GType) -> String -> IO GType
    forall a b. (a -> b) -> a -> b
    $ String
    "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]
    ++ String
    " not loaded."

                     return (gtypeIsBoxed gtype)
      return (s {structIsBoxed = isBoxed})

    -- | Fix the size and alignment of fields. This is much easier to do
    -- by using libgirepository than reading the GIR file directly.
    fixupStructSizeAndOffsets :: Name -> Struct -> IO Struct
    fixupStructSizeAndOffsets :: Name -> Struct -> IO Struct
    fixupStructSizeAndOffsets (Name Text
    ns Text
    n) Struct
    s = do
      (size, infoMap) <- Text -> Text -> IO (Int, Map Text FieldInfo)
    girStructFieldInfo Text
    ns Text
    n
      return (s { structSize = size
                , structFields = map (fixupField infoMap) (structFields s)})

    -- | Same thing for unions.
    fixupUnion :: (Name, API) -> IO (Name, API)
    fixupUnion :: (Name, API) -> IO (Name, API)
    fixupUnion (Name
    n, APIUnion Union
    u) = do
      fixed <- (Name -> Union -> IO Union
    fixupUnionSizeAndOffsets Name
    n) Union
    u
      return (n, APIUnion fixed)
    fixupUnion (Name, API)
    api = (Name, API) -> IO (Name, API)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name, API)
    api

    -- | Like 'fixupStructSizeAndOffset' above.
    fixupUnionSizeAndOffsets :: Name -> Union -> IO Union
    fixupUnionSizeAndOffsets :: Name -> Union -> IO Union
    fixupUnionSizeAndOffsets (Name Text
    ns Text
    n) Union
    u = do
      (size, infoMap) <- Text -> Text -> IO (Int, Map Text FieldInfo)
    girUnionFieldInfo Text
    ns Text
    n
      return (u { unionSize = size
                , unionFields = map (fixupField infoMap) (unionFields u)})

    -- | Fixup the offsets of fields using the given offset map.
    fixupField :: M.Map Text FieldInfo -> Field -> Field
    fixupField :: Map Text FieldInfo -> Field -> Field
    fixupField Map Text FieldInfo
    offsetMap Field
    f =
        Field
    f {fieldOffset = case M.lookup (fieldName f) offsetMap of
                           Maybe FieldInfo
    Nothing -> String -> Int
    forall a. HasCallStack => String -> a
    error (String -> Int) -> String -> Int
    forall a b. (a -> b) -> a -> b
    $ String
    "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 FieldInfo
    o -> FieldInfo -> Int
    fieldInfoOffset FieldInfo
    o }

    -- | Some of the symbols listed in the introspection data are not
    -- present in the dynamic library itself. Generating bindings for
    -- these will sometimes lead to linker errors, so here we check that
    -- every symbol listed in the bindings is actually present.
    fixupMissingSymbols :: Bool -> M.Map Text Typelib -> (Name, API)
                        -> IO (Name, API)
    fixupMissingSymbols :: Bool -> Map Text Typelib -> (Name, API) -> IO (Name, API)
    fixupMissingSymbols Bool
    verbose Map Text Typelib
    typelibMap (Name
    n, APIStruct Struct
    s) = do
      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
      return (n, APIStruct (s {structMethods = fixedMethods}))
    fixupMissingSymbols Bool
    verbose Map Text Typelib
    typelibMap (Name
    n, APIUnion Union
    u) = do
      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
      return (n, APIUnion (u {unionMethods = fixedMethods}))
    fixupMissingSymbols Bool
    verbose Map Text Typelib
    typelibMap (Name
    n, APIObject Object
    o) = do
      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
      return (n, APIObject (o {objMethods = fixedMethods}))
    fixupMissingSymbols Bool
    verbose Map Text Typelib
    typelibMap (Name
    n, APIInterface Interface
    i) = do
      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
      return (n, APIInterface (i {ifMethods = fixedMethods}))
    fixupMissingSymbols Bool
    verbose Map Text Typelib
    typelibMap (Name
    n, APIFunction Function
    f) =
      Map Text Typelib -> (Name, Function) -> Bool -> IO (Name, API)
    fixupFunctionSymbols Map Text Typelib
    typelibMap (Name
    n, Function
    f) Bool
    verbose
    fixupMissingSymbols Bool
    _ Map Text Typelib
    _ (Name
    n, API
    api) = (Name, API) -> IO (Name, API)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name
    n, API
    api)

    -- | Resolve the typelib owning the given name, erroring out if the
    -- typelib is not known.
    resolveTypelib :: Name -> M.Map Text Typelib -> Typelib
    resolveTypelib :: Name -> Map Text Typelib -> Typelib
    resolveTypelib Name
    n 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
      Maybe Typelib
    Nothing -> Text -> Typelib
    forall a. HasCallStack => Text -> a
    terror (Text -> Typelib) -> Text -> Typelib
    forall a b. (a -> b) -> a -> b
    $ Text
    "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
    <> Text
    "”."
      Just Typelib
    typelib -> Typelib
    typelib

    -- | Mark whether the methods can be resolved in the given typelib.
    fixupMethodMissingSymbols :: Typelib -> [Method] -> Bool -> IO [Method]
    fixupMethodMissingSymbols :: Typelib -> [Method] -> Bool -> IO [Method]
    fixupMethodMissingSymbols Typelib
    typelib [Method]
    methods 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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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
              resolvable <- Typelib -> Text -> IO Bool
    girIsSymbolResolvable Typelib
    typelib (Method -> Text
    methodSymbol Method
    method)
              when (verbose && not resolvable) $
                printWarning $ "Could not resolve the callable “"
                               <> methodSymbol method
                               <> "” in the “" <> tshow typelib
                               <> "” typelib, ignoring."
              let callable' = Callable
    callable{callableResolvable = Just resolvable}
              return $ method{methodCallable = callable'}

    -- | Check that the symbol the function refers to is actually present
    -- in the dynamic library.
    fixupFunctionSymbols :: M.Map Text Typelib -> (Name, Function) -> Bool
                                -> IO (Name, API)
    fixupFunctionSymbols :: Map Text Typelib -> (Name, Function) -> Bool -> IO (Name, API)
    fixupFunctionSymbols Map Text Typelib
    typelibMap (Name
    n, Function
    f) Bool
    verbose = do
      let typelib :: Typelib
    typelib = Name -> Map Text Typelib -> Typelib
    resolveTypelib Name
    n Map Text Typelib
    typelibMap
      resolvable <- Typelib -> Text -> IO Bool
    girIsSymbolResolvable Typelib
    typelib (Function -> Text
    fnSymbol Function
    f)
      when (verbose && not resolvable) $
        printWarning $ "Could not resolve the function “" <> fnSymbol f
                        <> "” in the “" <> tshow typelib <> "” typelib, ignoring."
      let callable' = (Function -> Callable
    fnCallable Function
    f){callableResolvable = Just resolvable}
      return (n, APIFunction (f {fnCallable = callable'}))

    -- | Load and parse a GIR file, including its dependencies.
    loadGIRInfo :: Bool             -- ^ verbose
                -> Text             -- ^ name
                -> Maybe Text       -- ^ version
                -> [FilePath]       -- ^ extra paths to search
                -> [GIRRule]        -- ^ fixups
                -> IO (GIRInfo, [GIRInfo])
                -- ^ (parsed doc,  parsed deps)
    loadGIRInfo :: Bool
    -> Text
    -> Maybe Text
    -> [String]
    -> [GIRRule]
    -> IO (GIRInfo, [GIRInfo])
    loadGIRInfo Bool
    verbose Text
    name Maybe Text
    version [String]
    extraPaths [GIRRule]
    rules =  do
      (doc, 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] -> 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 = GIRInfoParse -> Either Text GIRInfo
    toGIRInfo (Map Alias Type -> Document -> GIRInfoParse
    parseGIRDocument Map Alias Type
    aliases Document
    doc)
          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 combineErrors parsedDoc parsedDeps of
        Left 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
    $ Text
    "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 -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    err
        Right (GIRInfo
    docGIR, [GIRInfo]
    depsGIR) -> do
          if GIRInfo -> Text
    girNSName GIRInfo
    docGIR Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    name
          then do
            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
    $ \GIRInfo
    info -> do
                 typelib <- Text -> Text -> IO Typelib
    girRequire (GIRInfo -> Text
    girNSName GIRInfo
    info) (GIRInfo -> Text
    girNSVersion GIRInfo
    info)
                 return (girNSName info, typelib))
            (fixedDoc, fixedDeps) <- fixupGIRInfos verbose typelibMap docGIR depsGIR
            return (fixedDoc, 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
    $ Text
    "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
    <> Text
    "\" 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
    "\"."
      where combineErrors :: Either Text GIRInfo -> [Either Text GIRInfo]
                          -> Either Text (GIRInfo, [GIRInfo])
            combineErrors :: Either Text GIRInfo
    -> [Either Text GIRInfo] -> Either Text (GIRInfo, [GIRInfo])
    combineErrors Either Text GIRInfo
    parsedDoc [Either Text GIRInfo]
    parsedDeps = do
              doc <- Either Text GIRInfo
    parsedDoc
              deps <- sequence parsedDeps
              return (doc, deps)

    -- | Given a XML document containing GIR data, apply the given overrides.
    overrideGIRDocument :: [GIRRule] -> XML.Document -> XML.Document
    overrideGIRDocument :: [GIRRule] -> Document -> Document
    overrideGIRDocument [GIRRule]
    rules Document
    doc =
        Document
    doc {XML.documentRoot = overrideGIR rules (XML.documentRoot doc)}

    -- | Looks for the given path in the given subelements of the given
    -- element. If the path is empty apply the corresponding rule,
    -- otherwise return the element ummodified.
    overrideGIR :: [GIRRule] -> XML.Element -> XML.Element
    overrideGIR :: [GIRRule] -> Element -> Element
    overrideGIR [GIRRule]
    rules Element
    elem =
        Element
    elem {XML.elementNodes =
              mapMaybe (\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) (XML.elementNodes elem)}
        where applyGIRRule :: XML.Node -> GIRRule -> Maybe XML.Node
              applyGIRRule :: Node -> GIRRule -> Maybe Node
    applyGIRRule Node
    n (GIRSetAttr ([GIRNodeSpec]
    path, Name
    attr) 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 Node
    n (GIRDeleteAttr [GIRNodeSpec]
    path 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 Node
    n (GIRAddNode [GIRNodeSpec]
    path 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 Node
    n (GIRDeleteNode [GIRNodeSpec]
    path) =
                [GIRNodeSpec] -> Node -> Maybe Node
    girDeleteNodes [GIRNodeSpec]
    path Node
    n

    -- | Set an attribute for the child element specified by the given
    -- path.
    girSetAttr :: (GIRPath, XML.Name) -> Text -> XML.Node -> XML.Node
    girSetAttr :: ([GIRNodeSpec], Name) -> Text -> Node -> Node
    girSetAttr (GIRNodeSpec
    spec:[GIRNodeSpec]
    rest, Name
    attr) Text
    newVal n :: Node
    n@(XML.NodeElement Element
    elem) =
        if GIRNodeSpec -> Node -> Bool
    specMatch GIRNodeSpec
    spec Node
    n
        then case [GIRNodeSpec]
    rest of
               -- Matched the full path, apply
               [] -> Element -> Node
    XML.NodeElement (Element
    elem {XML.elementAttributes =
                                            M.insert attr newVal
                                            (XML.elementAttributes elem)})
               -- Still some selectors to apply
               [GIRNodeSpec]
    _ -> Element -> Node
    XML.NodeElement (Element
    elem {XML.elementNodes =
                                           map (girSetAttr (rest, attr) newVal)
                                           (XML.elementNodes elem)})
        else Node
    n
    girSetAttr ([GIRNodeSpec], Name)
    _ Text
    _ Node
    n = Node
    n

    -- | Delete an attribute for the child element specified by the given
    -- path, if the attribute exists.
    girDeleteAttr :: GIRPath -> XML.Name -> XML.Node -> XML.Node
    girDeleteAttr :: [GIRNodeSpec] -> Name -> Node -> Node
    girDeleteAttr (GIRNodeSpec
    spec:[GIRNodeSpec]
    rest) Name
    attr n :: Node
    n@(XML.NodeElement Element
    elem) =
        if GIRNodeSpec -> Node -> Bool
    specMatch GIRNodeSpec
    spec Node
    n
        then case [GIRNodeSpec]
    rest of
               -- Matched the full path, apply
               [] -> Element -> Node
    XML.NodeElement (Element
    elem {XML.elementAttributes =
                                            M.delete attr
                                            (XML.elementAttributes elem)})
               -- Still some selectors to apply
               [GIRNodeSpec]
    _ -> Element -> Node
    XML.NodeElement (Element
    elem {XML.elementNodes =
                                           map (girDeleteAttr rest attr)
                                           (XML.elementNodes elem)})
        else Node
    n
    girDeleteAttr [GIRNodeSpec]
    _ Name
    _ Node
    n = Node
    n

    -- | Add the given subnode to any nodes matching the given path
    girAddNode :: GIRPath -> XML.Name -> XML.Node -> XML.Node
    girAddNode :: [GIRNodeSpec] -> Name -> Node -> Node
    girAddNode (GIRNodeSpec
    spec:[GIRNodeSpec]
    rest) Name
    newNode n :: Node
    n@(XML.NodeElement Element
    element) =
      if GIRNodeSpec -> Node -> Bool
    specMatch GIRNodeSpec
    spec Node
    n
      then case [GIRNodeSpec]
    rest of
        -- Matched the full path, add the new child node.
        [] -> let newElement :: Element
    newElement = 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 = [] }
                  -- We only insert if not present, see #171. For
                  -- convenience when writing the override files, we
                  -- ignore the namespace when comparing.
                  nodeElementName :: Node -> Maybe Text
    nodeElementName (XML.NodeElement 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 Node
    _ = 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 a. Eq a => a -> [a] -> 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 {XML.elementNodes =
                                        XML.elementNodes element <>
                                         [XML.NodeElement newElement]})
        -- Still some selectors to apply.
        [GIRNodeSpec]
    _ -> Element -> Node
    XML.NodeElement (Element
    element {XML.elementNodes =
                                    map (girAddNode rest newNode)
                                     (XML.elementNodes element)})
      else Node
    n
    girAddNode [GIRNodeSpec]
    _ Name
    _ Node
    n = Node
    n

    -- | Delete any nodes matching the given path.
    girDeleteNodes :: GIRPath -> XML.Node -> Maybe XML.Node
    girDeleteNodes :: [GIRNodeSpec] -> Node -> Maybe Node
    girDeleteNodes (GIRNodeSpec
    spec:[GIRNodeSpec]
    rest) n :: Node
    n@(XML.NodeElement Element
    elem) =
      if GIRNodeSpec -> Node -> Bool
    specMatch GIRNodeSpec
    spec Node
    n
      then case [GIRNodeSpec]
    rest of
             -- Matched the full path, discard the node
             [] -> Maybe Node
    forall a. Maybe a
    Nothing
             -- More selectors to apply
             [GIRNodeSpec]
    _ -> 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 {XML.elementNodes =
                                                mapMaybe (girDeleteNodes rest)
                                                (XML.elementNodes elem)})
      else Node -> Maybe Node
    forall a. a -> Maybe a
    Just Node
    n
    girDeleteNodes [GIRNodeSpec]
    _ Node
    n = Node -> Maybe Node
    forall a. a -> Maybe a
    Just Node
    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
    lookupAndMatch :: GIRNameTag -> Map Name Text -> Name -> Bool
    lookupAndMatch GIRNameTag
    tag Map Name Text
    attrs 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 Text
    s -> case GIRNameTag
    tag of
                      GIRPlainName Text
    pn -> Text
    s Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    pn
                      GIRRegex 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
          Maybe Text
    Nothing -> Bool
    False

    -- | See if a given node specification applies to the given node.
    specMatch :: GIRNodeSpec -> XML.Node -> Bool
    specMatch :: GIRNodeSpec -> Node -> Bool
    specMatch (GIRType Text
    t) (XML.NodeElement 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 GIRNameTag
    name) (XML.NodeElement Element
    elem) =
        GIRNameTag -> Map Name Text -> Name -> Bool
    lookupAndMatch GIRNameTag
    name  (Element -> Map Name Text
    XML.elementAttributes Element
    elem) (Text -> Name
    xmlLocalName Text
    "name")
    specMatch (GIRTypedName Text
    t GIRNameTag
    name) (XML.NodeElement 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 Text
    "name")
    specMatch GIRNodeSpec
    _ Node
    _ = Bool
    False