    -- | Support for enums and flags.
    module Data.GI.CodeGen.EnumFlags
        ( genEnum
        , genFlags
        ) where

    import Control.Monad (when, forM_)
    #if !MIN_VERSION_base(4,11,0)
    import Data.Monoid ((<>))
    #endif
    import Data.Text (Text)
    import qualified Data.Set as S

    import Foreign.C (CUInt)
    import Foreign.Storable (sizeOf)

    import Data.GI.CodeGen.API
    import Data.GI.CodeGen.Code
    import Data.GI.CodeGen.Haddock (deprecatedPragma, writeDocumentation,
                                    writeHaddock, RelativeDocPosition(..))
    import Data.GI.CodeGen.SymbolNaming (upperName)
    import Data.GI.CodeGen.Util (tshow)

    -- | Given a list of named enum members, filter out those that have
    -- the same value as a previous entry in the list.
    dropDuplicated :: [(Text, EnumerationMember)] -> [(Text, EnumerationMember)]
    dropDuplicated :: [(Text, EnumerationMember)] -> [(Text, EnumerationMember)]
    dropDuplicated [(Text, EnumerationMember)]
    namedMembers = [(Text, EnumerationMember)]
    -> (EnumerationMember -> Int64)
    -> Set Int64
    -> [(Text, EnumerationMember)]
    forall c a b. Ord c => [(a, b)] -> (b -> c) -> Set c -> [(a, b)]
    go [(Text, EnumerationMember)]
    namedMembers EnumerationMember -> Int64
    enumMemberValue Set Int64
    forall a. Set a
    S.empty
      where go :: Ord c => [(a, b)] -> (b->c) -> S.Set c -> [(a, b)]
            go :: forall c a b. Ord c => [(a, b)] -> (b -> c) -> Set c -> [(a, b)]
    go [] b -> c
    _ Set c
    _ = []
            go ((a
    n, b
    m) : [(a, b)]
    rest) b -> c
    f Set c
    seen =
              if c -> Set c -> Bool
    forall a. Ord a => a -> Set a -> Bool
    S.member (b -> c
    f b
    m) Set c
    seen
                 -- already seen, discard
              then [(a, b)] -> (b -> c) -> Set c -> [(a, b)]
    forall c a b. Ord c => [(a, b)] -> (b -> c) -> Set c -> [(a, b)]
    go [(a, b)]
    rest b -> c
    f Set c
    seen
              else (a
    n,b
    m) (a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    : [(a, b)] -> (b -> c) -> Set c -> [(a, b)]
    forall c a b. Ord c => [(a, b)] -> (b -> c) -> Set c -> [(a, b)]
    go [(a, b)]
    rest b -> c
    f (c -> Set c -> Set c
    forall a. Ord a => a -> Set a -> Set a
    S.insert (b -> c
    f b
    m) Set c
    seen)

    genEnumOrFlags :: HaddockSection -> Name -> Enumeration -> ExcCodeGen ()
    genEnumOrFlags :: HaddockSection -> Name -> Enumeration -> ExcCodeGen ()
    genEnumOrFlags HaddockSection
    docSection n :: Name
    n@(Name Text
    ns Text
    name) Enumeration
    e = do
      -- Conversion functions expect enums and flags to map to CUInt,
      -- which we assume to be of 32 bits. Fail early, instead of giving
      -- strange errors at runtime.
      Bool -> ExcCodeGen () -> ExcCodeGen ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CUInt -> Int
    forall a. Storable a => a -> Int
    sizeOf (CUInt
    0 :: CUInt) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    4) (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $
           Text -> ExcCodeGen ()
    forall a. Text -> ExcCodeGen a
    notImplementedError (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "Unsupported CUInt size: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    tshow (CUInt -> Int
    forall a. Storable a => a -> Int
    sizeOf (CUInt
    0 :: CUInt))
      Bool -> ExcCodeGen () -> ExcCodeGen ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Enumeration -> Int
    enumStorageBytes Enumeration
    e Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    4) (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $
           Text -> ExcCodeGen ()
    forall a. Text -> ExcCodeGen a
    notImplementedError (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "Storage of size /= 4 not supported : " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int -> Text
    forall a. Show a => a -> Text
    tshow (Enumeration -> Int
    enumStorageBytes Enumeration
    e)

      let name' :: Text
    name' = Name -> Text
    upperName Name
    n
          members' :: [(Text, EnumerationMember)]
    members' = ((EnumerationMember -> (Text, EnumerationMember))
     -> [EnumerationMember] -> [(Text, EnumerationMember)])
    -> [EnumerationMember]
    -> (EnumerationMember -> (Text, EnumerationMember))
    -> [(Text, EnumerationMember)]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (EnumerationMember -> (Text, EnumerationMember))
    -> [EnumerationMember] -> [(Text, EnumerationMember)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Enumeration -> [EnumerationMember]
    enumMembers Enumeration
    e) ((EnumerationMember -> (Text, EnumerationMember))
     -> [(Text, EnumerationMember)])
    -> (EnumerationMember -> (Text, EnumerationMember))
    -> [(Text, EnumerationMember)]
    forall a b. (a -> b) -> a -> b
    $ \EnumerationMember
    member ->
            let n :: Text
    n = Name -> Text
    upperName (Name -> Text) -> Name -> Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> Name
    Name Text
    ns (Text
    name Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> EnumerationMember -> Text
    enumMemberName EnumerationMember
    member)
            in (Text
    n, EnumerationMember
    member)

      Text -> Maybe DeprecationInfo -> ExcCodeGen ()
    forall e. Text -> Maybe DeprecationInfo -> CodeGen e ()
    deprecatedPragma Text
    name' (Enumeration -> Maybe DeprecationInfo
    enumDeprecated Enumeration
    e)

      ExcCodeGen () -> ExcCodeGen ()
    forall e a. CodeGen e a -> CodeGen e a
    group (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ do
        HaddockSection -> Text -> ExcCodeGen ()
    forall e. HaddockSection -> Text -> CodeGen e ()
    export HaddockSection
    docSection (Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "(..)")
        ExcCodeGen () -> ExcCodeGen ()
    forall e a. CodeGen e a -> CodeGen e a
    hsBoot (ExcCodeGen () -> ExcCodeGen ())
    -> (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> ExcCodeGen ()
    forall e. Text -> CodeGen e ()
    line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "data " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name'
        RelativeDocPosition -> Documentation -> ExcCodeGen ()
    forall e. RelativeDocPosition -> Documentation -> CodeGen e ()
    writeDocumentation RelativeDocPosition
    DocBeforeSymbol (Enumeration -> Documentation
    enumDocumentation Enumeration
    e)
        Text -> ExcCodeGen ()
    forall e. Text -> CodeGen e ()
    line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "data " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " = "
        ExcCodeGen () -> ExcCodeGen ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $
          case [(Text, EnumerationMember)]
    members' of
            ((Text
    fieldName, EnumerationMember
    firstMember):[(Text, EnumerationMember)]
    fs) -> do
              Text -> ExcCodeGen ()
    forall e. Text -> CodeGen e ()
    line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "  " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    fieldName
              RelativeDocPosition -> Documentation -> ExcCodeGen ()
    forall e. RelativeDocPosition -> Documentation -> CodeGen e ()
    writeDocumentation RelativeDocPosition
    DocAfterSymbol (EnumerationMember -> Documentation
    enumMemberDoc EnumerationMember
    firstMember)
              [(Text, EnumerationMember)]
    -> ((Text, EnumerationMember) -> ExcCodeGen ()) -> ExcCodeGen ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(Text, EnumerationMember)]
    fs (((Text, EnumerationMember) -> ExcCodeGen ()) -> ExcCodeGen ())
    -> ((Text, EnumerationMember) -> ExcCodeGen ()) -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ \(Text
    n, EnumerationMember
    member) -> do
                Text -> ExcCodeGen ()
    forall e. Text -> CodeGen e ()
    line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "| " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    n
                RelativeDocPosition -> Documentation -> ExcCodeGen ()
    forall e. RelativeDocPosition -> Documentation -> CodeGen e ()
    writeDocumentation RelativeDocPosition
    DocAfterSymbol (EnumerationMember -> Documentation
    enumMemberDoc EnumerationMember
    member)
              Text -> ExcCodeGen ()
    forall e. Text -> CodeGen e ()
    line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "| Another" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " Int"
              RelativeDocPosition -> Text -> ExcCodeGen ()
    forall e. RelativeDocPosition -> Text -> CodeGen e ()
    writeHaddock RelativeDocPosition
    DocAfterSymbol Text
    "Catch-all for unknown values"
              Text -> ExcCodeGen ()
    forall e. Text -> CodeGen e ()
    line Text
    "deriving (Show, Eq)"
            [(Text, EnumerationMember)]
    _ -> () -> ExcCodeGen ()
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

      ExcCodeGen () -> ExcCodeGen ()
    forall e a. CodeGen e a -> CodeGen e a
    group (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ do
        Text -> ExcCodeGen ()
    forall e. Text -> CodeGen e ()
    bline (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "instance P.Enum " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " where"
        ExcCodeGen () -> ExcCodeGen ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ do
                [(Text, EnumerationMember)]
    -> ((Text, EnumerationMember) -> ExcCodeGen ()) -> ExcCodeGen ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(Text, EnumerationMember)]
    members' (((Text, EnumerationMember) -> ExcCodeGen ()) -> ExcCodeGen ())
    -> ((Text, EnumerationMember) -> ExcCodeGen ()) -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ \(Text
    n, EnumerationMember
    m) ->
                    Text -> ExcCodeGen ()
    forall e. Text -> CodeGen e ()
    line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "fromEnum " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    n Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " = " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int64 -> Text
    forall a. Show a => a -> Text
    tshow (EnumerationMember -> Int64
    enumMemberValue EnumerationMember
    m)
                Text -> ExcCodeGen ()
    forall e. Text -> CodeGen e ()
    line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "fromEnum (Another" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " k) = k"
        ExcCodeGen ()
    forall e. CodeGen e ()
    blank
        ExcCodeGen () -> ExcCodeGen ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ do
                [(Text, EnumerationMember)]
    -> ((Text, EnumerationMember) -> ExcCodeGen ()) -> ExcCodeGen ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ ([(Text, EnumerationMember)] -> [(Text, EnumerationMember)]
    dropDuplicated [(Text, EnumerationMember)]
    members') (((Text, EnumerationMember) -> ExcCodeGen ()) -> ExcCodeGen ())
    -> ((Text, EnumerationMember) -> ExcCodeGen ()) -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ \(Text
    n, EnumerationMember
    m) ->
                    Text -> ExcCodeGen ()
    forall e. Text -> CodeGen e ()
    line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "toEnum " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Int64 -> Text
    forall a. Show a => a -> Text
    tshow (EnumerationMember -> Int64
    enumMemberValue EnumerationMember
    m) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " = " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    n
                Text -> ExcCodeGen ()
    forall e. Text -> CodeGen e ()
    line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "toEnum k = Another" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " k"

      ExcCodeGen () -> ExcCodeGen ()
    forall e a. CodeGen e a -> CodeGen e a
    group (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ do
        Text -> ExcCodeGen ()
    forall e. Text -> CodeGen e ()
    line (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "instance P.Ord " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " where"
        ExcCodeGen () -> ExcCodeGen ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text -> ExcCodeGen ()
    forall e. Text -> CodeGen e ()
    line Text
    "compare a b = P.compare (P.fromEnum a) (P.fromEnum b)"

      ExcCodeGen ()
    -> (Text -> ExcCodeGen ()) -> Maybe Text -> ExcCodeGen ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> ExcCodeGen ()
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) (HaddockSection -> Text -> Text -> ExcCodeGen ()
    forall e. HaddockSection -> Text -> Text -> CodeGen e ()
    genErrorDomain HaddockSection
    docSection Text
    name') (Enumeration -> Maybe Text
    enumErrorDomain Enumeration
    e)

    genBoxedEnum :: Name -> Text -> CodeGen e ()
    genBoxedEnum :: forall e. Name -> Text -> CodeGen e ()
    genBoxedEnum Name
    n Text
    typeInit = do
      let name' :: Text
    name' = Name -> Text
    upperName Name
    n

      CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
        Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "type instance O.ParentTypes " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " = '[]"
        Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    bline (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "instance O.HasParentTypes " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name'

      CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
        Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "foreign import ccall \"" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    typeInit Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" c_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                Text
    typeInit Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " :: "
        CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line Text
    "IO GType"
      CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
           Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    bline (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "instance B.Types.TypedObject " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " where"
           CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "glibType = c_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    typeInit

      CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
        Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    bline (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "instance B.Types.BoxedEnum " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name'

    genEnum :: Name -> Enumeration -> CodeGen e ()
    genEnum :: forall e. Name -> Enumeration -> CodeGen e ()
    genEnum n :: Name
    n@(Name Text
    _ Text
    name) Enumeration
    enum = do
      Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "-- Enum " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name

      let docSection :: HaddockSection
    docSection = NamedSection -> Text -> HaddockSection
    NamedSubsection NamedSection
    EnumSection (Name -> Text
    upperName Name
    n)
      (CGError -> CodeGen e ()) -> ExcCodeGen () -> CodeGen e ()
    forall e a. (CGError -> CodeGen e a) -> ExcCodeGen a -> CodeGen e a
    handleCGExc (\CGError
    e -> do
                      Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "-- XXX Code Generation error"
                      CGError -> CodeGen e ()
    forall e. CGError -> CodeGen e ()
    printCGError CGError
    e)
                  (do HaddockSection -> Name -> Enumeration -> ExcCodeGen ()
    genEnumOrFlags HaddockSection
    docSection Name
    n Enumeration
    enum
                      case Enumeration -> Maybe Text
    enumTypeInit Enumeration
    enum of
                        Maybe Text
    Nothing -> () -> ExcCodeGen ()
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                        Just Text
    ti -> Name -> Text -> ExcCodeGen ()
    forall e. Name -> Text -> CodeGen e ()
    genBoxedEnum Name
    n Text
    ti)

    genBoxedFlags :: Name -> Text -> CodeGen e ()
    genBoxedFlags :: forall e. Name -> Text -> CodeGen e ()
    genBoxedFlags Name
    n Text
    typeInit = do
      let name' :: Text
    name' = Name -> Text
    upperName Name
    n

      CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
        Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "type instance O.ParentTypes " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " = '[]"
        Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    bline (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "instance O.HasParentTypes " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name'

      CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
        Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "foreign import ccall \"" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    typeInit Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" c_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <>
                Text
    typeInit Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " :: "
        CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line Text
    "IO GType"
      CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
           Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    bline (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "instance B.Types.TypedObject " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " where"
           CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "glibType = c_" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    typeInit

      CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
        Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    bline (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "instance B.Types.BoxedFlags " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name'

    -- | Very similar to enums, but we also declare ourselves as members of
    -- the IsGFlag typeclass.
    genFlags :: Name -> Flags -> CodeGen e ()
    genFlags :: forall e. Name -> Flags -> CodeGen e ()
    genFlags n :: Name
    n@(Name Text
    _ Text
    name) (Flags Enumeration
    enum) = do
      Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "-- Flags " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name

      let docSection :: HaddockSection
    docSection = NamedSection -> Text -> HaddockSection
    NamedSubsection NamedSection
    FlagSection (Name -> Text
    upperName Name
    n)
      (CGError -> CodeGen e ()) -> ExcCodeGen () -> CodeGen e ()
    forall e a. (CGError -> CodeGen e a) -> ExcCodeGen a -> CodeGen e a
    handleCGExc (\CGError
    e -> do
                      Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line Text
    "-- XXX Code generation error"
                      CGError -> CodeGen e ()
    forall e. CGError -> CodeGen e ()
    printCGError CGError
    e)
                  (do
                    HaddockSection -> Name -> Enumeration -> ExcCodeGen ()
    genEnumOrFlags HaddockSection
    docSection Name
    n Enumeration
    enum

                    case Enumeration -> Maybe Text
    enumTypeInit Enumeration
    enum of
                      Maybe Text
    Nothing -> () -> ExcCodeGen ()
    forall a.
    a
    -> ReaderT
         CodeGenConfig (StateT (CGState, ModuleInfo) (Except CGError)) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                      Just Text
    ti -> Name -> Text -> ExcCodeGen ()
    forall e. Name -> Text -> CodeGen e ()
    genBoxedFlags Name
    n Text
    ti

                    let name' :: Text
    name' = Name -> Text
    upperName Name
    n
                    ExcCodeGen () -> ExcCodeGen ()
    forall e a. CodeGen e a -> CodeGen e a
    group (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text -> ExcCodeGen ()
    forall e. Text -> CodeGen e ()
    bline (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "instance IsGFlag " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name')

    -- | Support for enums encapsulating error codes.
    genErrorDomain :: HaddockSection -> Text -> Text -> CodeGen e ()
    genErrorDomain :: forall e. HaddockSection -> Text -> Text -> CodeGen e ()
    genErrorDomain HaddockSection
    docSection Text
    name' Text
    domain = do
      CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
        Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "instance GErrorClass " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " where"
        CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $
                   Text
    "gerrorClassDomain _ = \"" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    domain Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\""
      -- Generate type specific error handling (saves a bit of typing, and
      -- it's clearer to read).
      CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
        let catcher :: Text
    catcher = Text
    "catch" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name'
        RelativeDocPosition -> Text -> CodeGen e ()
    forall e. RelativeDocPosition -> Text -> CodeGen e ()
    writeHaddock RelativeDocPosition
    DocBeforeSymbol Text
    catcherDoc
        Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    catcher Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " ::"
        CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
                Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line   Text
    "IO a ->"
                Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "(" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " -> GErrorMessage -> IO a) ->"
                Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line   Text
    "IO a"
        Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    catcher Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " = catchGErrorJustDomain"

      CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    group (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
        let handler :: Text
    handler = Text
    "handle" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name'
        RelativeDocPosition -> Text -> CodeGen e ()
    forall e. RelativeDocPosition -> Text -> CodeGen e ()
    writeHaddock RelativeDocPosition
    DocBeforeSymbol Text
    handleDoc
        Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    handler Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " ::"
        CodeGen e () -> CodeGen e ()
    forall e a. CodeGen e a -> CodeGen e a
    indent (CodeGen e () -> CodeGen e ()) -> CodeGen e () -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ do
                Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    "(" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " -> GErrorMessage -> IO a) ->"
                Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line   Text
    "IO a ->"
                Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line   Text
    "IO a"
        Text -> CodeGen e ()
    forall e. Text -> CodeGen e ()
    line (Text -> CodeGen e ()) -> Text -> CodeGen e ()
    forall a b. (a -> b) -> a -> b
    $ Text
    handler Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " = handleGErrorJustDomain"
      HaddockSection -> Text -> CodeGen e ()
    forall e. HaddockSection -> Text -> CodeGen e ()
    export HaddockSection
    docSection (Text
    "catch" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name')
      HaddockSection -> Text -> CodeGen e ()
    forall e. HaddockSection -> Text -> CodeGen e ()
    export HaddockSection
    docSection (Text
    "handle" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name')

      where
        catcherDoc :: Text
        catcherDoc :: Text
    catcherDoc = Text
    "Catch exceptions of type `" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "`. This is a specialized version of `Data.GI.Base.GError.catchGErrorJustDomain`."

        handleDoc :: Text
        handleDoc :: Text
    handleDoc = Text
    "Handle exceptions of type `" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    name' Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "`. This is a specialized version of `Data.GI.Base.GError.handleGErrorJustDomain`."