    {-# LANGUAGE ViewPatterns #-}
    module Data.GI.CodeGen.Overrides
        ( Overrides(pkgConfigMap, cabalPkgVersion, nsChooseVersion, girFixups,
                    onlineDocsMap)
        , parseOverrides
        , filterAPIsAndDeps
        ) where

    #if !MIN_VERSION_base(4,8,0)
    import Control.Applicative ((<$>))
    import Data.Traversable (traverse)
    #endif

    #if MIN_VERSION_base(4,18,0)
    import Control.Monad (foldM)
    #endif
    import Control.Monad.Except
    import Control.Monad.State
    import Control.Monad.Writer (WriterT, execWriterT, tell)

    import Data.Maybe (isJust)
    import qualified Data.Map as M
    import Data.Semigroup as Sem
    import qualified Data.Set as S
    import qualified Data.Text as T
    import Data.Text (Text)
    import qualified Data.Version as V

    import Text.ParserCombinators.ReadP (readP_to_S)

    import qualified System.Info as SI

    import Data.GI.CodeGen.API
    import qualified Text.XML as XML
    import Data.GI.CodeGen.PkgConfig (tryPkgConfig)
    import Data.GI.CodeGen.Util (tshow, utf8ReadFile)
    import Data.GI.GIR.XMLUtils (xmlLocalName, xmlNSName,
                                 GIRXMLNamespace(CGIRNS, GLibGIRNS, CoreGIRNS))

    data Overrides = Overrides {
          -- | Ignored elements of a given API.
          Overrides -> Map Name (Set Text)
    ignoredElems    :: M.Map Name (S.Set Text),
          -- | Ignored APIs (all elements in this API will just be discarded).
          Overrides -> Set Name
    ignoredAPIs     :: S.Set Name,
          -- | Structs for which accessors should not be auto-generated.
          Overrides -> Set Name
    sealedStructs   :: S.Set Name,
          -- | Explicit calloc\/copy\/free for structs/unions.
          Overrides -> Map Name AllocationInfo
    allocInfo       :: M.Map Name AllocationInfo,
          -- | Mapping from GObject Introspection namespaces to pkg-config
          Overrides -> Map Text Text
    pkgConfigMap    :: M.Map Text Text,
          -- | Version number for the generated .cabal package.
          Overrides -> Maybe Text
    cabalPkgVersion :: Maybe Text,
          -- | Prefered version of the namespace.
          Overrides -> Map Text Text
    nsChooseVersion :: M.Map Text Text,
          -- | Fixups for the GIR data.
          Overrides -> [GIRRule]
    girFixups       :: [GIRRule],
          -- | Known places where to find the C docs.
          Overrides -> Map Text Text
    onlineDocsMap   :: M.Map Text Text
    } deriving (Int -> Overrides -> ShowS
    [Overrides] -> ShowS
    Overrides -> String
    (Int -> Overrides -> ShowS)
    -> (Overrides -> String)
    -> ([Overrides] -> ShowS)
    -> Show Overrides
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Overrides -> ShowS
    showsPrec :: Int -> Overrides -> ShowS
    $cshow :: Overrides -> String
    show :: Overrides -> String
    $cshowList :: [Overrides] -> ShowS
    showList :: [Overrides] -> ShowS
    Show)

    -- | Construct the generic config for a module.
    defaultOverrides :: Overrides
    defaultOverrides :: Overrides
    defaultOverrides = Overrides {
                         ignoredElems :: Map Name (Set Text)
    ignoredElems    = Map Name (Set Text)
    forall k a. Map k a
    M.empty,
                         ignoredAPIs :: Set Name
    ignoredAPIs     = Set Name
    forall a. Set a
    S.empty,
                         sealedStructs :: Set Name
    sealedStructs   = Set Name
    forall a. Set a
    S.empty,
                         allocInfo :: Map Name AllocationInfo
    allocInfo       = Map Name AllocationInfo
    forall k a. Map k a
    M.empty,
                         pkgConfigMap :: Map Text Text
    pkgConfigMap    = Map Text Text
    forall k a. Map k a
    M.empty,
                         cabalPkgVersion :: Maybe Text
    cabalPkgVersion = Maybe Text
    forall a. Maybe a
    Nothing,
                         nsChooseVersion :: Map Text Text
    nsChooseVersion = Map Text Text
    forall k a. Map k a
    M.empty,
                         girFixups :: [GIRRule]
    girFixups       = [],
                         onlineDocsMap :: Map Text Text
    onlineDocsMap   = Map Text Text
    forall k a. Map k a
    M.empty
                       }

    -- | There is a sensible notion of zero and addition of Overridess,
    -- encode this so that we can view the parser as a writer monad of
    -- configs.
    instance Monoid Overrides where
      mempty :: Overrides
    mempty = Overrides
    defaultOverrides
    #if !MIN_VERSION_base(4,11,0)
      mappend = concatOverrides
    #endif

    -- | There is a sensible notion of zero and addition of Overridess,
    -- encode this so that we can view the parser as a writer monad of
    -- configs.
    instance Sem.Semigroup Overrides where
      <> :: Overrides -> Overrides -> Overrides
    (<>) = Overrides -> Overrides -> Overrides
    concatOverrides

    -- | Addition of overrides is meaningful.
    concatOverrides :: Overrides -> Overrides -> Overrides
    concatOverrides :: Overrides -> Overrides -> Overrides
    concatOverrides Overrides
    a Overrides
    b = Overrides {
          ignoredAPIs :: Set Name
    ignoredAPIs = Overrides -> Set Name
    ignoredAPIs Overrides
    a Set Name -> Set Name -> Set Name
    forall a. Semigroup a => a -> a -> a
    <> Overrides -> Set Name
    ignoredAPIs Overrides
    b,
          sealedStructs :: Set Name
    sealedStructs = Overrides -> Set Name
    sealedStructs Overrides
    a Set Name -> Set Name -> Set Name
    forall a. Semigroup a => a -> a -> a
    <> Overrides -> Set Name
    sealedStructs Overrides
    b,
          allocInfo :: Map Name AllocationInfo
    allocInfo = Overrides -> Map Name AllocationInfo
    allocInfo Overrides
    a Map Name AllocationInfo
    -> Map Name AllocationInfo -> Map Name AllocationInfo
    forall a. Semigroup a => a -> a -> a
    <> Overrides -> Map Name AllocationInfo
    allocInfo Overrides
    b,
          ignoredElems :: Map Name (Set Text)
    ignoredElems = (Set Text -> Set Text -> Set Text)
    -> Map Name (Set Text)
    -> Map Name (Set Text)
    -> Map Name (Set Text)
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    M.unionWith Set Text -> Set Text -> Set Text
    forall a. Ord a => Set a -> Set a -> Set a
    S.union (Overrides -> Map Name (Set Text)
    ignoredElems Overrides
    a) (Overrides -> Map Name (Set Text)
    ignoredElems Overrides
    b),
          pkgConfigMap :: Map Text Text
    pkgConfigMap = Overrides -> Map Text Text
    pkgConfigMap Overrides
    a Map Text Text -> Map Text Text -> Map Text Text
    forall a. Semigroup a => a -> a -> a
    <> Overrides -> Map Text Text
    pkgConfigMap Overrides
    b,
          cabalPkgVersion :: Maybe Text
    cabalPkgVersion = if Maybe Text -> Bool
    forall a. Maybe a -> Bool
    isJust (Overrides -> Maybe Text
    cabalPkgVersion Overrides
    b)
                            then Overrides -> Maybe Text
    cabalPkgVersion Overrides
    b
                            else Overrides -> Maybe Text
    cabalPkgVersion Overrides
    a,
          nsChooseVersion :: Map Text Text
    nsChooseVersion = Overrides -> Map Text Text
    nsChooseVersion Overrides
    a Map Text Text -> Map Text Text -> Map Text Text
    forall a. Semigroup a => a -> a -> a
    <> Overrides -> Map Text Text
    nsChooseVersion Overrides
    b,
          girFixups :: [GIRRule]
    girFixups = Overrides -> [GIRRule]
    girFixups Overrides
    a [GIRRule] -> [GIRRule] -> [GIRRule]
    forall a. Semigroup a => a -> a -> a
    <> Overrides -> [GIRRule]
    girFixups Overrides
    b,
          onlineDocsMap :: Map Text Text
    onlineDocsMap = Overrides -> Map Text Text
    onlineDocsMap Overrides
    a Map Text Text -> Map Text Text -> Map Text Text
    forall a. Semigroup a => a -> a -> a
    <> Overrides -> Map Text Text
    onlineDocsMap Overrides
    b
        }

    -- | The state of the overrides parser.
    data ParserState = ParserState {
          ParserState -> Maybe Text
    currentNS :: Maybe Text   -- ^ The current namespace.
        , ParserState -> [Bool]
    flags     :: [Bool] -- ^ The contents of the override file will
                              -- be ignored if there is any `False` value
                              -- here. @if@ primitive push (prepend)
                              -- values here, @endif@ pop them.
        } deriving (Int -> ParserState -> ShowS
    [ParserState] -> ShowS
    ParserState -> String
    (Int -> ParserState -> ShowS)
    -> (ParserState -> String)
    -> ([ParserState] -> ShowS)
    -> Show ParserState
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ParserState -> ShowS
    showsPrec :: Int -> ParserState -> ShowS
    $cshow :: ParserState -> String
    show :: ParserState -> String
    $cshowList :: [ParserState] -> ShowS
    showList :: [ParserState] -> ShowS
    Show)

    -- | Default, empty, parser state.
    emptyParserState :: ParserState
    emptyParserState :: ParserState
    emptyParserState = ParserState {
                         currentNS :: Maybe Text
    currentNS = Maybe Text
    forall a. Maybe a
    Nothing
                       , flags :: [Bool]
    flags = []
                       }

    -- | Get the current namespace.
    getNS :: Parser (Maybe Text)
    getNS :: Parser (Maybe Text)
    getNS = ParserState -> Maybe Text
    currentNS (ParserState -> Maybe Text)
    -> WriterT
         Overrides (StateT ParserState (ExceptT Text IO)) ParserState
    -> Parser (Maybe Text)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WriterT
      Overrides (StateT ParserState (ExceptT Text IO)) ParserState
    forall s (m :: * -> *). MonadState s m => m s
    get

    -- | Run the given parser only if the flags can be satisfied.
    withFlags :: Parser () -> Parser ()
    withFlags :: Parser () -> Parser ()
    withFlags Parser ()
    p = do
      fs <- ParserState -> [Bool]
    flags (ParserState -> [Bool])
    -> WriterT
         Overrides (StateT ParserState (ExceptT Text IO)) ParserState
    -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) [Bool]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> WriterT
      Overrides (StateT ParserState (ExceptT Text IO)) ParserState
    forall s (m :: * -> *). MonadState s m => m s
    get
      if and fs
      then p
      else return ()

    -- | We have a bit of context (the current namespace), and can fail,
    -- encode this in a monad.
    type Parser a = WriterT Overrides (StateT ParserState (ExceptT Text IO)) a

    -- | Parse the given overrides, filling in the configuration as
    -- needed. In case the parsing fails we return a description of the
    -- error instead.
    parseOverrides :: Text -> IO (Either Text Overrides)
    parseOverrides :: Text -> IO (Either Text Overrides)
    parseOverrides Text
    overrides = do
      ExceptT Text IO Overrides -> IO (Either Text Overrides)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT Text IO Overrides -> IO (Either Text Overrides))
    -> ExceptT Text IO Overrides -> IO (Either Text Overrides)
    forall a b. (a -> b) -> a -> b
    $ (StateT ParserState (ExceptT Text IO) Overrides
     -> ParserState -> ExceptT Text IO Overrides)
    -> ParserState
    -> StateT ParserState (ExceptT Text IO) Overrides
    -> ExceptT Text IO Overrides
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip StateT ParserState (ExceptT Text IO) Overrides
    -> ParserState -> ExceptT Text IO Overrides
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT ParserState
    emptyParserState (StateT ParserState (ExceptT Text IO) Overrides
     -> ExceptT Text IO Overrides)
    -> StateT ParserState (ExceptT Text IO) Overrides
    -> ExceptT Text IO Overrides
    forall a b. (a -> b) -> a -> b
    $ WriterT Overrides (StateT ParserState (ExceptT Text IO)) [()]
    -> StateT ParserState (ExceptT Text IO) Overrides
    forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
    execWriterT (WriterT Overrides (StateT ParserState (ExceptT Text IO)) [()]
     -> StateT ParserState (ExceptT Text IO) Overrides)
    -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) [()]
    -> StateT ParserState (ExceptT Text IO) Overrides
    forall a b. (a -> b) -> a -> b
    $
        (Text -> Parser ())
    -> [Text]
    -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) [()]
    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 (Text -> Parser ()
    parseOneLine (Text -> Parser ()) -> (Text -> Text) -> Text -> Parser ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    T.strip) (Text -> [Text]
    T.lines Text
    overrides)

    -- | Parse a single line of the config file, modifying the
    -- configuration as appropriate.
    parseOneLine :: Text -> Parser ()
    -- Empty lines
    parseOneLine :: Text -> Parser ()
    parseOneLine Text
    line | Text -> Bool
    T.null Text
    line = () -> Parser ()
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    -- Comments
    parseOneLine (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "#" -> Just Text
    _) = () -> Parser ()
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    parseOneLine (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "namespace " -> Just Text
    ns) =
        Parser () -> Parser ()
    withFlags (Parser () -> Parser ()) -> Parser () -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ (ParserState -> ParserState) -> Parser ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify' (\ParserState
    s -> ParserState
    s {currentNS = (Just . T.strip) ns})
    parseOneLine (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "ignore " -> Just Text
    ign) =
        Parser () -> Parser ()
    withFlags (Parser () -> Parser ()) -> Parser () -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Parser (Maybe Text)
    getNS Parser (Maybe Text) -> (Maybe Text -> Parser ()) -> Parser ()
    forall a b.
    WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    -> (a
        -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) b)
    -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Text -> Maybe Text -> Parser ()
    parseIgnore Text
    ign
    parseOneLine (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "seal " -> Just Text
    s) =
        Parser () -> Parser ()
    withFlags (Parser () -> Parser ()) -> Parser () -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Parser (Maybe Text)
    getNS Parser (Maybe Text) -> (Maybe Text -> Parser ()) -> Parser ()
    forall a b.
    WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    -> (a
        -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) b)
    -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Text -> Maybe Text -> Parser ()
    parseSeal Text
    s
    parseOneLine (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "alloc-info " -> Just Text
    s) =
        Parser () -> Parser ()
    withFlags (Parser () -> Parser ()) -> Parser () -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Parser (Maybe Text)
    getNS Parser (Maybe Text) -> (Maybe Text -> Parser ()) -> Parser ()
    forall a b.
    WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    -> (a
        -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) b)
    -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Text -> Maybe Text -> Parser ()
    parseAllocInfo Text
    s
    parseOneLine (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "pkg-config-name " -> Just Text
    s) =
        Parser () -> Parser ()
    withFlags (Parser () -> Parser ()) -> Parser () -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Parser ()
    parsePkgConfigName Text
    s
    parseOneLine (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "cabal-pkg-version " -> Just Text
    s) =
        Parser () -> Parser ()
    withFlags (Parser () -> Parser ()) -> Parser () -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Parser ()
    parseCabalPkgVersion Text
    s
    parseOneLine (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "namespace-version " -> Just Text
    s) =
        Parser () -> Parser ()
    withFlags (Parser () -> Parser ()) -> Parser () -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Parser ()
    parseNsVersion Text
    s
    parseOneLine (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "set-attr " -> Just Text
    s) =
        Parser () -> Parser ()
    withFlags (Parser () -> Parser ()) -> Parser () -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Parser ()
    parseSetAttr Text
    s
    parseOneLine (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "delete-attr " -> Just Text
    s) =
        Parser () -> Parser ()
    withFlags (Parser () -> Parser ()) -> Parser () -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Parser ()
    parseDeleteAttr Text
    s
    parseOneLine (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "add-node " -> Just Text
    s) =
        Parser () -> Parser ()
    withFlags (Parser () -> Parser ()) -> Parser () -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Parser ()
    parseAdd Text
    s
    parseOneLine (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "delete-node " -> Just Text
    s) =
        Parser () -> Parser ()
    withFlags (Parser () -> Parser ()) -> Parser () -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Parser ()
    parseDelete Text
    s
    parseOneLine (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "C-docs-url " -> Just Text
    u) =
        Parser () -> Parser ()
    withFlags (Parser () -> Parser ()) -> Parser () -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Parser ()
    parseDocsUrl Text
    u
    parseOneLine (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "if " -> Just Text
    s) = Text -> Parser ()
    parseIf Text
    s
    parseOneLine (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "endif" -> Just Text
    s) = Text -> Parser ()
    parseEndif Text
    s
    parseOneLine (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "include " -> Just Text
    s) = Text -> Parser ()
    parseInclude Text
    s
    parseOneLine Text
    l = Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> Parser ()) -> Text -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "Could not understand \"" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    l Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\"."

    -- | Ignored elements.
    parseIgnore :: Text -> Maybe Text -> Parser ()
    parseIgnore :: Text -> Maybe Text -> Parser ()
    parseIgnore Text
    _ Maybe Text
    Nothing =
        Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError Text
    "'ignore' requires a namespace to be defined first."
    parseIgnore (Text -> [Text]
    T.words -> [HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    T.splitOn Text
    "." -> [Text
    api,Text
    elem]]) (Just Text
    ns) =
        Overrides -> Parser ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell (Overrides -> Parser ()) -> Overrides -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Overrides
    defaultOverrides {ignoredElems = M.singleton (Name ns api)
                                             (S.singleton elem)}
    parseIgnore (Text -> [Text]
    T.words -> [HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    T.splitOn Text
    "." -> [Text
    api]]) (Just Text
    ns) =
        Overrides -> Parser ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell (Overrides -> Parser ()) -> Overrides -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Overrides
    defaultOverrides {ignoredAPIs = S.singleton (Name ns api)}
    parseIgnore Text
    ignore Maybe Text
    _ =
        Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "Ignore syntax is of the form \"ignore API.elem\" with '.elem' optional.\nGot \"ignore " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ignore Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" instead.")

    -- | Sealed structures.
    parseSeal :: Text -> Maybe Text -> Parser ()
    parseSeal :: Text -> Maybe Text -> Parser ()
    parseSeal Text
    _ Maybe Text
    Nothing = Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError Text
    "'seal' requires a namespace to be defined first."
    parseSeal (Text -> [Text]
    T.words -> [Text
    s]) (Just Text
    ns) = Overrides -> Parser ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell (Overrides -> Parser ()) -> Overrides -> Parser ()
    forall a b. (a -> b) -> a -> b
    $
        Overrides
    defaultOverrides {sealedStructs = S.singleton (Name ns s)}
    parseSeal Text
    seal Maybe Text
    _ =
        Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "seal syntax is of the form \"seal name\".\nGot \"seal "
                    Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    seal Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" instead.")

    -- | Explicit allocation info for wrapped pointers.
    parseAllocInfo :: Text -> Maybe Text -> Parser ()
    parseAllocInfo :: Text -> Maybe Text -> Parser ()
    parseAllocInfo Text
    _ Maybe Text
    Nothing = Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError Text
    "'alloc-info' requires a namespace to be defined first."
    parseAllocInfo (Text -> [Text]
    T.words -> (Text
    n:[Text]
    ops)) (Just Text
    ns) = do
      parsedOps <- (Text
     -> WriterT
          Overrides (StateT ParserState (ExceptT Text IO)) (Text, Text))
    -> [Text]
    -> WriterT
         Overrides (StateT ParserState (ExceptT Text IO)) [(Text, Text)]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse Text
    -> WriterT
         Overrides (StateT ParserState (ExceptT Text IO)) (Text, Text)
    parseKeyValuePair [Text]
    ops
      info <- foldM applyOp unknownAllocationInfo parsedOps
      tell $ defaultOverrides {allocInfo = M.singleton (Name ns n) info}
      where applyOp :: AllocationInfo -> (Text, Text) -> Parser AllocationInfo
            applyOp :: AllocationInfo
    -> (Text, Text)
    -> WriterT
         Overrides (StateT ParserState (ExceptT Text IO)) AllocationInfo
    applyOp AllocationInfo
    a (Text
    "calloc", Text
    f) = AllocationInfo
    -> WriterT
         Overrides (StateT ParserState (ExceptT Text IO)) AllocationInfo
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AllocationInfo
    a {allocCalloc = AllocationOp f})
            applyOp AllocationInfo
    a (Text
    "copy", Text
    f) = AllocationInfo
    -> WriterT
         Overrides (StateT ParserState (ExceptT Text IO)) AllocationInfo
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AllocationInfo
    a {allocCopy = AllocationOp f})
            applyOp AllocationInfo
    a (Text
    "free", Text
    f) = AllocationInfo
    -> WriterT
         Overrides (StateT ParserState (ExceptT Text IO)) AllocationInfo
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (AllocationInfo
    a {allocFree = AllocationOp f})
            applyOp AllocationInfo
    _ (Text
    op, Text
    _) = Text
    -> WriterT
         Overrides (StateT ParserState (ExceptT Text IO)) AllocationInfo
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "Unknown alloc op \"" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    op Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\".")
    parseAllocInfo Text
    info Maybe Text
    _ =
        Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "alloc-info syntax is of the form "
                    Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\"alloc-info name calloc copy free\", with \"-\" meaning "
                    Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "a masked operation. Got \"alloc-info " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    info
                    Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" instead.")

    -- | Parse a explicit key=value pair into a (key, value) tuple.
    parseKeyValuePair :: Text -> Parser (Text, Text)
    parseKeyValuePair :: Text
    -> WriterT
         Overrides (StateT ParserState (ExceptT Text IO)) (Text, Text)
    parseKeyValuePair Text
    p =
        case HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    T.splitOn Text
    "=" Text
    p of
          [Text
    k,Text
    v] -> (Text, Text)
    -> WriterT
         Overrides (StateT ParserState (ExceptT Text IO)) (Text, Text)
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text
    k, Text
    v)
          [Text]
    _ -> Text
    -> WriterT
         Overrides (StateT ParserState (ExceptT Text IO)) (Text, Text)
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "Could not parse \"" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    p Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\"as a \"key=value\" pair.")

    -- | Mapping from GObject Introspection namespaces to pkg-config.
    parsePkgConfigName :: Text -> Parser ()
    parsePkgConfigName :: Text -> Parser ()
    parsePkgConfigName (Text -> [Text]
    T.words -> [Text
    gi,Text
    pc]) = Overrides -> Parser ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell (Overrides -> Parser ()) -> Overrides -> Parser ()
    forall a b. (a -> b) -> a -> b
    $
        Overrides
    defaultOverrides {pkgConfigMap =
                              M.singleton (T.toLower gi) pc}
    parsePkgConfigName Text
    t =
        Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "pkg-config-name syntax is of the form\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                    Text
    "\t\"pkg-config-name gi-namespace pk-name\"\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                    Text
    "Got \"pkg-config-name " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" instead.")

    -- | Choose a preferred namespace version to load.
    parseNsVersion :: Text -> Parser ()
    parseNsVersion :: Text -> Parser ()
    parseNsVersion (Text -> [Text]
    T.words -> [Text
    ns,Text
    version]) = Overrides -> Parser ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell (Overrides -> Parser ()) -> Overrides -> Parser ()
    forall a b. (a -> b) -> a -> b
    $
        Overrides
    defaultOverrides {nsChooseVersion =
                              M.singleton ns version}
    parseNsVersion Text
    t =
        Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "namespace-version syntax is of the form\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                    Text
    "\t\"namespace-version namespace version\"\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                    Text
    "Got \"namespace-version " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" instead.")

    -- | Specifying the cabal package version by hand.
    parseCabalPkgVersion :: Text -> Parser ()
    parseCabalPkgVersion :: Text -> Parser ()
    parseCabalPkgVersion (Text -> [Text]
    T.words -> [Text
    version]) = Overrides -> Parser ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell (Overrides -> Parser ()) -> Overrides -> Parser ()
    forall a b. (a -> b) -> a -> b
    $
        Overrides
    defaultOverrides {cabalPkgVersion = Just version}
    parseCabalPkgVersion Text
    t =
        Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "cabal-pkg-version syntax is of the form\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                   Text
    "\t\"cabal-pkg-version version\"\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                   Text
    "Got \"cabal-pkg-version " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" instead.")

    -- | Set a given attribute in the GIR file.
    parseSetAttr :: Text -> Parser ()
    parseSetAttr :: Text -> Parser ()
    parseSetAttr (Text -> [Text]
    T.words -> [Text
    path, Text
    attr, Text
    newVal]) = do
      pathSpec <- Text -> Parser GIRPath
    parsePathSpec Text
    path
      parsedAttr <- parseXMLName attr
      tell $ defaultOverrides {girFixups =
                               [GIRSetAttr (pathSpec, parsedAttr) newVal]}
    parseSetAttr Text
    t =
        Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "set-attr syntax is of the form\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                   Text
    "\t\"set-attr nodePath attrName newValue\"\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                   Text
    "Got \"set-attr " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" instead.")

    -- | Delete the given attribute
    parseDeleteAttr :: Text -> Parser ()
    parseDeleteAttr :: Text -> Parser ()
    parseDeleteAttr (Text -> [Text]
    T.words -> [Text
    path, Text
    attr]) = do
      pathSpec <- Text -> Parser GIRPath
    parsePathSpec Text
    path
      parsedAttr <- parseXMLName attr
      tell $ defaultOverrides {girFixups = [GIRDeleteAttr pathSpec parsedAttr]}
    parseDeleteAttr Text
    t =
        Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "delete-attr syntax is of the form\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                   Text
    "\t\"delete-attr nodePath attrName\"\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                   Text
    "Got \"delete-attr " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" instead.")

    -- | Add the given child node to all nodes matching the path.
    parseAdd :: Text -> Parser ()
    parseAdd :: Text -> Parser ()
    parseAdd (Text -> [Text]
    T.words -> [Text
    path, Text
    name]) = do
      pathSpec <- Text -> Parser GIRPath
    parsePathSpec Text
    path
      parsedName <- parseXMLName name
      tell $ defaultOverrides {girFixups = [GIRAddNode pathSpec parsedName]}
    parseAdd Text
    t =
        Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "add-node syntax is of the form\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                   Text
    "\t\"add-node nodePath newName\"\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                   Text
    "Got \"add-node " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" instead.")

    -- | Delete all nodes matching the given path.
    parseDelete :: Text -> Parser ()
    parseDelete :: Text -> Parser ()
    parseDelete (Text -> [Text]
    T.words -> [Text
    path]) = do
      pathSpec <- Text -> Parser GIRPath
    parsePathSpec Text
    path
      tell $ defaultOverrides {girFixups = [GIRDeleteNode pathSpec]}
    parseDelete Text
    t =
        Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "delete-node syntax is of the form\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                   Text
    "\t\"delete-node nodePath\"\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                   Text
    "Got \"delete-node " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" instead.")

    -- | Parse a documentation URL for the given module.
    parseDocsUrl :: Text -> Parser ()
    parseDocsUrl :: Text -> Parser ()
    parseDocsUrl (Text -> [Text]
    T.words -> [Text
    ns, Text
    url]) = do
      Overrides -> Parser ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell (Overrides -> Parser ()) -> Overrides -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Overrides
    defaultOverrides { onlineDocsMap = M.singleton ns url }
    parseDocsUrl Text
    t =
      Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "C-docs-url syntax of of the form\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                  Text
    "\t\"C-docs-url namespace url\"\n" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                  Text
    "Got \"C-docs-url " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" instead.")

    -- | Parse a path specification, which is of the form
    -- "nodeSpec1/nodeSpec2/../nodeSpecN", where nodeSpec is a node
    -- specification of the form "nodeType[:name attribute]".
    parsePathSpec :: Text -> Parser GIRPath
    parsePathSpec :: Text -> Parser GIRPath
    parsePathSpec Text
    spec = (Text
     -> WriterT
          Overrides (StateT ParserState (ExceptT Text IO)) GIRNodeSpec)
    -> [Text] -> Parser GIRPath
    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 Text
    -> WriterT
         Overrides (StateT ParserState (ExceptT Text IO)) GIRNodeSpec
    parseNodeSpec (HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    T.splitOn Text
    "/" Text
    spec)

    -- | A specification of a name, which is either a regex (prefixed with
    -- "~") or a plain name.
    parseGIRNameTag :: Text -> GIRNameTag
    parseGIRNameTag :: Text -> GIRNameTag
    parseGIRNameTag (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "~" -> Just Text
    regex) = Text -> GIRNameTag
    GIRRegex Text
    regex
    parseGIRNameTag Text
    t = Text -> GIRNameTag
    GIRPlainName Text
    t

    -- | Parse a single node specification.
    parseNodeSpec :: Text -> Parser GIRNodeSpec
    parseNodeSpec :: Text
    -> WriterT
         Overrides (StateT ParserState (ExceptT Text IO)) GIRNodeSpec
    parseNodeSpec Text
    spec = case HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    T.splitOn Text
    "@" Text
    spec of
                           [Text
    n] -> GIRNodeSpec
    -> WriterT
         Overrides (StateT ParserState (ExceptT Text IO)) GIRNodeSpec
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GIRNameTag -> GIRNodeSpec
    GIRNamed (Text -> GIRNameTag
    parseGIRNameTag Text
    n))
                           [Text
    "", Text
    t] -> GIRNodeSpec
    -> WriterT
         Overrides (StateT ParserState (ExceptT Text IO)) GIRNodeSpec
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> GIRNodeSpec
    GIRType Text
    t)
                           [Text
    n, Text
    t] -> GIRNodeSpec
    -> WriterT
         Overrides (StateT ParserState (ExceptT Text IO)) GIRNodeSpec
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> GIRNameTag -> GIRNodeSpec
    GIRTypedName Text
    t (Text -> GIRNameTag
    parseGIRNameTag Text
    n))
                           [Text]
    _ -> Text
    -> WriterT
         Overrides (StateT ParserState (ExceptT Text IO)) GIRNodeSpec
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "Could not understand node spec \""
                                            Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    spec Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\".")

    -- | Parse an XML name, with an optional prefix.
    parseXMLName :: Text -> Parser XML.Name
    parseXMLName :: Text -> Parser Name
    parseXMLName Text
    a = case HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    T.splitOn Text
    ":" Text
    a of
                       [Text
    n] -> Name -> Parser Name
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> Name
    xmlLocalName Text
    n)
                       [Text
    "c", Text
    n] -> Name -> Parser Name
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GIRXMLNamespace -> Text -> Name
    xmlNSName GIRXMLNamespace
    CGIRNS Text
    n)
                       [Text
    "glib", Text
    n] -> Name -> Parser Name
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GIRXMLNamespace -> Text -> Name
    xmlNSName GIRXMLNamespace
    GLibGIRNS Text
    n)
                       [Text
    "core", Text
    n] -> Name -> Parser Name
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GIRXMLNamespace -> Text -> Name
    xmlNSName GIRXMLNamespace
    CoreGIRNS Text
    n)
                       [Text]
    _ -> Text -> Parser Name
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "Could not understand xml name \""
                                        Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    a Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\".")

    -- | Known operating systems.
    data OSType = Linux
                | OSX
                | Windows
                  deriving (Int -> OSType -> ShowS
    [OSType] -> ShowS
    OSType -> String
    (Int -> OSType -> ShowS)
    -> (OSType -> String) -> ([OSType] -> ShowS) -> Show OSType
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> OSType -> ShowS
    showsPrec :: Int -> OSType -> ShowS
    $cshow :: OSType -> String
    show :: OSType -> String
    $cshowList :: [OSType] -> ShowS
    showList :: [OSType] -> ShowS
    Show)

    -- | Check whether we are running under the given OS.
    checkOS :: String -> Parser Bool
    checkOS :: String -> Parser Bool
    checkOS String
    os = Bool -> Parser Bool
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    SI.os String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    os)

    -- | Parse a textual representation of a version into a `Data.Version.Version`.
    parseVersion :: Text -> Parser V.Version
    parseVersion :: Text -> Parser Version
    parseVersion Text
    v = ([(Version, String)] -> Parser Version
    chooseFullParse ([(Version, String)] -> Parser Version)
    -> (Text -> [(Version, String)]) -> Text -> Parser Version
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ReadP Version -> ReadS Version
    forall a. ReadP a -> ReadS a
    readP_to_S ReadP Version
    V.parseVersion ReadS Version -> (Text -> String) -> Text -> [(Version, String)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack) Text
    v
        where chooseFullParse :: [(V.Version, String)] -> Parser V.Version
              chooseFullParse :: [(Version, String)] -> Parser Version
    chooseFullParse [] = Text -> Parser Version
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "Could not parse version \""
                                               Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    v Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\".")
              chooseFullParse [(Version
    parsed, String
    "")] = Version -> Parser Version
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Version
    parsed
              chooseFullParse ((Version, String)
    _ : [(Version, String)]
    rest) = [(Version, String)] -> Parser Version
    chooseFullParse [(Version, String)]
    rest

    -- | Check that the given pkg-config package has a version compatible
    -- with the given constraint.
    checkPkgConfigVersion :: Text -> Text -> Text -> Parser Bool
    checkPkgConfigVersion :: Text -> Text -> Text -> Parser Bool
    checkPkgConfigVersion Text
    pkg Text
    op Text
    tVersion = do
      version <- Text -> Parser Version
    parseVersion Text
    tVersion
      pcVersion <- liftIO (tryPkgConfig pkg) >>= \case
                   Maybe (Text, Text)
    Nothing ->
                       Text -> Parser Version
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "Could not determine pkg-config version for \""
                                   Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    pkg Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\".")
                   Just (Text
    _, Text
    tv) -> Text -> Parser Version
    parseVersion Text
    tv
      case op of
        Text
    "==" -> Bool -> Parser Bool
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Version
    pcVersion Version -> Version -> Bool
    forall a. Eq a => a -> a -> Bool
    == Version
    version)
        Text
    "/=" -> Bool -> Parser Bool
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Version
    pcVersion Version -> Version -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Version
    version)
        Text
    ">=" -> Bool -> Parser Bool
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Version
    pcVersion Version -> Version -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Version
    version)
        Text
    ">"  -> Bool -> Parser Bool
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Version
    pcVersion Version -> Version -> Bool
    forall a. Ord a => a -> a -> Bool
    >  Version
    version)
        Text
    "<=" -> Bool -> Parser Bool
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Version
    pcVersion Version -> Version -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Version
    version)
        Text
    "<"  -> Bool -> Parser Bool
    forall a.
    a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Version
    pcVersion Version -> Version -> Bool
    forall a. Ord a => a -> a -> Bool
    <  Version
    version)
        Text
    _    -> Text -> Parser Bool
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "Unrecognized comparison operator \"" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    op Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\".")

    -- | Parse a 'if' directive.
    parseIf :: Text -> Parser ()
    parseIf :: Text -> Parser ()
    parseIf Text
    cond = case Text -> [Text]
    T.words Text
    cond of
                     [] -> Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "Empty 'if' condition.")
                     [Text
    "linux"] -> String -> Parser Bool
    checkOS String
    "linux" Parser Bool -> (Bool -> Parser ()) -> Parser ()
    forall a b.
    WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    -> (a
        -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) b)
    -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Bool -> Parser ()
    setFlag
                     [Text
    "osx"] -> String -> Parser Bool
    checkOS String
    "darwin" Parser Bool -> (Bool -> Parser ()) -> Parser ()
    forall a b.
    WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    -> (a
        -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) b)
    -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Bool -> Parser ()
    setFlag
                     [Text
    "windows"] -> String -> Parser Bool
    checkOS String
    "mingw32" Parser Bool -> (Bool -> Parser ()) -> Parser ()
    forall a b.
    WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    -> (a
        -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) b)
    -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Bool -> Parser ()
    setFlag
                     (Text
    "pkg-config-version" : [Text]
    rest) ->
                         case [Text]
    rest of
                           [Text
    pkg, Text
    op, Text
    version] ->
                               Text -> Text -> Text -> Parser Bool
    checkPkgConfigVersion Text
    pkg Text
    op Text
    version Parser Bool -> (Bool -> Parser ()) -> Parser ()
    forall a b.
    WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    -> (a
        -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) b)
    -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Bool -> Parser ()
    setFlag
                           [Text]
    _ -> Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "Syntax for `pkg-config-version' is "
                                            Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\"pkg op version\", got \""
                                            Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Text] -> Text
    forall a. Show a => a -> Text
    tshow [Text]
    rest Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\".")
                     [Text]
    _ -> Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "Unknown condition \"" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    cond Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\".")
        where setFlag :: Bool -> Parser ()
              setFlag :: Bool -> Parser ()
    setFlag Bool
    flag = (ParserState -> ParserState) -> Parser ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify' (\ParserState
    s -> ParserState
    s {flags = flag : flags s})

    -- | Parse an 'endif' directive.
    parseEndif :: Text -> Parser ()
    parseEndif :: Text -> Parser ()
    parseEndif Text
    rest = case Text -> [Text]
    T.words Text
    rest of
                        [] -> Parser ()
    unsetFlag
                        [Text]
    _ -> Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "Unexpected argument to 'endif': \""
                                         Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    rest Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\".")
        where unsetFlag :: Parser ()
              unsetFlag :: Parser ()
    unsetFlag = do
                s <- WriterT
      Overrides (StateT ParserState (ExceptT Text IO)) ParserState
    forall s (m :: * -> *). MonadState s m => m s
    get
                case flags s of
                  Bool
    _:[Bool]
    rest -> ParserState -> Parser ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put (ParserState
    s {flags = rest})
                  [] -> Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "'endif' with no matching 'if'.")

    -- | Parse the given overrides file, and merge into the given context.
    parseInclude :: Text -> Parser ()
    parseInclude :: Text -> Parser ()
    parseInclude Text
    fname = do
      includeText <- IO Text
    -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) Text
    forall a.
    IO a -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Text
     -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) Text)
    -> IO Text
    -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) Text
    forall a b. (a -> b) -> a -> b
    $ String -> IO Text
    utf8ReadFile (Text -> String
    T.unpack Text
    fname)
      liftIO (parseOverrides includeText) >>= \case
        Left Text
    err -> Text -> Parser ()
    forall a.
    Text -> WriterT Overrides (StateT ParserState (ExceptT Text IO)) a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text
    "Error when parsing included '"
                                Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    fname Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "': " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    err)
        Right Overrides
    ovs -> Overrides -> Parser ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell Overrides
    ovs

    -- | Filter a set of named objects based on a lookup list of names to
    -- ignore.
    filterMethods :: [Method] -> S.Set Text -> [Method]
    filterMethods :: [Method] -> Set Text -> [Method]
    filterMethods [Method]
    set Set Text
    ignores =
        (Method -> Bool) -> [Method] -> [Method]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Text -> Set Text -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.notMember` Set Text
    ignores) (Text -> Bool) -> (Method -> Text) -> Method -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Text
    name (Name -> Text) -> (Method -> Name) -> Method -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Method -> Name
    methodName) [Method]
    set

    -- | Given the previous allocation info, and a new allocation info,
    -- replace those entries in the old allocation info which are
    -- specified in the new info.
    filterAllocInfo :: AllocationInfo -> AllocationInfo -> AllocationInfo
    filterAllocInfo :: AllocationInfo -> AllocationInfo -> AllocationInfo
    filterAllocInfo AllocationInfo
    old AllocationInfo
    new =
        AllocationInfo { allocCalloc :: AllocationOp
    allocCalloc = AllocationOp -> AllocationOp -> AllocationOp
    replace (AllocationInfo -> AllocationOp
    allocCalloc AllocationInfo
    old) (AllocationInfo -> AllocationOp
    allocCalloc AllocationInfo
    new)
                       , allocCopy :: AllocationOp
    allocCopy = AllocationOp -> AllocationOp -> AllocationOp
    replace (AllocationInfo -> AllocationOp
    allocCopy AllocationInfo
    old) (AllocationInfo -> AllocationOp
    allocCopy AllocationInfo
    new)
                       , allocFree :: AllocationOp
    allocFree = AllocationOp -> AllocationOp -> AllocationOp
    replace (AllocationInfo -> AllocationOp
    allocFree AllocationInfo
    old) (AllocationInfo -> AllocationOp
    allocFree AllocationInfo
    new) }
        where replace :: AllocationOp -> AllocationOp -> AllocationOp
              replace :: AllocationOp -> AllocationOp -> AllocationOp
    replace AllocationOp
    o AllocationOp
    AllocationOpUnknown = AllocationOp
    o
              replace AllocationOp
    _ AllocationOp
    o = AllocationOp
    o

    -- | Filter one API according to the given config.
    filterOneAPI :: Overrides -> (Name, API, Maybe (S.Set Text)) -> (Name, API)
    filterOneAPI :: Overrides -> (Name, API, Maybe (Set Text)) -> (Name, API)
    filterOneAPI Overrides
    ovs (Name
    n, APIStruct Struct
    s, Maybe (Set Text)
    maybeIgnores) =
        (Name
    n, Struct -> API
    APIStruct Struct
    s { structMethods = maybe (structMethods s)
                                          (filterMethods (structMethods s))
                                          maybeIgnores
                        , structFields = if n `S.member` sealedStructs ovs
                                        then []
                                        else structFields s
                        , structAllocationInfo =
                            let ai = Struct -> AllocationInfo
    structAllocationInfo Struct
    s
                            in case M.lookup n (allocInfo ovs) of
                                 Just AllocationInfo
    info -> AllocationInfo -> AllocationInfo -> AllocationInfo
    filterAllocInfo AllocationInfo
    ai AllocationInfo
    info
                                 Maybe AllocationInfo
    Nothing -> AllocationInfo
    ai
                        })
    filterOneAPI Overrides
    ovs (Name
    n, APIUnion Union
    u, Maybe (Set Text)
    maybeIgnores) =
        (Name
    n, Union -> API
    APIUnion Union
    u {unionMethods = maybe (unionMethods u)
                                       (filterMethods (unionMethods u))
                                       maybeIgnores
                       , unionAllocationInfo =
                            let ai = Union -> AllocationInfo
    unionAllocationInfo Union
    u
                            in case M.lookup n (allocInfo ovs) of
                                 Just AllocationInfo
    info -> AllocationInfo -> AllocationInfo -> AllocationInfo
    filterAllocInfo AllocationInfo
    ai AllocationInfo
    info
                                 Maybe AllocationInfo
    Nothing -> AllocationInfo
    ai
                       })
    -- The rest only apply if there are ignores.
    filterOneAPI Overrides
    _ (Name
    n, API
    api, Maybe (Set Text)
    Nothing) = (Name
    n, API
    api)
    filterOneAPI Overrides
    _ (Name
    n, APIObject Object
    o, Just Set Text
    ignores) =
        (Name
    n, Object -> API
    APIObject Object
    o {objMethods = filterMethods (objMethods o) ignores,
                         objSignals = filter ((`S.notMember` ignores) . sigName)
                                      (objSignals o)
                        })
    filterOneAPI Overrides
    ovs (Name
    n, APIInterface Interface
    i, Just Set Text
    ignores) =
        (Name
    n, Interface -> API
    APIInterface Interface
    i {ifMethods = filterMethods (ifMethods i) ignores,
                            ifSignals = filter ((`S.notMember` ignores) . sigName)
                                        (ifSignals i),
                            ifAllocationInfo =
                               let ai = Interface -> AllocationInfo
    ifAllocationInfo Interface
    i
                               in case M.lookup n (allocInfo ovs) of
                                    Just AllocationInfo
    info -> AllocationInfo -> AllocationInfo -> AllocationInfo
    filterAllocInfo AllocationInfo
    ai AllocationInfo
    info
                                    Maybe AllocationInfo
    Nothing -> AllocationInfo
    ai

                           })
    filterOneAPI Overrides
    _ (Name
    n, API
    api, Maybe (Set Text)
    _) = (Name
    n, API
    api)

    -- | Given a list of APIs modify them according to the given config.
    filterAPIs :: Overrides -> [(Name, API)] -> [(Name, API)]
    filterAPIs :: Overrides -> [(Name, API)] -> [(Name, API)]
    filterAPIs Overrides
    ovs [(Name, API)]
    apis = ((Name, API) -> (Name, API)) -> [(Name, API)] -> [(Name, API)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Overrides -> (Name, API, Maybe (Set Text)) -> (Name, API)
    filterOneAPI Overrides
    ovs ((Name, API, Maybe (Set Text)) -> (Name, API))
    -> ((Name, API) -> (Name, API, Maybe (Set Text)))
    -> (Name, API)
    -> (Name, API)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Name, API) -> (Name, API, Maybe (Set Text))
    forall {b}. (Name, b) -> (Name, b, Maybe (Set Text))
    fetchIgnores) [(Name, API)]
    filtered
        where filtered :: [(Name, API)]
    filtered = ((Name, API) -> Bool) -> [(Name, API)] -> [(Name, API)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Name -> Set Name -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.notMember` Overrides -> Set Name
    ignoredAPIs Overrides
    ovs) (Name -> Bool) -> ((Name, API) -> Name) -> (Name, API) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Name, API) -> Name
    forall a b. (a, b) -> a
    fst) [(Name, API)]
    apis
              fetchIgnores :: (Name, b) -> (Name, b, Maybe (Set Text))
    fetchIgnores (Name
    n, b
    api) = (Name
    n, b
    api, Name -> Map Name (Set Text) -> Maybe (Set Text)
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Name
    n (Overrides -> Map Name (Set Text)
    ignoredElems Overrides
    ovs))

    -- | Load a given API, applying filtering. Load also any necessary
    -- dependencies.
    filterAPIsAndDeps :: Overrides -> GIRInfo -> [GIRInfo]
                      -> (M.Map Name API, M.Map Name API)
    filterAPIsAndDeps :: Overrides -> GIRInfo -> [GIRInfo] -> (Map Name API, Map Name API)
    filterAPIsAndDeps Overrides
    ovs GIRInfo
    doc [GIRInfo]
    deps =
      let toMap :: GIRInfo -> Map Name API
    toMap = [(Name, API)] -> Map Name API
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(Name, API)] -> Map Name API)
    -> (GIRInfo -> [(Name, API)]) -> GIRInfo -> Map Name API
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Overrides -> [(Name, API)] -> [(Name, API)]
    filterAPIs Overrides
    ovs ([(Name, API)] -> [(Name, API)])
    -> (GIRInfo -> [(Name, API)]) -> GIRInfo -> [(Name, API)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GIRInfo -> [(Name, API)]
    girAPIs
      in (GIRInfo -> Map Name API
    toMap GIRInfo
    doc, [Map Name API] -> Map Name API
    forall (f :: * -> *) k a.
    (Foldable f, Ord k) =>
    f (Map k a) -> Map k a
    M.unions ((GIRInfo -> Map Name API) -> [GIRInfo] -> [Map Name API]
    forall a b. (a -> b) -> [a] -> [b]
    map GIRInfo -> Map Name API
    toMap [GIRInfo]
    deps))