    {-# LANGUAGE CPP #-}
    -- HookGenerator.hs -*-haskell-*-
    -- Takes a type list of possible hooks from the GTK+ distribution and produces
    -- Haskell functions to connect to these callbacks.
    module HookGenerator(hookGen) where

    import Data.Char   (showLitChar)
    import Data.List   (nub, isPrefixOf)
    import System.Exit (exitWith, ExitCode(..))
    import System.IO (stderr, hPutStr)
    import Paths_gtk2hs_buildtools (getDataFileName)

    -- Define all possible data types the GTK will supply in callbacks.
    --
    data Types = Tunit              -- ()
               | Tbool              -- Bool
               | Tchar
               | Tuchar
               | Tint               -- Int
               | Tuint
               | Tlong
               | Tulong
               | Tenum
               | Tflags
               | Tfloat
               | Tdouble
               | Tstring
               | Tmstring
               | Tgstring
               | Tmgstring
               | Tboxed             -- a struct which is passed by value
               | Tptr               -- pointer
               | Ttobject           -- foreign with WidgetClass context
               | Tmtobject          -- foreign with WidgetClass context using a Maybe type
               | Tobject            -- foreign with GObjectClass context
               | Tmobject           -- foreign with GObjectClass context using a Maybe type
               deriving Types -> Types -> Bool
    (Types -> Types -> Bool) -> (Types -> Types -> Bool) -> Eq Types
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Types -> Types -> Bool
    $c/= :: Types -> Types -> Bool
    == :: Types -> Types -> Bool
    $c== :: Types -> Types -> Bool
    Eq

    type Signature = (Types,[Types])
    type Signatures = [Signature]

    -------------------------------------------------------------------------------
    -- Parsing
    -------------------------------------------------------------------------------

    parseSignatures :: String -> Signatures
    parseSignatures :: String -> Signatures
    parseSignatures content :: String
    content = (Signatures -> Signatures
    forall a. Eq a => [a] -> [a]
    nub(Signatures -> Signatures)
    -> (String -> Signatures) -> String -> Signatures
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> [Token] -> Signatures
    parseSig 1([Token] -> Signatures)
    -> (String -> [Token]) -> String -> Signatures
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> [Token]
    scan) String
    content

    data Token = TokColon
               | TokType Types
               | TokComma
               | TokEOL

    instance Show Token where
      showsPrec :: Int -> Token -> ShowS
    showsPrec _ TokColon = String -> ShowS
    forall a. Show a => a -> ShowS
    shows ":"
      showsPrec _ (TokType _) = String -> ShowS
    forall a. Show a => a -> ShowS
    shows "<type>"
      showsPrec _ TokComma = String -> ShowS
    forall a. Show a => a -> ShowS
    shows ","
      showsPrec _ TokEOL = String -> ShowS
    forall a. Show a => a -> ShowS
    shows "<EOL>"

    parseSig :: Int -> [Token] -> Signatures
    parseSig :: Int -> [Token] -> Signatures
    parseSig l :: Int
    l [] = []
    parseSig l :: Int
    l (TokEOL: rem :: [Token]
    rem) = Int -> [Token] -> Signatures
    parseSig (Int
    lInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1) [Token]
    rem
    parseSig l :: Int
    l (TokType ret :: Types
    ret: TokColon: TokType Tunit:rem :: [Token]
    rem) =
      (Types
    ret,[])(Types, [Types]) -> Signatures -> Signatures
    forall a. a -> [a] -> [a]
    :Int -> [Token] -> Signatures
    parseSig Int
    l [Token]
    rem
    parseSig l :: Int
    l (TokType ret :: Types
    ret: TokColon: rem :: [Token]
    rem) =
      let (args :: [Types]
    args,rem' :: [Token]
    rem') = Int -> [Token] -> ([Types], [Token])
    parseArg Int
    l [Token]
    rem in
      (Types
    ret,[Types]
    args)(Types, [Types]) -> Signatures -> Signatures
    forall a. a -> [a] -> [a]
    : Int -> [Token] -> Signatures
    parseSig (Int
    lInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1) [Token]
    rem'
    parseSig l :: Int
    l rem :: [Token]
    rem = String -> Signatures
    forall a. HasCallStack => String -> a
    error ("parse error on line "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Int -> String
    forall a. Show a => a -> String
    show Int
    lString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                           ": expected type and colon, found\n"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                           (Token -> String) -> [Token] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Token -> String
    forall a. Show a => a -> String
    show (Int -> [Token] -> [Token]
    forall a. Int -> [a] -> [a]
    take 5 [Token]
    rem))

    parseArg :: Int -> [Token] -> ([Types],[Token])
    parseArg :: Int -> [Token] -> ([Types], [Token])
    parseArg l :: Int
    l [TokType ty :: Types
    ty] = ([Types
    ty],[])
    parseArg l :: Int
    l (TokType ty :: Types
    ty: TokEOL:rem :: [Token]
    rem) = ([Types
    ty],[Token]
    rem)
    parseArg l :: Int
    l (TokType ty :: Types
    ty: TokComma:rem :: [Token]
    rem) =
      let (args :: [Types]
    args,rem' :: [Token]
    rem') = Int -> [Token] -> ([Types], [Token])
    parseArg Int
    l [Token]
    rem in
      (Types
    tyTypes -> [Types] -> [Types]
    forall a. a -> [a] -> [a]
    :[Types]
    args, [Token]
    rem')
    parseArg l :: Int
    l rem :: [Token]
    rem = String -> ([Types], [Token])
    forall a. HasCallStack => String -> a
    error ("parse error on line "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Int -> String
    forall a. Show a => a -> String
    show Int
    lString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++": expected type"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                            " followed by comma or EOL, found\n "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                           (Token -> String) -> [Token] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Token -> String
    forall a. Show a => a -> String
    show (Int -> [Token] -> [Token]
    forall a. Int -> [a] -> [a]
    take 5 [Token]
    rem))

    scan :: String -> [Token]
    scan :: String -> [Token]
    scan "" = []
    scan ('#':xs :: String
    xs) = (String -> [Token]
    scan(String -> [Token]) -> ShowS -> String -> [Token]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /='\n'))  String
    xs
    scan ('\n':xs :: String
    xs) = Token
    TokEOLToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan (' ':xs :: String
    xs) = String -> [Token]
    scan String
    xs
    scan ('\t':xs :: String
    xs) = String -> [Token]
    scan String
    xs
    scan (':':xs :: String
    xs) = Token
    TokColonToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan (',':xs :: String
    xs) = Token
    TokCommaToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('V':'O':'I':'D':xs :: String
    xs) = Types -> Token
    TokType Types
    TunitToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('B':'O':'O':'L':'E':'A':'N':xs :: String
    xs) = Types -> Token
    TokType Types
    TboolToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('C':'H':'A':'R':xs :: String
    xs) = Types -> Token
    TokType Types
    TcharToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('U':'C':'H':'A':'R':xs :: String
    xs) = Types -> Token
    TokType Types
    TucharToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('I':'N':'T':xs :: String
    xs) = Types -> Token
    TokType Types
    TintToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('U':'I':'N':'T':xs :: String
    xs) = Types -> Token
    TokType Types
    TuintToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('L':'O':'N':'G':xs :: String
    xs) = Types -> Token
    TokType Types
    TuintToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('U':'L':'O':'N':'G':xs :: String
    xs) = Types -> Token
    TokType Types
    TulongToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('E':'N':'U':'M':xs :: String
    xs) = Types -> Token
    TokType Types
    TenumToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('F':'L':'A':'G':'S':xs :: String
    xs) = Types -> Token
    TokType Types
    TflagsToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('F':'L':'O':'A':'T':xs :: String
    xs) = Types -> Token
    TokType Types
    TfloatToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('D':'O':'U':'B':'L':'E':xs :: String
    xs) = Types -> Token
    TokType Types
    TdoubleToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('S':'T':'R':'I':'N':'G':xs :: String
    xs) = Types -> Token
    TokType Types
    TstringToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('M':'S':'T':'R':'I':'N':'G':xs :: String
    xs) = Types -> Token
    TokType Types
    TmstringToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('G':'L':'I':'B':'S':'T':'R':'I':'N':'G':xs :: String
    xs) = Types -> Token
    TokType Types
    TgstringToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('M':'G':'L':'I':'B':'S':'T':'R':'I':'N':'G':xs :: String
    xs) = Types -> Token
    TokType Types
    TmgstringToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('B':'O':'X':'E':'D':xs :: String
    xs) = Types -> Token
    TokType Types
    TboxedToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('P':'O':'I':'N':'T':'E':'R':xs :: String
    xs) = Types -> Token
    TokType Types
    TptrToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('T':'O':'B':'J':'E':'C':'T':xs :: String
    xs) = Types -> Token
    TokType Types
    TtobjectToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('M':'T':'O':'B':'J':'E':'C':'T':xs :: String
    xs) = Types -> Token
    TokType Types
    TmtobjectToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('O':'B':'J':'E':'C':'T':xs :: String
    xs) = Types -> Token
    TokType Types
    TobjectToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('M':'O':'B':'J':'E':'C':'T':xs :: String
    xs) = Types -> Token
    TokType Types
    TmobjectToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('N':'O':'N':'E':xs :: String
    xs) = Types -> Token
    TokType Types
    TunitToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan ('B':'O':'O':'L':xs :: String
    xs) = Types -> Token
    TokType Types
    TboolToken -> [Token] -> [Token]
    forall a. a -> [a] -> [a]
    :String -> [Token]
    scan String
    xs
    scan str :: String
    str = String -> [Token]
    forall a. HasCallStack => String -> a
    error ("Invalid character in input file:\n"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
               (Char -> String) -> ShowS
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (((Char -> ShowS) -> String -> Char -> String
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Char -> ShowS
    showLitChar) "") (Int -> ShowS
    forall a. Int -> [a] -> [a]
    take 5 String
    str))

    -------------------------------------------------------------------------------
    -- Helper functions
    -------------------------------------------------------------------------------

    ss :: String -> ShowS
    ss = String -> ShowS
    showString
    sc :: Char -> ShowS
    sc = Char -> ShowS
    showChar

    indent :: Int -> ShowS
    indent :: Int -> ShowS
    indent c :: Int
    c = String -> ShowS
    ss ("\n"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    c) ' ')

    -------------------------------------------------------------------------------
    -- Tables of code fragments
    -------------------------------------------------------------------------------

    identifier :: Types -> ShowS
    identifier :: Types -> ShowS
    identifier Tunit    = String -> ShowS
    ss "NONE"
    identifier Tbool    = String -> ShowS
    ss "BOOL"
    identifier Tchar    = String -> ShowS
    ss "CHAR"
    identifier Tuchar   = String -> ShowS
    ss "UCHAR"
    identifier Tint     = String -> ShowS
    ss "INT"
    identifier Tuint    = String -> ShowS
    ss "WORD"
    identifier Tlong    = String -> ShowS
    ss "LONG"
    identifier Tulong   = String -> ShowS
    ss "ULONG"
    identifier Tenum    = String -> ShowS
    ss "ENUM"
    identifier Tflags   = String -> ShowS
    ss "FLAGS"
    identifier Tfloat   = String -> ShowS
    ss "FLOAT"
    identifier Tdouble  = String -> ShowS
    ss "DOUBLE"
    identifier Tstring  = String -> ShowS
    ss "STRING"
    identifier Tmstring = String -> ShowS
    ss "MSTRING"
    identifier Tgstring = String -> ShowS
    ss "GLIBSTRING"
    identifier Tmgstring = String -> ShowS
    ss "MGLIBSTRING"
    identifier Tboxed   = String -> ShowS
    ss "BOXED"
    identifier Tptr     = String -> ShowS
    ss "PTR"
    identifier Ttobject  = String -> ShowS
    ss "OBJECT"
    identifier Tmtobject = String -> ShowS
    ss "MOBJECT"
    identifier Tobject  = String -> ShowS
    ss "OBJECT"
    identifier Tmobject = String -> ShowS
    ss "MOBJECT"

    #ifdef USE_GCLOSURE_SIGNALS_IMPL

    -- The monomorphic type which is used to export the function signature.
    rawtype :: Types -> ShowS
    rawtype :: Types -> ShowS
    rawtype Tunit    = String -> ShowS
    ss "()"
    rawtype Tbool    = String -> ShowS
    ss "Bool"
    rawtype Tchar    = String -> ShowS
    ss "Char"
    rawtype Tuchar   = String -> ShowS
    ss "Char"
    rawtype Tint     = String -> ShowS
    ss "Int"
    rawtype Tuint    = String -> ShowS
    ss "Word"
    rawtype Tlong    = String -> ShowS
    ss "Int"
    rawtype Tulong   = String -> ShowS
    ss "Word"
    rawtype Tenum    = String -> ShowS
    ss "Int"
    rawtype Tflags   = String -> ShowS
    ss "Word"
    rawtype Tfloat   = String -> ShowS
    ss "Float"
    rawtype Tdouble  = String -> ShowS
    ss "Double"
    rawtype Tstring  = String -> ShowS
    ss "CString"
    rawtype Tmstring  = String -> ShowS
    ss "CString"
    rawtype Tgstring  = String -> ShowS
    ss "CString"
    rawtype Tmgstring  = String -> ShowS
    ss "CString"
    rawtype Tboxed   = String -> ShowS
    ss "Ptr ()"
    rawtype Tptr     = String -> ShowS
    ss "Ptr ()"
    rawtype Ttobject  = String -> ShowS
    ss "Ptr GObject"
    rawtype Tmtobject  = String -> ShowS
    ss "Ptr GObject"
    rawtype Tobject  = String -> ShowS
    ss "Ptr GObject"
    rawtype Tmobject  = String -> ShowS
    ss "Ptr GObject"

    #else

    -- The monomorphic type which is used to export the function signature.
    rawtype :: Types -> ShowS
    rawtype Tunit    = ss "()"
    rawtype Tbool    = ss "{#type gboolean#}"
    rawtype Tchar    = ss "{#type gchar#}"
    rawtype Tuchar   = ss "{#type guchar#}"
    rawtype Tint       = ss "{#type gint#}"
    rawtype Tuint    = ss "{#type guint#}"
    rawtype Tlong    = ss "{#type glong#}"
    rawtype Tulong   = ss "{#type gulong#}"
    rawtype Tenum    = ss "{#type gint#}"
    rawtype Tflags   = ss "{#type guint#}"
    rawtype Tfloat   = ss "{#type gfloat#}"
    rawtype Tdouble  = ss "{#type gdouble#}"
    rawtype Tstring  = ss "CString"
    rawtype Tmstring  = ss "CString"
    rawtype Tgstring  = ss "CString"
    rawtype Tmgstring  = ss "CString"
    rawtype Tboxed   = ss "Ptr ()"
    rawtype Tptr       = ss "Ptr ()"
    rawtype Ttobject  = ss "Ptr GObject"
    rawtype Tmtobject = ss "Ptr GObject"
    rawtype Tobject  = ss "Ptr GObject"
    rawtype Tmobject = ss "Ptr GObject"

    #endif

    -- The possibly polymorphic type which
    usertype :: Types -> [Char] -> (ShowS,[Char])
    usertype :: Types -> String -> (ShowS, String)
    usertype Tunit    cs :: String
    cs = (String -> ShowS
    ss "()",String
    cs)
    usertype Tbool    (c :: Char
    c:cs :: String
    cs) = (String -> ShowS
    ss "Bool",String
    cs)
    usertype Tchar    (c :: Char
    c:cs :: String
    cs) = (String -> ShowS
    ss "Char",String
    cs)
    usertype Tuchar   (c :: Char
    c:cs :: String
    cs) = (String -> ShowS
    ss "Char",String
    cs)
    usertype Tint     (c :: Char
    c:cs :: String
    cs) = (String -> ShowS
    ss "Int",String
    cs)
    usertype Tuint    (c :: Char
    c:cs :: String
    cs) = (String -> ShowS
    ss "Word",String
    cs)
    usertype Tlong    (c :: Char
    c:cs :: String
    cs) = (String -> ShowS
    ss "Int",String
    cs)
    usertype Tulong   (c :: Char
    c:cs :: String
    cs) = (String -> ShowS
    ss "Int",String
    cs)
    usertype Tenum    (c :: Char
    c:cs :: String
    cs) = (Char -> ShowS
    sc Char
    c,String
    cs)
    usertype Tflags   cs :: String
    cs = Types -> String -> (ShowS, String)
    usertype Types
    Tenum String
    cs
    usertype Tfloat   (c :: Char
    c:cs :: String
    cs) = (String -> ShowS
    ss "Float",String
    cs)
    usertype Tdouble  (c :: Char
    c:cs :: String
    cs) = (String -> ShowS
    ss "Double",String
    cs)
    usertype Tstring  (c :: Char
    c:cs :: String
    cs) = (String -> ShowS
    ss "String",String
    cs)
    usertype Tmstring  (c :: Char
    c:cs :: String
    cs) = (String -> ShowS
    ss "Maybe String",String
    cs)
    usertype Tgstring  (c :: Char
    c:cs :: String
    cs) = (Char -> ShowS
    sc Char
    cShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc '\'',String
    cs)
    usertype Tmgstring  (c :: Char
    c:cs :: String
    cs) = (String -> ShowS
    ss "Maybe "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc Char
    cShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc '\'',String
    cs)
    usertype Tboxed   (c :: Char
    c:cs :: String
    cs) = (Char -> ShowS
    sc Char
    c,String
    cs)
    usertype Tptr     (c :: Char
    c:cs :: String
    cs) = (String -> ShowS
    ss "Ptr "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc Char
    c,String
    cs)
    usertype Ttobject  (c :: Char
    c:cs :: String
    cs) = (Char -> ShowS
    sc Char
    cShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc '\'',String
    cs)
    usertype Tmtobject  (c :: Char
    c:cs :: String
    cs) = (String -> ShowS
    ss "Maybe "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc Char
    cShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc '\'',String
    cs)
    usertype Tobject  (c :: Char
    c:cs :: String
    cs) = (Char -> ShowS
    sc Char
    cShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc '\'',String
    cs)
    usertype Tmobject  (c :: Char
    c:cs :: String
    cs) = (String -> ShowS
    ss "Maybe "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc Char
    cShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc '\'',String
    cs)

    -- type declaration: only consume variables when they are needed
    --
    --  * Tint is used as return value as well. Therefore Integral has to be added
    --   to the context. Grrr.
    --
    context :: [Types] -> [Char] -> [ShowS]
    context :: [Types] -> String -> [ShowS]
    context (Tenum:ts :: [Types]
    ts)    (c :: Char
    c:cs :: String
    cs) = String -> ShowS
    ss "Enum "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc Char
    cShowS -> [ShowS] -> [ShowS]
    forall a. a -> [a] -> [a]
    : [Types] -> String -> [ShowS]
    context [Types]
    ts String
    cs
    context (Tflags:ts :: [Types]
    ts)   (c :: Char
    c:cs :: String
    cs) = String -> ShowS
    ss "Flags "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc Char
    cShowS -> [ShowS] -> [ShowS]
    forall a. a -> [a] -> [a]
    : [Types] -> String -> [ShowS]
    context [Types]
    ts String
    cs
    context (Ttobject:ts :: [Types]
    ts)  (c :: Char
    c:cs :: String
    cs) = String -> ShowS
    ss "GObjectClass "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc Char
    cShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc '\''ShowS -> [ShowS] -> [ShowS]
    forall a. a -> [a] -> [a]
    : [Types] -> String -> [ShowS]
    context [Types]
    ts String
    cs
    context (Tmtobject:ts :: [Types]
    ts)  (c :: Char
    c:cs :: String
    cs) = String -> ShowS
    ss "GObjectClass "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc Char
    cShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc '\''ShowS -> [ShowS] -> [ShowS]
    forall a. a -> [a] -> [a]
    : [Types] -> String -> [ShowS]
    context [Types]
    ts String
    cs
    context (Tobject:ts :: [Types]
    ts)  (c :: Char
    c:cs :: String
    cs) = String -> ShowS
    ss "GObjectClass "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc Char
    cShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc '\''ShowS -> [ShowS] -> [ShowS]
    forall a. a -> [a] -> [a]
    : [Types] -> String -> [ShowS]
    context [Types]
    ts String
    cs
    context (Tmobject:ts :: [Types]
    ts)  (c :: Char
    c:cs :: String
    cs) = String -> ShowS
    ss "GObjectClass "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc Char
    cShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc '\''ShowS -> [ShowS] -> [ShowS]
    forall a. a -> [a] -> [a]
    : [Types] -> String -> [ShowS]
    context [Types]
    ts String
    cs
    context (Tgstring:ts :: [Types]
    ts)  (c :: Char
    c:cs :: String
    cs) = String -> ShowS
    ss "Glib.GlibString "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc Char
    cShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc '\''ShowS -> [ShowS] -> [ShowS]
    forall a. a -> [a] -> [a]
    : [Types] -> String -> [ShowS]
    context [Types]
    ts String
    cs
    context (Tmgstring:ts :: [Types]
    ts)  (c :: Char
    c:cs :: String
    cs) = String -> ShowS
    ss "Glib.GlibString "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc Char
    cShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc '\''ShowS -> [ShowS] -> [ShowS]
    forall a. a -> [a] -> [a]
    : [Types] -> String -> [ShowS]
    context [Types]
    ts String
    cs
    context (_:ts :: [Types]
    ts)        (c :: Char
    c:cs :: String
    cs) = [Types] -> String -> [ShowS]
    context [Types]
    ts String
    cs
    context []            _      = []

    marshType :: [Types] -> [Char] -> [ShowS]
    marshType :: [Types] -> String -> [ShowS]
    marshType (Tint:ts :: [Types]
    ts)     (c :: Char
    c:cs :: String
    cs) = [Types] -> String -> [ShowS]
    marshType [Types]
    ts String
    cs
    marshType (Tuint:ts :: [Types]
    ts)    (c :: Char
    c:cs :: String
    cs) = [Types] -> String -> [ShowS]
    marshType [Types]
    ts String
    cs
    marshType (Tenum:ts :: [Types]
    ts)    (c :: Char
    c:cs :: String
    cs) = [Types] -> String -> [ShowS]
    marshType [Types]
    ts String
    cs
    marshType (Tflags:ts :: [Types]
    ts)   cs :: String
    cs     = [Types] -> String -> [ShowS]
    marshType (Types
    TenumTypes -> [Types] -> [Types]
    forall a. a -> [a] -> [a]
    :[Types]
    ts) String
    cs
    marshType (Tboxed:ts :: [Types]
    ts)   (c :: Char
    c:cs :: String
    cs) = String -> ShowS
    ss "(Ptr "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc Char
    cShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss "' -> IO "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                     Char -> ShowS
    sc Char
    cShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss ") -> "ShowS -> [ShowS] -> [ShowS]
    forall a. a -> [a] -> [a]
    :
                                     [Types] -> String -> [ShowS]
    marshType [Types]
    ts String
    cs
    marshType (Tptr:ts :: [Types]
    ts)     (c :: Char
    c:cs :: String
    cs) = [Types] -> String -> [ShowS]
    marshType [Types]
    ts String
    cs
    marshType (Tobject:ts :: [Types]
    ts)  (c :: Char
    c:cs :: String
    cs) = [Types] -> String -> [ShowS]
    marshType [Types]
    ts String
    cs
    marshType (_:ts :: [Types]
    ts)        (c :: Char
    c:cs :: String
    cs) = [Types] -> String -> [ShowS]
    marshType [Types]
    ts String
    cs
    marshType []            _      = []

    -- arguments for user defined marshalling

    type ArgNo = Int

    marshArg :: Types -> ArgNo -> ShowS
    marshArg :: Types -> Int -> ShowS
    marshArg Tboxed   c :: Int
    c = String -> ShowS
    ss "boxedPre"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    cShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc ' '
    marshArg _        _ = ShowS
    forall a. a -> a
    id

    -- generate a name for every passed argument,
    nameArg :: Types -> ArgNo -> ShowS
    nameArg :: Types -> Int -> ShowS
    nameArg Tunit    _ = ShowS
    forall a. a -> a
    id
    nameArg Tbool    c :: Int
    c = String -> ShowS
    ss "bool"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Tchar    c :: Int
    c = String -> ShowS
    ss "char"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Tuchar   c :: Int
    c = String -> ShowS
    ss "char"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Tint     c :: Int
    c = String -> ShowS
    ss "int"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Tuint    c :: Int
    c = String -> ShowS
    ss "int"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Tlong    c :: Int
    c = String -> ShowS
    ss "long"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Tulong   c :: Int
    c = String -> ShowS
    ss "long"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Tenum    c :: Int
    c = String -> ShowS
    ss "enum"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Tflags   c :: Int
    c = String -> ShowS
    ss "flags"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Tfloat   c :: Int
    c = String -> ShowS
    ss "float"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Tdouble  c :: Int
    c = String -> ShowS
    ss "double"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Tstring  c :: Int
    c = String -> ShowS
    ss "str"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Tmstring c :: Int
    c = String -> ShowS
    ss "str"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Tgstring         c :: Int
    c = String -> ShowS
    ss "str"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Tmgstring c :: Int
    c = String -> ShowS
    ss "str"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Tboxed   c :: Int
    c = String -> ShowS
    ss "box"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Tptr     c :: Int
    c = String -> ShowS
    ss "ptr"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Ttobject  c :: Int
    c = String -> ShowS
    ss "obj"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Tmtobject  c :: Int
    c = String -> ShowS
    ss "obj"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Tobject  c :: Int
    c = String -> ShowS
    ss "obj"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c
    nameArg Tmobject  c :: Int
    c = String -> ShowS
    ss "obj"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    forall a. Show a => a -> ShowS
    shows Int
    c

    -- describe marshalling between the data passed from the registered function
    -- to the user supplied Haskell function

    #ifdef USE_GCLOSURE_SIGNALS_IMPL

    marshExec :: Types -> ShowS -> Int -> (ShowS -> ShowS)
    marshExec :: Types -> ShowS -> Int -> ShowS -> ShowS
    marshExec Tbool   arg :: ShowS
    arg _ body :: ShowS
    body = ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc ' 'ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    arg
    marshExec Tchar   arg :: ShowS
    arg _ body :: ShowS
    body = ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc ' 'ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    arg
    marshExec Tuchar  arg :: ShowS
    arg _ body :: ShowS
    body = ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc ' 'ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    arg
    marshExec Tint    arg :: ShowS
    arg _ body :: ShowS
    body = ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc ' 'ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    arg
    marshExec Tuint   arg :: ShowS
    arg _ body :: ShowS
    body = ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc ' 'ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    arg
    marshExec Tlong   arg :: ShowS
    arg _ body :: ShowS
    body = ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc ' 'ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    arg
    marshExec Tulong  arg :: ShowS
    arg _ body :: ShowS
    body = ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc ' 'ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    arg
    marshExec Tenum   arg :: ShowS
    arg _ body :: ShowS
    body = ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss " (toEnum "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc ')'
    marshExec Tflags  arg :: ShowS
    arg _ body :: ShowS
    body = ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss " (toFlags "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc ')'
    marshExec Tfloat  arg :: ShowS
    arg _ body :: ShowS
    body = ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc ' 'ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    arg
    marshExec Tdouble arg :: ShowS
    arg _ body :: ShowS
    body = ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc ' 'ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    arg
    marshExec Tstring arg :: ShowS
    arg _ body :: ShowS
    body = Int -> ShowS
    indent 5ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "peekUTFString "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss " >>= \\"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "\' ->"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                   ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc ' 'ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc '\''
    marshExec Tmstring arg :: ShowS
    arg _ body :: ShowS
    body = Int -> ShowS
    indent 5ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "maybePeekUTFString "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss " >>= \\"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "\' ->"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                   ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc ' 'ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc '\''
    marshExec Tgstring arg :: ShowS
    arg _ body :: ShowS
    body = Int -> ShowS
    indent 5ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "peekUTFString "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss " >>= \\"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "\' ->"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                   ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc ' 'ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc '\''
    marshExec Tmgstring arg :: ShowS
    arg _ body :: ShowS
    body = Int -> ShowS
    indent 5ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "maybePeekUTFString "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss " >>= \\"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "\' ->"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                   ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc ' 'ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc '\''
    marshExec Tboxed  arg :: ShowS
    arg n :: Int
    n body :: ShowS
    body = Int -> ShowS
    indent 5ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "boxedPre"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss (Int -> String
    forall a. Show a => a -> String
    show Int
    n)ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss " (castPtr "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss ") >>= \\"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "\' ->"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                   ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc ' 'ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc '\''
    marshExec Tptr    arg :: ShowS
    arg _ body :: ShowS
    body = ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss " (castPtr "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc ')'
    marshExec Ttobject arg :: ShowS
    arg _ body :: ShowS
    body = Int -> ShowS
    indent 5ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss "makeNewGObject (GObject, objectUnrefFromMainloop) (return "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss ") >>= \\"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "\' ->"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                   ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss " (unsafeCastGObject "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "\')"
    marshExec Tmtobject arg :: ShowS
    arg _ body :: ShowS
    body = Int -> ShowS
    indent 5ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss "maybeNull (makeNewGObject (GObject, objectUnrefFromMainloop)) (return "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss ") >>= \\"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "\' ->"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                   ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss " (liftM unsafeCastGObject "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "\')"
    marshExec Tobject arg :: ShowS
    arg _ body :: ShowS
    body = Int -> ShowS
    indent 5ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss "makeNewGObject (GObject, objectUnref) (return "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss ") >>= \\"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "\' ->"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                   ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss " (unsafeCastGObject "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "\')"
    marshExec Tmobject arg :: ShowS
    arg _ body :: ShowS
    body = Int -> ShowS
    indent 5ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss "maybeNull (makeNewGObject (GObject, objectUnref)) (return "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss ") >>= \\"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "\' ->"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                   ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss " (liftM unsafeCastGObject "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    argShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "\')"

    marshRet :: Types -> (ShowS -> ShowS)
    marshRet :: Types -> ShowS -> ShowS
    marshRet Tunit   body :: ShowS
    body = ShowS
    body
    marshRet Tbool   body :: ShowS
    body = ShowS
    body
    marshRet Tint    body :: ShowS
    body = ShowS
    body
    marshRet Tuint   body :: ShowS
    body = ShowS
    body
    marshRet Tlong   body :: ShowS
    body = ShowS
    body
    marshRet Tulong  body :: ShowS
    body = ShowS
    body
    marshRet Tenum   body :: ShowS
    body = Int -> ShowS
    indent 5ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "liftM fromEnum $ "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    body
    marshRet Tflags  body :: ShowS
    body = Int -> ShowS
    indent 5ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "liftM fromFlags $ "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    body
    marshRet Tfloat  body :: ShowS
    body = ShowS
    body
    marshRet Tdouble body :: ShowS
    body = ShowS
    body
    marshRet Tstring body :: ShowS
    body = ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ShowS
    indent 5ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss ">>= newUTFString"
    marshRet Tgstring body :: ShowS
    body = ShowS
    bodyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ShowS
    indent 5ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss ">>= newUTFString"
    marshRet Tptr    body :: ShowS
    body = Int -> ShowS
    indent 5ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "liftM castPtr $ "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    body
    marshRet _       _    = String -> ShowS
    forall a. HasCallStack => String -> a
    error "Signal handlers cannot return structured types."

    #else

    marshExec :: Types -> ArgNo -> ShowS
    marshExec Tbool   n = indent 4.ss "let bool".shows n.
                          ss "' = toBool bool".shows n
    marshExec Tchar   n = indent 4.ss "let char".shows n.
                          ss "' = (toEnum.fromEnum) char".shows n
    marshExec Tuchar  n = indent 4.ss "let char".shows n.
                          ss "' = (toEnum.fromEnum) char".shows n
    marshExec Tint    n = indent 4.ss "let int".shows n.
                          ss "' = fromIntegral int".shows n
    marshExec Tuint   n = indent 4.ss "let int".shows n.
                          ss "' = fromIntegral int".shows n
    marshExec Tlong   n = indent 4.ss "let long".shows n.
                          ss "' = toInteger long".shows n
    marshExec Tulong  n = indent 4.ss "let long".shows n.
                          ss "' = toInteger long".shows n
    marshExec Tenum   n = indent 4.ss "let enum".shows n.
                          ss "' = (toEnum.fromEnum) enum".shows n
    marshExec Tflags  n = indent 4.ss "let flags".shows n.
                          ss "' = (toEnum.fromEnum) flags".shows n
    marshExec Tfloat  n = indent 4.ss "let float".shows n.
                          ss "' = (fromRational.toRational) float".shows n
    marshExec Tdouble n = indent 4.ss "let double".shows n.
                          ss "' = (fromRational.toRational) double".shows n
    marshExec Tstring n = indent 4.ss "str".shows n.
                          ss "' <- peekCString str".shows n
    marshExec Tmstring n = indent 4.ss "str".shows n.
                          ss "' <- maybePeekCString str".shows n
    marshExec Tgstring n = indent 4.ss "str".shows n.
                          ss "' <- peekCString str".shows n
    marshExec Tmgstring n = indent 4.ss "str".shows n.
                          ss "' <- maybePeekCString str".shows n
    marshExec Tboxed  n = indent 4.ss "box".shows n.ss "' <- boxedPre".
                          shows n.ss " $ castPtr box".shows n
    marshExec Tptr    n = indent 4.ss "let ptr".shows n.ss "' = castPtr ptr".
                          shows n
    marshExec Ttobject n = indent 4.ss "objectRef obj".shows n.
                          indent 4.ss "obj".shows n.
                          ss "' <- liftM (unsafeCastGObject. fst mkGObject) $".
                          indent 5.ss "newForeignPtr obj".shows n.ss " (snd mkGObject)"
    marshExec Tobject n = indent 4.ss "objectRef obj".shows n.
                          indent 4.ss "obj".shows n.
                          ss "' <- liftM (unsafeCastGObject. fst mkGObject) $".
                          indent 5.ss "newForeignPtr obj".shows n.ss " (snd mkGObject)"
    marshExec _       _ = id

    marshRet :: Types -> ShowS
    marshRet Tunit    = ss "id"
    marshRet Tbool    = ss "fromBool"
    marshRet Tint     = ss "fromIntegral"
    marshRet Tuint    = ss "fromIntegral"
    marshRet Tlong    = ss "fromIntegral"
    marshRet Tulong   = ss "fromIntegral"
    marshRet Tenum    = ss "(toEnum.fromEnum)"
    marshRet Tflags   = ss "fromFlags"
    marshRet Tfloat   = ss "(toRational.fromRational)"
    marshRet Tdouble  = ss "(toRational.fromRational)"
    marshRet Tptr     = ss "castPtr"
    marshRet _  = ss "(error \"Signal handlers cannot return structured types.\")"

    #endif

    -------------------------------------------------------------------------------
    -- generation of parameterized fragments
    -------------------------------------------------------------------------------

    mkUserType :: Signature -> ShowS
    mkUserType :: (Types, [Types]) -> ShowS
    mkUserType (ret :: Types
    ret,ts :: [Types]
    ts) = let
      (str :: ShowS
    str,cs :: String
    cs) = ((ShowS, String) -> Types -> (ShowS, String))
    -> (ShowS, String) -> [Types] -> (ShowS, String)
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\(str :: ShowS
    str,cs :: String
    cs) t :: Types
    t ->
                let (str' :: ShowS
    str',cs' :: String
    cs') = Types -> String -> (ShowS, String)
    usertype Types
    t String
    cs in (ShowS
    strShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .ShowS
    str'ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss " -> ",String
    cs'))
                (Char -> ShowS
    sc '(',['a'..]) [Types]
    ts
      (str' :: ShowS
    str',_) = Types -> String -> (ShowS, String)
    usertype Types
    ret String
    cs
      str'' :: ShowS
    str'' = if ' ' Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (ShowS
    str' "") then (Char -> ShowS
    sc '('ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .ShowS
    str'ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc ')') else ShowS
    str'
      in ShowS
    strShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss "IO "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .ShowS
    str''ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc ')'

    mkContext :: Signature -> ShowS
    mkContext :: (Types, [Types]) -> ShowS
    mkContext (ret :: Types
    ret,ts :: [Types]
    ts) = let ctxts :: [ShowS]
    ctxts = [Types] -> String -> [ShowS]
    context ([Types]
    ts[Types] -> [Types] -> [Types]
    forall a. [a] -> [a] -> [a]
    ++[Types
    ret]) ['a'..] in
      if [ShowS] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ShowS]
    ctxts then String -> ShowS
    ss "GObjectClass obj =>" else Char -> ShowS
    sc '('ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        (ShowS -> ShowS -> ShowS) -> [ShowS] -> ShowS
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldl1 (\a :: ShowS
    a b :: ShowS
    b -> ShowS
    aShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss ", "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .ShowS
    b) [ShowS]
    ctxtsShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss ", GObjectClass obj) =>"

    mkMarshType :: Signature -> [ShowS]
    mkMarshType :: (Types, [Types]) -> [ShowS]
    mkMarshType (ret :: Types
    ret,ts :: [Types]
    ts) = [Types] -> String -> [ShowS]
    marshType ([Types]
    ts[Types] -> [Types] -> [Types]
    forall a. [a] -> [a] -> [a]
    ++[Types
    ret]) ['a'..]

    mkType :: (Types, [Types]) -> ShowS
    mkType sig :: (Types, [Types])
    sig = let types :: [ShowS]
    types = (Types, [Types]) -> [ShowS]
    mkMarshType (Types, [Types])
    sig in
      if [ShowS] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ShowS]
    types then ShowS
    forall a. a -> a
    id else (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) (Int -> ShowS
    indent 1) [ShowS]
    types

    mkMarshArg :: Signature -> [ShowS]
    mkMarshArg :: (Types, [Types]) -> [ShowS]
    mkMarshArg (ret :: Types
    ret,ts :: [Types]
    ts) = (Types -> Int -> ShowS) -> [Types] -> [Int] -> [ShowS]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Types -> Int -> ShowS
    marshArg ([Types]
    ts[Types] -> [Types] -> [Types]
    forall a. [a] -> [a] -> [a]
    ++[Types
    ret]) [1..]

    mkArg :: (Types, [Types]) -> ShowS
    mkArg sig :: (Types, [Types])
    sig = (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) (Char -> ShowS
    sc ' ') ([ShowS] -> ShowS) -> [ShowS] -> ShowS
    forall a b. (a -> b) -> a -> b
    $ (Types, [Types]) -> [ShowS]
    mkMarshArg (Types, [Types])
    sig

    #ifdef USE_GCLOSURE_SIGNALS_IMPL

    mkMarshExec :: Signature -> ShowS
    mkMarshExec :: (Types, [Types]) -> ShowS
    mkMarshExec (ret :: Types
    ret,ts :: [Types]
    ts) = (ShowS -> (ShowS -> ShowS) -> ShowS)
    -> ShowS -> [ShowS -> ShowS] -> ShowS
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\body :: ShowS
    body marshaler :: ShowS -> ShowS
    marshaler -> ShowS -> ShowS
    marshaler ShowS
    body) (Int -> ShowS
    indent 5ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss "user")
                                 ([ShowS -> ShowS]
    paramMarshalers[ShowS -> ShowS] -> [ShowS -> ShowS] -> [ShowS -> ShowS]
    forall a. [a] -> [a] -> [a]
    ++[ShowS -> ShowS
    returnMarshaler])
      where paramMarshalers :: [ShowS -> ShowS]
    paramMarshalers = [ Types -> ShowS -> Int -> ShowS -> ShowS
    marshExec Types
    t (Types -> Int -> ShowS
    nameArg Types
    t Int
    n) Int
    n | (t :: Types
    t,n :: Int
    n) <- [Types] -> [Int] -> [(Types, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Types]
    ts [1..] ]
            returnMarshaler :: ShowS -> ShowS
    returnMarshaler = Types -> ShowS -> ShowS
    marshRet Types
    ret

    #else

    mkMarshExec :: Signature -> ShowS
    mkMarshExec (_,ts) = foldl (.) id $
                         zipWith marshExec ts [1..]

    #endif

    mkIdentifier :: Signature -> ShowS
    mkIdentifier :: (Types, [Types]) -> ShowS
    mkIdentifier (ret :: Types
    ret,[]) = Types -> ShowS
    identifier Types
    Tunit ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "__"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Types -> ShowS
    identifier Types
    ret
    mkIdentifier (ret :: Types
    ret,ts :: [Types]
    ts) = (ShowS -> ShowS -> ShowS) -> [ShowS] -> ShowS
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldl1 (\a :: ShowS
    a b :: ShowS
    b -> ShowS
    aShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc '_'ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .ShowS
    b) ((Types -> ShowS) -> [Types] -> [ShowS]
    forall a b. (a -> b) -> [a] -> [b]
    map Types -> ShowS
    identifier [Types]
    ts)ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                            String -> ShowS
    ss "__"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Types -> ShowS
    identifier Types
    ret

    mkRawtype :: Signature -> ShowS
    mkRawtype :: (Types, [Types]) -> ShowS
    mkRawtype (ret :: Types
    ret,ts :: [Types]
    ts) =
      (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) ShowS
    forall a. a -> a
    id ((Types -> ShowS) -> [Types] -> [ShowS]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ty :: Types
    ty -> Types -> ShowS
    rawtype Types
    tyShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss " -> ") [Types]
    ts)ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      (case Types
    ret of
          Tboxed  -> String -> ShowS
    ss "IO ("ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Types -> ShowS
    rawtype Types
    retShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc ')'
          Tptr    -> String -> ShowS
    ss "IO ("ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Types -> ShowS
    rawtype Types
    retShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc ')'
          Ttobject -> String -> ShowS
    ss "IO ("ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Types -> ShowS
    rawtype Types
    retShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc ')'
          Tmtobject -> String -> ShowS
    ss "IO ("ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Types -> ShowS
    rawtype Types
    retShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc ')'
          Tobject -> String -> ShowS
    ss "IO ("ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Types -> ShowS
    rawtype Types
    retShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc ')'
          Tmobject -> String -> ShowS
    ss "IO ("ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Types -> ShowS
    rawtype Types
    retShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc ')'
          _       -> String -> ShowS
    ss "IO "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Types -> ShowS
    rawtype Types
    ret)

    mkLambdaArgs :: Signature -> ShowS
    mkLambdaArgs :: (Types, [Types]) -> ShowS
    mkLambdaArgs (_,ts :: [Types]
    ts) = (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) ShowS
    forall a. a -> a
    id ([ShowS] -> ShowS) -> [ShowS] -> ShowS
    forall a b. (a -> b) -> a -> b
    $
                          (Types -> Int -> ShowS) -> [Types] -> [Int] -> [ShowS]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\a :: Types
    a b :: Int
    b -> Types -> Int -> ShowS
    nameArg Types
    a Int
    bShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc ' ') [Types]
    ts [1..]

    #ifndef USE_GCLOSURE_SIGNALS_IMPL

    mkFuncArgs :: Signature -> ShowS
    mkFuncArgs (_,ts) = foldl (.) id $
                        zipWith (\a b -> sc ' '.nameArg a b.sc '\'') ts [1..]

    mkMarshRet :: Signature -> ShowS
    mkMarshRet (ret,_) = marshRet ret

    #endif

    -------------------------------------------------------------------------------
    -- start of code generation
    -------------------------------------------------------------------------------

    usage :: IO b
    usage = do
     Handle -> String -> IO ()
    hPutStr Handle
    stderr (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $
       "Program to generate callback hook for Gtk signals. Usage:\n\n"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       "HookGenerator [--template=<template-file>] --types=<types-file>\n"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       "              [--import=<import>]  --modname=<moduleName> > <outFile>\n"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       "where\n"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       "  <moduleName>    the module name for <outFile>\n"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       "  <template-file> a path to the Signal.chs.template file\n"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       "  <types-file>    a path to a gtkmarshal.list file\n"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
       "  <import>        a module to be imported into the template file\n"
     ExitCode -> IO b
    forall a. ExitCode -> IO a
    exitWith (ExitCode -> IO b) -> ExitCode -> IO b
    forall a b. (a -> b) -> a -> b
    $ Int -> ExitCode
    ExitFailure 1

    hookGen :: [String] -> IO String
    hookGen :: [String] -> IO String
    hookGen args :: [String]
    args = do
      let showHelp :: Bool
    showHelp = Bool -> Bool
    not ([String] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ((String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ("-h" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`) [String]
    args[String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
                                (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ("--help" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`) [String]
    args)) Bool -> Bool -> Bool
    || [String] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    args
      if Bool
    showHelp then IO String
    forall b. IO b
    usage else do
      let outModuleName :: String
    outModuleName = case ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop 10) ((String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ("--modname=" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`)  [String]
    args) of
                            (modName :: String
    modName:_) -> String
    modName
      String
    templateFile <- case ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop 11) ((String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ("--template=" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`)  [String]
    args) of
                        [tplName :: String
    tplName] -> String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    tplName
                        _ -> String -> IO String
    getDataFileName "callbackGen/Signal.chs.template"
      String
    typesFile <- case ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop 8) ((String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ("--types=" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`)  [String]
    args) of
                     [typName :: String
    typName] -> String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    typName
                     _ -> IO String
    forall b. IO b
    usage
      let extraImports :: [String]
    extraImports = ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop 9) ((String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ("--import=" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`) [String]
    args)
      String
    content <- String -> IO String
    readFile String
    typesFile
      let sigs :: Signatures
    sigs = String -> Signatures
    parseSignatures String
    content
      String
    template <- String -> IO String
    readFile String
    templateFile
      String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $
        String -> (String -> ShowS) -> ShowS
    templateSubstitute String
    template (\var :: String
    var ->
          case String
    var of
            "MODULE_NAME"    -> String -> ShowS
    ss String
    outModuleName
            "MODULE_EXPORTS" -> Signatures -> ShowS
    genExport Signatures
    sigs
            "MODULE_IMPORTS" -> [String] -> ShowS
    genImports [String]
    extraImports
            "MODULE_BODY"    -> (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) ShowS
    forall a. a -> a
    id (((Types, [Types]) -> ShowS) -> Signatures -> [ShowS]
    forall a b. (a -> b) -> [a] -> [b]
    map (Types, [Types]) -> ShowS
    generate Signatures
    sigs)
            _ -> String -> ShowS
    forall a. HasCallStack => String -> a
    error String
    var
        ) ""

    templateSubstitute :: String -> (String -> ShowS) -> ShowS
    templateSubstitute :: String -> (String -> ShowS) -> ShowS
    templateSubstitute template :: String
    template varSubst :: String -> ShowS
    varSubst = String -> ShowS
    doSubst String
    template
      where doSubst :: String -> ShowS
    doSubst [] = ShowS
    forall a. a -> a
    id
            doSubst ('\\':'@':cs :: String
    cs) = Char -> ShowS
    sc '@' ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    doSubst String
    cs
            doSubst ('@':cs :: String
    cs) = let (var :: String
    var,_:cs' :: String
    cs') = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span ('@'Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /=) String
    cs
                                in String -> ShowS
    varSubst String
    var ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    doSubst String
    cs'
            doSubst (c :: Char
    c:cs :: String
    cs) = Char -> ShowS
    sc Char
    c ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    doSubst String
    cs

    -------------------------------------------------------------------------------
    -- generate dynamic fragments
    -------------------------------------------------------------------------------

    genExport :: Signatures -> ShowS
    genExport :: Signatures -> ShowS
    genExport sigs :: Signatures
    sigs = (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) ShowS
    forall a. a -> a
    id (((Types, [Types]) -> ShowS) -> Signatures -> [ShowS]
    forall a b. (a -> b) -> [a] -> [b]
    map (Types, [Types]) -> ShowS
    mkId Signatures
    sigs)
      where
        mkId :: (Types, [Types]) -> ShowS
    mkId sig :: (Types, [Types])
    sig = String -> ShowS
    ss "connect_"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Types, [Types]) -> ShowS
    mkIdentifier (Types, [Types])
    sigShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Char -> ShowS
    sc ','ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Int -> ShowS
    indent 1

    genImports :: [String] -> ShowS
    genImports :: [String] -> ShowS
    genImports mods :: [String]
    mods = (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.) ShowS
    forall a. a -> a
    id ((String -> ShowS) -> [String] -> [ShowS]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> ShowS
    mkImp [String]
    mods)
      where
        mkImp :: String -> ShowS
    mkImp m :: String
    m = String -> ShowS
    ss "import " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss String
    m ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ShowS
    indent 0

    #ifdef USE_GCLOSURE_SIGNALS_IMPL

    generate :: Signature -> ShowS
    generate :: (Types, [Types]) -> ShowS
    generate sig :: (Types, [Types])
    sig = let ident :: ShowS
    ident = (Types, [Types]) -> ShowS
    mkIdentifier (Types, [Types])
    sig in
      Int -> ShowS
    indent 0ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss "connect_"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .ShowS
    identShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss " :: "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      Int -> ShowS
    indent 1ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Types, [Types]) -> ShowS
    mkContext (Types, [Types])
    sigShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss " SignalName ->"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      (Types, [Types]) -> ShowS
    mkType (Types, [Types])
    sigShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      Int -> ShowS
    indent 1ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss "ConnectAfter -> obj ->"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      Int -> ShowS
    indent 1ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Types, [Types]) -> ShowS
    mkUserType (Types, [Types])
    sigShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss " ->"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      Int -> ShowS
    indent 1ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss "IO (ConnectId obj)"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      Int -> ShowS
    indent 0ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss "connect_"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .ShowS
    identShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss " signal"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Types, [Types]) -> ShowS
    mkArg (Types, [Types])
    sigShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    ss "after obj user ="ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      Int -> ShowS
    indent 1ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss "connectGeneric signal after obj action"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      Int -> ShowS
    indent 1ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss "where action :: Ptr GObject -> "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Types, [Types]) -> ShowS
    mkRawtype (Types, [Types])
    sigShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      Int -> ShowS
    indent 1ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss "      action _ "ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(Types, [Types]) -> ShowS
    mkLambdaArgs (Types, [Types])
    sigShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    sc '='ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      Int -> ShowS
    indent 5ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .String -> ShowS
    ss "failOnGError $"ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      (Types, [Types]) -> ShowS
    mkMarshExec (Types, [Types])
    sigShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
      Int -> ShowS
    indent 0

    #else

    generate :: Signature -> ShowS
    generate sig = let ident = mkIdentifier sig in
      indent 0.ss "type Tag_".ident.ss " = Ptr () -> ".
      indent 1.mkRawtype sig.
      indent 0.
      indent 0.ss "foreign".ss " import ccall \"wrapper\" ".ss "mkHandler_".ident.ss " ::".
      indent 1.ss "Tag_".ident.ss " -> ".
      indent 1.ss "IO (FunPtr ".ss "Tag_".ident.sc ')'.
      indent 0.
      indent 0.ss "connect_".ident.ss " :: ".
      indent 1.mkContext sig.ss " SignalName ->".
      mkType sig.
      indent 1.ss "ConnectAfter -> obj ->".
      indent 1.mkUserType sig.ss " ->".
      indent 1.ss "IO (ConnectId obj)".
      indent 0.ss "connect_".ident.ss " signal".
      mkArg sig.
      indent 1.ss "after obj user =".
      indent 1.ss "do".
      indent 2.ss "hPtr <- mkHandler_".ident.
      indent 3.ss "(\\_ ".mkLambdaArgs sig.ss "-> failOnGError $ do".
      mkMarshExec sig.
      indent 4.ss "liftM ".mkMarshRet sig.ss " $".
      indent 5.ss "user".mkFuncArgs sig.
      indent 3.sc ')'.
      indent 2.ss "dPtr <- mkFunPtrClosureNotify hPtr".
      indent 2.ss "sigId <- withCString signal $ \\nPtr ->".
      indent 3.ss "withForeignPtr ((unGObject.toGObject) obj) $ \\objPtr ->".
      indent 4.ss "{#call unsafe g_signal_connect_data#} (castPtr objPtr)".
      indent 5.ss "nPtr (castFunPtr hPtr) nullPtr dPtr (fromBool after)".
      indent 2.ss "return $ ConnectId sigId obj".
      indent 0

    #endif