-- | 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 :: [(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 -> CodeGen ()
deprecatedPragma Text
name' (Enumeration -> Maybe DeprecationInfo
enumDeprecated Enumeration
e)

  ExcCodeGen () -> ExcCodeGen ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$ do
    HaddockSection -> Text -> CodeGen ()
export HaddockSection
docSection (Text
name' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(..)")
    ExcCodeGen () -> ExcCodeGen ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
hsBoot (ExcCodeGen () -> ExcCodeGen ())
-> (Text -> ExcCodeGen ()) -> Text -> ExcCodeGen ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ExcCodeGen ()
Text -> CodeGen ()
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 -> CodeGen ()
writeDocumentation RelativeDocPosition
DocBeforeSymbol (Enumeration -> Documentation
enumDocumentation Enumeration
e)
    Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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. BaseCodeGen e a -> BaseCodeGen 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 -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fieldName
          RelativeDocPosition -> Documentation -> CodeGen ()
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 -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"| " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n
            RelativeDocPosition -> Documentation -> CodeGen ()
writeDocumentation RelativeDocPosition
DocAfterSymbol (EnumerationMember -> Documentation
enumMemberDoc EnumerationMember
member)
          Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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 -> CodeGen ()
writeHaddock RelativeDocPosition
DocAfterSymbol Text
"Catch-all for unknown values"
          Text -> CodeGen ()
line Text
"deriving (Show, Eq)"
        [(Text, EnumerationMember)]
_ -> () -> ExcCodeGen ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  ExcCodeGen () -> ExcCodeGen ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> CodeGen ()
bline (Text -> CodeGen ()) -> Text -> CodeGen ()
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. BaseCodeGen e a -> BaseCodeGen 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 -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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 -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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 ()
CodeGen ()
blank
    ExcCodeGen () -> ExcCodeGen ()
forall e a. BaseCodeGen e a -> BaseCodeGen 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 -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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 -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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. BaseCodeGen e a -> BaseCodeGen e a
group (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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. BaseCodeGen e a -> BaseCodeGen e a
indent (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$ Text -> CodeGen ()
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 (m :: * -> *) a. Monad m => a -> m a
return ()) (HaddockSection -> Text -> Text -> CodeGen ()
genErrorDomain HaddockSection
docSection Text
name') (Enumeration -> Maybe Text
enumErrorDomain Enumeration
e)

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

  BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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 ()
bline (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"instance O.HasParentTypes " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name'

  BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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
" :: "
    BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
indent (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text -> CodeGen ()
line Text
"IO GType"
  BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
       Text -> CodeGen ()
bline (Text -> CodeGen ()) -> Text -> CodeGen ()
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"
       BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
indent (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"glibType = c_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typeInit

  BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> CodeGen ()
bline (Text -> CodeGen ()) -> Text -> CodeGen ()
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 ()
genEnum :: Name -> Enumeration -> CodeGen ()
genEnum n :: Name
n@(Name Text
_ Text
name) Enumeration
enum = do
  Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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 ()) -> ExcCodeGen () -> CodeGen ()
forall a. (CGError -> CodeGen a) -> ExcCodeGen a -> CodeGen a
handleCGExc (\CGError
e -> do
                  Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"-- XXX Code Generation error"
                  CGError -> CodeGen ()
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 (m :: * -> *) a. Monad m => a -> m a
return ()
                    Just Text
ti -> Name -> Text -> CodeGen ()
genBoxedEnum Name
n Text
ti)

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

  BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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 ()
bline (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"instance O.HasParentTypes " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name'

  BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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
" :: "
    BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
indent (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text -> CodeGen ()
line Text
"IO GType"
  BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
       Text -> CodeGen ()
bline (Text -> CodeGen ()) -> Text -> CodeGen ()
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"
       BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
indent (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
"glibType = c_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typeInit

  BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> CodeGen ()
bline (Text -> CodeGen ()) -> Text -> CodeGen ()
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 ()
genFlags :: Name -> Flags -> CodeGen ()
genFlags n :: Name
n@(Name Text
_ Text
name) (Flags Enumeration
enum) = do
  Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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 ()) -> ExcCodeGen () -> CodeGen ()
forall a. (CGError -> CodeGen a) -> ExcCodeGen a -> CodeGen a
handleCGExc (\CGError
e -> do
                  Text -> CodeGen ()
line Text
"-- XXX Code generation error"
                  CGError -> CodeGen ()
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 (m :: * -> *) a. Monad m => a -> m a
return ()
                  Just Text
ti -> Name -> Text -> CodeGen ()
genBoxedFlags Name
n Text
ti

                let name' :: Text
name' = Name -> Text
upperName Name
n
                ExcCodeGen () -> ExcCodeGen ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (ExcCodeGen () -> ExcCodeGen ()) -> ExcCodeGen () -> ExcCodeGen ()
forall a b. (a -> b) -> a -> b
$ Text -> CodeGen ()
bline (Text -> CodeGen ()) -> Text -> CodeGen ()
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 ()
genErrorDomain :: HaddockSection -> Text -> Text -> CodeGen ()
genErrorDomain HaddockSection
docSection Text
name' Text
domain = do
  BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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"
    BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
indent (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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).
  BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen 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 ()
writeHaddock RelativeDocPosition
DocBeforeSymbol Text
catcherDoc
    Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
catcher Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ::"
    BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
indent (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
            Text -> CodeGen ()
line   Text
"IO a ->"
            Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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 ()
line   Text
"IO a"
    Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
catcher Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = catchGErrorJustDomain"

  BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
group (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen 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 ()
writeHaddock RelativeDocPosition
DocBeforeSymbol Text
handleDoc
    Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
handler Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ::"
    BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
indent (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
            Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
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 ()
line   Text
"IO a ->"
            Text -> CodeGen ()
line   Text
"IO a"
    Text -> CodeGen ()
line (Text -> CodeGen ()) -> Text -> CodeGen ()
forall a b. (a -> b) -> a -> b
$ Text
handler Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = handleGErrorJustDomain"
  HaddockSection -> Text -> CodeGen ()
export HaddockSection
docSection (Text
"catch" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name')
  HaddockSection -> Text -> CodeGen ()
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`."