    -- | The Parser monad.
    module Data.GI.GIR.Parser
        ( Parser
        , ParseContext(..)
        , ParseError
        , parseError

        , runParser

        , parseName
        , parseDeprecation
        , parseDocumentation
        , parseIntegral
        , parseBool
        , parseChildrenWithLocalName
        , parseAllChildrenWithLocalName
        , parseChildrenWithNSName

        , getAttr
        , getAttrWithNamespace
        , queryAttr
        , queryAttrWithNamespace
        , optionalAttr

        , currentNamespace
        , qualifyName
        , resolveQualifiedTypeName

        -- Reexported for convenience
        , Name(..)
        , Element
        , GIRXMLNamespace(..)
        , DeprecationInfo
        , Documentation
        ) where

    import Control.Monad.Except
    import Control.Monad.Reader

    #if !MIN_VERSION_base(4,11,0)
    import Data.Monoid ((<>))
    #endif
    import qualified Data.Map as M
    import qualified Data.Text as T
    import qualified Data.Text.Read as TR
    import Data.Text (Text)
    import qualified Text.XML as XML
    import Text.XML (Element(elementAttributes))
    import Text.Show.Pretty (ppShow)

    import Data.GI.GIR.BasicTypes (Name(..), Alias(..), Type(TInterface))
    import Data.GI.GIR.Deprecation (DeprecationInfo, queryDeprecated)
    import Data.GI.GIR.Documentation (Documentation, queryDocumentation)
    import Data.GI.GIR.XMLUtils (localName, GIRXMLNamespace(..),
                            childElemsWithLocalName, childElemsWithNSName,
                            lookupAttr, lookupAttrWithNamespace)

    -- | Info to carry around when parsing.
    data ParseContext = ParseContext {
          ParseContext -> ParseError
    ctxNamespace     :: Text,
          -- Location in the XML tree of the node being parsed (for
          -- debugging purposes).
          ParseContext -> [ParseError]
    treePosition     :: [Text],
          -- Current element being parsed (to be set by withElement)
          ParseContext -> Element
    currentElement   :: Element,
          ParseContext -> Map Alias Type
    knownAliases     :: M.Map Alias Type
        } deriving Int -> ParseContext -> ShowS
    [ParseContext] -> ShowS
    ParseContext -> String
    (Int -> ParseContext -> ShowS)
    -> (ParseContext -> String)
    -> ([ParseContext] -> ShowS)
    -> Show ParseContext
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ParseContext -> ShowS
    showsPrec :: Int -> ParseContext -> ShowS
    $cshow :: ParseContext -> String
    show :: ParseContext -> String
    $cshowList :: [ParseContext] -> ShowS
    showList :: [ParseContext] -> ShowS
    Show

    -- | A message describing a parsing error in human readable form.
    type ParseError = Text

    -- | Monad where parsers live: we carry a context around, and can
    -- throw errors that abort the parsing.
    type Parser a = ReaderT ParseContext (Except ParseError) a

    -- | Throw a parse error.
    parseError :: ParseError -> Parser a
    parseError :: forall a. ParseError -> Parser a
    parseError ParseError
    msg = do
      ctx <- ReaderT ParseContext (Except ParseError) ParseContext
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      let position = (ParseError -> [ParseError] -> ParseError
    T.intercalate ParseError
    " / " ([ParseError] -> ParseError)
    -> (ParseContext -> [ParseError]) -> ParseContext -> ParseError
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ParseError] -> [ParseError]
    forall a. [a] -> [a]
    reverse ([ParseError] -> [ParseError])
    -> (ParseContext -> [ParseError]) -> ParseContext -> [ParseError]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseContext -> [ParseError]
    treePosition) ParseContext
    ctx
      throwError $ "Error when parsing \"" <> position <> "\": " <> msg <> "\n"
                     <> (T.pack . ppShow . currentElement) ctx

    -- | Build a textual description (for debug purposes) of a given element.
    elementDescription :: Element -> Text
    elementDescription :: Element -> ParseError
    elementDescription Element
    element =
        case Name -> Map Name ParseError -> Maybe ParseError
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Name
    "name" (Element -> Map Name ParseError
    elementAttributes Element
    element) of
          Maybe ParseError
    Nothing -> Element -> ParseError
    localName Element
    element
          Just ParseError
    n -> Element -> ParseError
    localName Element
    element ParseError -> ParseError -> ParseError
    forall a. Semigroup a => a -> a -> a
    <> ParseError
    " [" ParseError -> ParseError -> ParseError
    forall a. Semigroup a => a -> a -> a
    <> ParseError
    n ParseError -> ParseError -> ParseError
    forall a. Semigroup a => a -> a -> a
    <> ParseError
    "]"

    -- | Build a name in the current namespace.
    nameInCurrentNS :: Text -> Parser Name
    nameInCurrentNS :: ParseError -> Parser Name
    nameInCurrentNS ParseError
    n = do
      ctx <- ReaderT ParseContext (Except ParseError) ParseContext
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      return $ Name (ctxNamespace ctx) n

    -- | Return the current namespace.
    currentNamespace :: Parser Text
    currentNamespace :: Parser ParseError
    currentNamespace = ParseContext -> ParseError
    ctxNamespace (ParseContext -> ParseError)
    -> ReaderT ParseContext (Except ParseError) ParseContext
    -> Parser ParseError
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ReaderT ParseContext (Except ParseError) ParseContext
    forall r (m :: * -> *). MonadReader r m => m r
    ask

    -- | Check whether there is an alias for the given name, and return
    -- the corresponding type in case it exists, and otherwise a TInterface.
    resolveQualifiedTypeName :: Name -> Parser Type
    resolveQualifiedTypeName :: Name -> Parser Type
    resolveQualifiedTypeName Name
    name = do
      ctx <- ReaderT ParseContext (Except ParseError) ParseContext
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      case M.lookup (Alias name) (knownAliases ctx) of
        -- The resolved type may be an alias itself, like for
        -- Gtk.Allocation -> Gdk.Rectangle -> cairo.RectangleInt
        Just (TInterface Name
    n) -> Name -> Parser Type
    resolveQualifiedTypeName Name
    n
        Just Type
    t -> Type -> Parser Type
    forall a. a -> ReaderT ParseContext (Except ParseError) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    t
        Maybe Type
    Nothing -> Type -> Parser Type
    forall a. a -> ReaderT ParseContext (Except ParseError) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> Parser Type) -> Type -> Parser Type
    forall a b. (a -> b) -> a -> b
    $ Name -> Type
    TInterface Name
    name

    -- | Return the value of an attribute for the given element. If the
    -- attribute is not present this throws an error.
    getAttr :: XML.Name -> Parser Text
    getAttr :: Name -> Parser ParseError
    getAttr Name
    attr = do
      ctx <- ReaderT ParseContext (Except ParseError) ParseContext
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      case lookupAttr attr (currentElement ctx) of
        Just ParseError
    val -> ParseError -> Parser ParseError
    forall a. a -> ReaderT ParseContext (Except ParseError) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ParseError
    val
        Maybe ParseError
    Nothing -> ParseError -> Parser ParseError
    forall a. ParseError -> Parser a
    parseError (ParseError -> Parser ParseError)
    -> ParseError -> Parser ParseError
    forall a b. (a -> b) -> a -> b
    $ ParseError
    "Expected attribute \"" ParseError -> ParseError -> ParseError
    forall a. Semigroup a => a -> a -> a
    <>
                   (String -> ParseError
    T.pack (String -> ParseError) -> (Name -> String) -> Name -> ParseError
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String
    forall a. Show a => a -> String
    show) Name
    attr ParseError -> ParseError -> ParseError
    forall a. Semigroup a => a -> a -> a
    <> ParseError
    "\" not present."

    -- | Like 'getAttr', but allow for specifying the namespace.
    getAttrWithNamespace :: GIRXMLNamespace -> XML.Name -> Parser Text
    getAttrWithNamespace :: GIRXMLNamespace -> Name -> Parser ParseError
    getAttrWithNamespace GIRXMLNamespace
    ns Name
    attr = do
      ctx <- ReaderT ParseContext (Except ParseError) ParseContext
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      case lookupAttrWithNamespace ns attr (currentElement ctx) of
        Just ParseError
    val -> ParseError -> Parser ParseError
    forall a. a -> ReaderT ParseContext (Except ParseError) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ParseError
    val
        Maybe ParseError
    Nothing -> ParseError -> Parser ParseError
    forall a. ParseError -> Parser a
    parseError (ParseError -> Parser ParseError)
    -> ParseError -> Parser ParseError
    forall a b. (a -> b) -> a -> b
    $ ParseError
    "Expected attribute \"" ParseError -> ParseError -> ParseError
    forall a. Semigroup a => a -> a -> a
    <>
                   (String -> ParseError
    T.pack (String -> ParseError) -> (Name -> String) -> Name -> ParseError
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String
    forall a. Show a => a -> String
    show) Name
    attr ParseError -> ParseError -> ParseError
    forall a. Semigroup a => a -> a -> a
    <> ParseError
    "\" in namespace \"" ParseError -> ParseError -> ParseError
    forall a. Semigroup a => a -> a -> a
    <>
                   (String -> ParseError
    T.pack (String -> ParseError)
    -> (GIRXMLNamespace -> String) -> GIRXMLNamespace -> ParseError
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GIRXMLNamespace -> String
    forall a. Show a => a -> String
    show) GIRXMLNamespace
    ns ParseError -> ParseError -> ParseError
    forall a. Semigroup a => a -> a -> a
    <> ParseError
    "\" not present."

    -- | Return the value of an attribute if it is present, and Nothing otherwise.
    queryAttr :: XML.Name -> Parser (Maybe Text)
    queryAttr :: Name -> Parser (Maybe ParseError)
    queryAttr Name
    attr = do
      ctx <- ReaderT ParseContext (Except ParseError) ParseContext
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      return $ lookupAttr attr (currentElement ctx)

    -- | Like `queryAttr`, but allow for specifying the namespace.
    queryAttrWithNamespace :: GIRXMLNamespace -> XML.Name -> Parser (Maybe Text)
    queryAttrWithNamespace :: GIRXMLNamespace -> Name -> Parser (Maybe ParseError)
    queryAttrWithNamespace GIRXMLNamespace
    ns Name
    attr = do
      ctx <- ReaderT ParseContext (Except ParseError) ParseContext
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      return $ lookupAttrWithNamespace ns attr (currentElement ctx)

    -- | Ask for an optional attribute, applying the given parser to
    -- it. If the argument does not exist return the default value provided.
    optionalAttr :: XML.Name -> a -> (Text -> Parser a) -> Parser a
    optionalAttr :: forall a. Name -> a -> (ParseError -> Parser a) -> Parser a
    optionalAttr Name
    attr a
    def ParseError -> Parser a
    parser =
        Name -> Parser (Maybe ParseError)
    queryAttr Name
    attr Parser (Maybe ParseError)
    -> (Maybe ParseError -> Parser a) -> Parser a
    forall a b.
    ReaderT ParseContext (Except ParseError) a
    -> (a -> ReaderT ParseContext (Except ParseError) b)
    -> ReaderT ParseContext (Except ParseError) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
                  Just ParseError
    a -> ParseError -> Parser a
    parser ParseError
    a
                  Maybe ParseError
    Nothing -> a -> Parser a
    forall a. a -> ReaderT ParseContext (Except ParseError) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    def

    -- | Build a 'Name' out of the (possibly qualified) supplied name. If
    -- the supplied name is unqualified we qualify with the current
    -- namespace, and otherwise we simply parse it.
    qualifyName :: Text -> Parser Name
    qualifyName :: ParseError -> Parser Name
    qualifyName ParseError
    n = case (Char -> Bool) -> ParseError -> [ParseError]
    T.split (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '.') ParseError
    n of
        [ParseError
    ns, ParseError
    name] -> Name -> Parser Name
    forall a. a -> ReaderT ParseContext (Except ParseError) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> Parser Name) -> Name -> Parser Name
    forall a b. (a -> b) -> a -> b
    $ ParseError -> ParseError -> Name
    Name ParseError
    ns ParseError
    name
        [ParseError
    name] -> ParseError -> Parser Name
    nameInCurrentNS ParseError
    name
        [ParseError]
    _ -> ParseError -> Parser Name
    forall a. ParseError -> Parser a
    parseError ParseError
    "Could not understand name"

    -- | Get the qualified name for the current element.
    parseName :: Parser Name
    parseName :: Parser Name
    parseName = Name -> Parser ParseError
    getAttr Name
    "name" Parser ParseError -> (ParseError -> Parser Name) -> Parser Name
    forall a b.
    ReaderT ParseContext (Except ParseError) a
    -> (a -> ReaderT ParseContext (Except ParseError) b)
    -> ReaderT ParseContext (Except ParseError) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ParseError -> Parser Name
    qualifyName

    -- | Parse the deprecation text, if present.
    parseDeprecation :: Parser (Maybe DeprecationInfo)
    parseDeprecation :: Parser (Maybe DeprecationInfo)
    parseDeprecation = do
      ctx <- ReaderT ParseContext (Except ParseError) ParseContext
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      return $ queryDeprecated (currentElement ctx)

    -- | Parse the documentation info for the current node.
    parseDocumentation :: Parser Documentation
    parseDocumentation :: Parser Documentation
    parseDocumentation = do
      ctx <- ReaderT ParseContext (Except ParseError) ParseContext
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      return $ queryDocumentation (currentElement ctx)

    -- | Parse a signed integral number.
    parseIntegral :: Integral a => Text -> Parser a
    parseIntegral :: forall a. Integral a => ParseError -> Parser a
    parseIntegral ParseError
    str =
        case Reader a -> Reader a
    forall a. Num a => Reader a -> Reader a
    TR.signed Reader a
    forall a. Integral a => Reader a
    TR.decimal ParseError
    str of
          Right (a
    n, ParseError
    r) | ParseError -> Bool
    T.null ParseError
    r -> a -> Parser a
    forall a. a -> ReaderT ParseContext (Except ParseError) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    n
          Either String (a, ParseError)
    _ -> ParseError -> Parser a
    forall a. ParseError -> Parser a
    parseError (ParseError -> Parser a) -> ParseError -> Parser a
    forall a b. (a -> b) -> a -> b
    $ ParseError
    "Could not parse integral value: \"" ParseError -> ParseError -> ParseError
    forall a. Semigroup a => a -> a -> a
    <> ParseError
    str ParseError -> ParseError -> ParseError
    forall a. Semigroup a => a -> a -> a
    <> ParseError
    "\"."

    -- | A boolean value given by a numerical constant.
    parseBool :: Text -> Parser Bool
    parseBool :: ParseError -> Parser Bool
    parseBool ParseError
    "0" = Bool -> Parser Bool
    forall a. a -> ReaderT ParseContext (Except ParseError) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
    parseBool ParseError
    "1" = Bool -> Parser Bool
    forall a. a -> ReaderT ParseContext (Except ParseError) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
    parseBool ParseError
    other = ParseError -> Parser Bool
    forall a. ParseError -> Parser a
    parseError (ParseError -> Parser Bool) -> ParseError -> Parser Bool
    forall a b. (a -> b) -> a -> b
    $ ParseError
    "Unsupported boolean value: " ParseError -> ParseError -> ParseError
    forall a. Semigroup a => a -> a -> a
    <> String -> ParseError
    T.pack (ParseError -> String
    forall a. Show a => a -> String
    show ParseError
    other)

    -- | Parse all the introspectable subelements with the given local name.
    parseChildrenWithLocalName :: Text -> Parser a -> Parser [a]
    parseChildrenWithLocalName :: forall a. ParseError -> Parser a -> Parser [a]
    parseChildrenWithLocalName ParseError
    n Parser a
    parser = do
      ctx <- ReaderT ParseContext (Except ParseError) ParseContext
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      let introspectableChildren = (Element -> Bool) -> [Element] -> [Element]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Element -> Bool
    introspectable
                                   (ParseError -> Element -> [Element]
    childElemsWithLocalName ParseError
    n (ParseContext -> Element
    currentElement ParseContext
    ctx))
      mapM (withElement parser) introspectableChildren
          where introspectable :: Element -> Bool
                introspectable :: Element -> Bool
    introspectable Element
    e = Name -> Element -> Maybe ParseError
    lookupAttr Name
    "introspectable" Element
    e Maybe ParseError -> Maybe ParseError -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ParseError -> Maybe ParseError
    forall a. a -> Maybe a
    Just ParseError
    "0" Bool -> Bool -> Bool
    &&
                                   Name -> Element -> Maybe ParseError
    lookupAttr Name
    "shadowed-by" Element
    e Maybe ParseError -> Maybe ParseError -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe ParseError
    forall a. Maybe a
    Nothing

    -- | Parse all subelements with the given local name.
    parseAllChildrenWithLocalName :: Text -> Parser a -> Parser [a]
    parseAllChildrenWithLocalName :: forall a. ParseError -> Parser a -> Parser [a]
    parseAllChildrenWithLocalName ParseError
    n Parser a
    parser = do
      ctx <- ReaderT ParseContext (Except ParseError) ParseContext
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      mapM (withElement parser) (childElemsWithLocalName n (currentElement ctx))

    -- | Parse all introspectable children with the given namespace and
    -- local name.
    parseChildrenWithNSName :: GIRXMLNamespace -> Text -> Parser a -> Parser [a]
    parseChildrenWithNSName :: forall a. GIRXMLNamespace -> ParseError -> Parser a -> Parser [a]
    parseChildrenWithNSName GIRXMLNamespace
    ns ParseError
    n Parser a
    parser = do
      ctx <- ReaderT ParseContext (Except ParseError) ParseContext
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      let introspectableChildren = (Element -> Bool) -> [Element] -> [Element]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Element -> Bool
    introspectable
                                   (GIRXMLNamespace -> ParseError -> Element -> [Element]
    childElemsWithNSName GIRXMLNamespace
    ns ParseError
    n (ParseContext -> Element
    currentElement ParseContext
    ctx))
      mapM (withElement parser) introspectableChildren
          where introspectable :: Element -> Bool
                introspectable :: Element -> Bool
    introspectable Element
    e = Name -> Element -> Maybe ParseError
    lookupAttr Name
    "introspectable" Element
    e Maybe ParseError -> Maybe ParseError -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ParseError -> Maybe ParseError
    forall a. a -> Maybe a
    Just ParseError
    "0"

    -- | Run the given parser for a given subelement in the XML tree.
    withElement :: Parser a -> Element -> Parser a
    withElement :: forall a. Parser a -> Element -> Parser a
    withElement Parser a
    parser Element
    element = (ParseContext -> ParseContext) -> Parser a -> Parser a
    forall a.
    (ParseContext -> ParseContext)
    -> ReaderT ParseContext (Except ParseError) a
    -> ReaderT ParseContext (Except ParseError) a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local ParseContext -> ParseContext
    modifyParsePosition Parser a
    parser
        where modifyParsePosition :: ParseContext -> ParseContext
    modifyParsePosition ParseContext
    ctx =
                  ParseContext
    ctx { treePosition = elementDescription element : treePosition ctx
                      , currentElement = element}

    -- | Run the given parser, returning either success or an error.
    runParser :: Text -> M.Map Alias Type -> Element -> Parser a ->
                 Either ParseError a
    runParser :: forall a.
    ParseError
    -> Map Alias Type -> Element -> Parser a -> Either ParseError a
    runParser ParseError
    ns Map Alias Type
    aliases Element
    element Parser a
    parser =
        Except ParseError a -> Either ParseError a
    forall e a. Except e a -> Either e a
    runExcept (Parser a -> ParseContext -> Except ParseError a
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT Parser a
    parser ParseContext
    ctx)
                  where ctx :: ParseContext
    ctx = ParseContext {
                                ctxNamespace :: ParseError
    ctxNamespace = ParseError
    ns
                              , treePosition :: [ParseError]
    treePosition = [Element -> ParseError
    elementDescription Element
    element]
                              , currentElement :: Element
    currentElement = Element
    element
                              , knownAliases :: Map Alias Type
    knownAliases = Map Alias Type
    aliases
                              }