{-# LANGUAGE CPP #-}
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)
data Types = Tunit
| Tbool
| Tchar
| Tuchar
| Tint
| Tuint
| Tlong
| Tulong
| Tenum
| Tflags
| Tfloat
| Tdouble
| Tstring
| Tmstring
| Tgstring
| Tmgstring
| Tboxed
| Tptr
| Ttobject
| Tmtobject
| Tobject
| Tmobject
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]
parseSignatures :: String -> Signatures
parseSignatures :: String -> Signatures
parseSignatures 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 Int
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 Int
_ Token
TokColon = String -> ShowS
forall a. Show a => a -> ShowS
shows String
":"
showsPrec Int
_ (TokType Types
_) = String -> ShowS
forall a. Show a => a -> ShowS
shows String
"<type>"
showsPrec Int
_ Token
TokComma = String -> ShowS
forall a. Show a => a -> ShowS
shows String
","
showsPrec Int
_ Token
TokEOL = String -> ShowS
forall a. Show a => a -> ShowS
shows String
"<EOL>"
parseSig :: Int -> [Token] -> Signatures
parseSig :: Int -> [Token] -> Signatures
parseSig Int
l [] = []
parseSig Int
l (Token
TokEOL: [Token]
rem) = Int -> [Token] -> Signatures
parseSig (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Token]
rem
parseSig Int
l (TokType Types
ret: Token
TokColon: TokType Types
Tunit:[Token]
rem) =
(Types
ret,[])(Types, [Types]) -> Signatures -> Signatures
forall a. a -> [a] -> [a]
:Int -> [Token] -> Signatures
parseSig Int
l [Token]
rem
parseSig Int
l (TokType Types
ret: Token
TokColon: [Token]
rem) =
let ([Types]
args,[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
+Int
1) [Token]
rem'
parseSig Int
l [Token]
rem = String -> Signatures
forall a. HasCallStack => String -> a
error (String
"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]
++
String
": 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 Int
5 [Token]
rem))
parseArg :: Int -> [Token] -> ([Types],[Token])
parseArg :: Int -> [Token] -> ([Types], [Token])
parseArg Int
l [TokType Types
ty] = ([Types
ty],[])
parseArg Int
l (TokType Types
ty: Token
TokEOL:[Token]
rem) = ([Types
ty],[Token]
rem)
parseArg Int
l (TokType Types
ty: Token
TokComma:[Token]
rem) =
let ([Types]
args,[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 Int
l [Token]
rem = String -> ([Types], [Token])
forall a. HasCallStack => String -> a
error (String
"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]
++String
": expected type"String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" 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 Int
5 [Token]
rem))
scan :: String -> [Token]
scan :: String -> [Token]
scan String
"" = []
scan (Char
'#':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
/=Char
'\n')) String
xs
scan (Char
'\n':String
xs) = Token
TokEOLToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
' ':String
xs) = String -> [Token]
scan String
xs
scan (Char
'\t':String
xs) = String -> [Token]
scan String
xs
scan (Char
':':String
xs) = Token
TokColonToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
',':String
xs) = Token
TokCommaToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'V':Char
'O':Char
'I':Char
'D':String
xs) = Types -> Token
TokType Types
TunitToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'B':Char
'O':Char
'O':Char
'L':Char
'E':Char
'A':Char
'N':String
xs) = Types -> Token
TokType Types
TboolToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'C':Char
'H':Char
'A':Char
'R':String
xs) = Types -> Token
TokType Types
TcharToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'U':Char
'C':Char
'H':Char
'A':Char
'R':String
xs) = Types -> Token
TokType Types
TucharToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'I':Char
'N':Char
'T':String
xs) = Types -> Token
TokType Types
TintToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'U':Char
'I':Char
'N':Char
'T':String
xs) = Types -> Token
TokType Types
TuintToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'L':Char
'O':Char
'N':Char
'G':String
xs) = Types -> Token
TokType Types
TuintToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'U':Char
'L':Char
'O':Char
'N':Char
'G':String
xs) = Types -> Token
TokType Types
TulongToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'E':Char
'N':Char
'U':Char
'M':String
xs) = Types -> Token
TokType Types
TenumToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'F':Char
'L':Char
'A':Char
'G':Char
'S':String
xs) = Types -> Token
TokType Types
TflagsToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'F':Char
'L':Char
'O':Char
'A':Char
'T':String
xs) = Types -> Token
TokType Types
TfloatToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'D':Char
'O':Char
'U':Char
'B':Char
'L':Char
'E':String
xs) = Types -> Token
TokType Types
TdoubleToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'S':Char
'T':Char
'R':Char
'I':Char
'N':Char
'G':String
xs) = Types -> Token
TokType Types
TstringToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'M':Char
'S':Char
'T':Char
'R':Char
'I':Char
'N':Char
'G':String
xs) = Types -> Token
TokType Types
TmstringToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'G':Char
'L':Char
'I':Char
'B':Char
'S':Char
'T':Char
'R':Char
'I':Char
'N':Char
'G':String
xs) = Types -> Token
TokType Types
TgstringToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'M':Char
'G':Char
'L':Char
'I':Char
'B':Char
'S':Char
'T':Char
'R':Char
'I':Char
'N':Char
'G':String
xs) = Types -> Token
TokType Types
TmgstringToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'B':Char
'O':Char
'X':Char
'E':Char
'D':String
xs) = Types -> Token
TokType Types
TboxedToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'P':Char
'O':Char
'I':Char
'N':Char
'T':Char
'E':Char
'R':String
xs) = Types -> Token
TokType Types
TptrToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'T':Char
'O':Char
'B':Char
'J':Char
'E':Char
'C':Char
'T':String
xs) = Types -> Token
TokType Types
TtobjectToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'M':Char
'T':Char
'O':Char
'B':Char
'J':Char
'E':Char
'C':Char
'T':String
xs) = Types -> Token
TokType Types
TmtobjectToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'O':Char
'B':Char
'J':Char
'E':Char
'C':Char
'T':String
xs) = Types -> Token
TokType Types
TobjectToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'M':Char
'O':Char
'B':Char
'J':Char
'E':Char
'C':Char
'T':String
xs) = Types -> Token
TokType Types
TmobjectToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'N':Char
'O':Char
'N':Char
'E':String
xs) = Types -> Token
TokType Types
TunitToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan (Char
'B':Char
'O':Char
'O':Char
'L':String
xs) = Types -> Token
TokType Types
TboolToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:String -> [Token]
scan String
xs
scan String
str = String -> [Token]
forall a. HasCallStack => String -> a
error (String
"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) String
"") (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
5 String
str))
ss :: String -> ShowS
ss = String -> ShowS
showString
sc :: Char -> ShowS
sc = Char -> ShowS
showChar
indent :: Int -> ShowS
indent :: Int -> ShowS
indent Int
c = String -> ShowS
ss (String
"\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
c) Char
' ')
identifier :: Types -> ShowS
identifier :: Types -> ShowS
identifier Types
Tunit = String -> ShowS
ss String
"NONE"
identifier Types
Tbool = String -> ShowS
ss String
"BOOL"
identifier Types
Tchar = String -> ShowS
ss String
"CHAR"
identifier Types
Tuchar = String -> ShowS
ss String
"UCHAR"
identifier Types
Tint = String -> ShowS
ss String
"INT"
identifier Types
Tuint = String -> ShowS
ss String
"WORD"
identifier Types
Tlong = String -> ShowS
ss String
"LONG"
identifier Types
Tulong = String -> ShowS
ss String
"ULONG"
identifier Types
Tenum = String -> ShowS
ss String
"ENUM"
identifier Types
Tflags = String -> ShowS
ss String
"FLAGS"
identifier Types
Tfloat = String -> ShowS
ss String
"FLOAT"
identifier Types
Tdouble = String -> ShowS
ss String
"DOUBLE"
identifier Types
Tstring = String -> ShowS
ss String
"STRING"
identifier Types
Tmstring = String -> ShowS
ss String
"MSTRING"
identifier Types
Tgstring = String -> ShowS
ss String
"GLIBSTRING"
identifier Types
Tmgstring = String -> ShowS
ss String
"MGLIBSTRING"
identifier Types
Tboxed = String -> ShowS
ss String
"BOXED"
identifier Types
Tptr = String -> ShowS
ss String
"PTR"
identifier Types
Ttobject = String -> ShowS
ss String
"OBJECT"
identifier Types
Tmtobject = String -> ShowS
ss String
"MOBJECT"
identifier Types
Tobject = String -> ShowS
ss String
"OBJECT"
identifier Types
Tmobject = String -> ShowS
ss String
"MOBJECT"
#ifdef USE_GCLOSURE_SIGNALS_IMPL
rawtype :: Types -> ShowS
rawtype :: Types -> ShowS
rawtype Types
Tunit = String -> ShowS
ss String
"()"
rawtype Types
Tbool = String -> ShowS
ss String
"Bool"
rawtype Types
Tchar = String -> ShowS
ss String
"Char"
rawtype Types
Tuchar = String -> ShowS
ss String
"Char"
rawtype Types
Tint = String -> ShowS
ss String
"Int"
rawtype Types
Tuint = String -> ShowS
ss String
"Word"
rawtype Types
Tlong = String -> ShowS
ss String
"Int"
rawtype Types
Tulong = String -> ShowS
ss String
"Word"
rawtype Types
Tenum = String -> ShowS
ss String
"Int"
rawtype Types
Tflags = String -> ShowS
ss String
"Word"
rawtype Types
Tfloat = String -> ShowS
ss String
"Float"
rawtype Types
Tdouble = String -> ShowS
ss String
"Double"
rawtype Types
Tstring = String -> ShowS
ss String
"CString"
rawtype Types
Tmstring = String -> ShowS
ss String
"CString"
rawtype Types
Tgstring = String -> ShowS
ss String
"CString"
rawtype Types
Tmgstring = String -> ShowS
ss String
"CString"
rawtype Types
Tboxed = String -> ShowS
ss String
"Ptr ()"
rawtype Types
Tptr = String -> ShowS
ss String
"Ptr ()"
rawtype Types
Ttobject = String -> ShowS
ss String
"Ptr GObject"
rawtype Types
Tmtobject = String -> ShowS
ss String
"Ptr GObject"
rawtype Types
Tobject = String -> ShowS
ss String
"Ptr GObject"
rawtype Types
Tmobject = String -> ShowS
ss String
"Ptr GObject"
#else
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
usertype :: Types -> [Char] -> (ShowS,[Char])
usertype :: Types -> String -> (ShowS, String)
usertype Types
Tunit String
cs = (String -> ShowS
ss String
"()",String
cs)
usertype Types
Tbool (Char
c:String
cs) = (String -> ShowS
ss String
"Bool",String
cs)
usertype Types
Tchar (Char
c:String
cs) = (String -> ShowS
ss String
"Char",String
cs)
usertype Types
Tuchar (Char
c:String
cs) = (String -> ShowS
ss String
"Char",String
cs)
usertype Types
Tint (Char
c:String
cs) = (String -> ShowS
ss String
"Int",String
cs)
usertype Types
Tuint (Char
c:String
cs) = (String -> ShowS
ss String
"Word",String
cs)
usertype Types
Tlong (Char
c:String
cs) = (String -> ShowS
ss String
"Int",String
cs)
usertype Types
Tulong (Char
c:String
cs) = (String -> ShowS
ss String
"Int",String
cs)
usertype Types
Tenum (Char
c:String
cs) = (Char -> ShowS
sc Char
c,String
cs)
usertype Types
Tflags String
cs = Types -> String -> (ShowS, String)
usertype Types
Tenum String
cs
usertype Types
Tfloat (Char
c:String
cs) = (String -> ShowS
ss String
"Float",String
cs)
usertype Types
Tdouble (Char
c:String
cs) = (String -> ShowS
ss String
"Double",String
cs)
usertype Types
Tstring (Char
c:String
cs) = (String -> ShowS
ss String
"String",String
cs)
usertype Types
Tmstring (Char
c:String
cs) = (String -> ShowS
ss String
"Maybe String",String
cs)
usertype Types
Tgstring (Char
c:String
cs) = (Char -> ShowS
sc Char
cShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> ShowS
sc Char
'\'',String
cs)
usertype Types
Tmgstring (Char
c:String
cs) = (String -> ShowS
ss String
"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 Char
'\'',String
cs)
usertype Types
Tboxed (Char
c:String
cs) = (Char -> ShowS
sc Char
c,String
cs)
usertype Types
Tptr (Char
c:String
cs) = (String -> ShowS
ss String
"Ptr "ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> ShowS
sc Char
c,String
cs)
usertype Types
Ttobject (Char
c:String
cs) = (Char -> ShowS
sc Char
cShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> ShowS
sc Char
'\'',String
cs)
usertype Types
Tmtobject (Char
c:String
cs) = (String -> ShowS
ss String
"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 Char
'\'',String
cs)
usertype Types
Tobject (Char
c:String
cs) = (Char -> ShowS
sc Char
cShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> ShowS
sc Char
'\'',String
cs)
usertype Types
Tmobject (Char
c:String
cs) = (String -> ShowS
ss String
"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 Char
'\'',String
cs)
context :: [Types] -> [Char] -> [ShowS]
context :: [Types] -> String -> [ShowS]
context (Types
Tenum:[Types]
ts) (Char
c:String
cs) = String -> ShowS
ss String
"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 (Types
Tflags:[Types]
ts) (Char
c:String
cs) = String -> ShowS
ss String
"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 (Types
Ttobject:[Types]
ts) (Char
c:String
cs) = String -> ShowS
ss String
"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 Char
'\''ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
: [Types] -> String -> [ShowS]
context [Types]
ts String
cs
context (Types
Tmtobject:[Types]
ts) (Char
c:String
cs) = String -> ShowS
ss String
"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 Char
'\''ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
: [Types] -> String -> [ShowS]
context [Types]
ts String
cs
context (Types
Tobject:[Types]
ts) (Char
c:String
cs) = String -> ShowS
ss String
"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 Char
'\''ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
: [Types] -> String -> [ShowS]
context [Types]
ts String
cs
context (Types
Tmobject:[Types]
ts) (Char
c:String
cs) = String -> ShowS
ss String
"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 Char
'\''ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
: [Types] -> String -> [ShowS]
context [Types]
ts String
cs
context (Types
Tgstring:[Types]
ts) (Char
c:String
cs) = String -> ShowS
ss String
"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 Char
'\''ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
: [Types] -> String -> [ShowS]
context [Types]
ts String
cs
context (Types
Tmgstring:[Types]
ts) (Char
c:String
cs) = String -> ShowS
ss String
"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 Char
'\''ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
: [Types] -> String -> [ShowS]
context [Types]
ts String
cs
context (Types
_:[Types]
ts) (Char
c:String
cs) = [Types] -> String -> [ShowS]
context [Types]
ts String
cs
context [] String
_ = []
marshType :: [Types] -> [Char] -> [ShowS]
marshType :: [Types] -> String -> [ShowS]
marshType (Types
Tint:[Types]
ts) (Char
c:String
cs) = [Types] -> String -> [ShowS]
marshType [Types]
ts String
cs
marshType (Types
Tuint:[Types]
ts) (Char
c:String
cs) = [Types] -> String -> [ShowS]
marshType [Types]
ts String
cs
marshType (Types
Tenum:[Types]
ts) (Char
c:String
cs) = [Types] -> String -> [ShowS]
marshType [Types]
ts String
cs
marshType (Types
Tflags:[Types]
ts) String
cs = [Types] -> String -> [ShowS]
marshType (Types
TenumTypes -> [Types] -> [Types]
forall a. a -> [a] -> [a]
:[Types]
ts) String
cs
marshType (Types
Tboxed:[Types]
ts) (Char
c:String
cs) = String -> ShowS
ss String
"(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 String
"' -> 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 String
") -> "ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
:
[Types] -> String -> [ShowS]
marshType [Types]
ts String
cs
marshType (Types
Tptr:[Types]
ts) (Char
c:String
cs) = [Types] -> String -> [ShowS]
marshType [Types]
ts String
cs
marshType (Types
Tobject:[Types]
ts) (Char
c:String
cs) = [Types] -> String -> [ShowS]
marshType [Types]
ts String
cs
marshType (Types
_:[Types]
ts) (Char
c:String
cs) = [Types] -> String -> [ShowS]
marshType [Types]
ts String
cs
marshType [] String
_ = []
type ArgNo = Int
marshArg :: Types -> ArgNo -> ShowS
marshArg :: Types -> Int -> ShowS
marshArg Types
Tboxed Int
c = String -> ShowS
ss String
"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 Char
' '
marshArg Types
_ Int
_ = ShowS
forall a. a -> a
id
nameArg :: Types -> ArgNo -> ShowS
nameArg :: Types -> Int -> ShowS
nameArg Types
Tunit Int
_ = ShowS
forall a. a -> a
id
nameArg Types
Tbool Int
c = String -> ShowS
ss String
"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 Types
Tchar Int
c = String -> ShowS
ss String
"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 Types
Tuchar Int
c = String -> ShowS
ss String
"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 Types
Tint Int
c = String -> ShowS
ss String
"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 Types
Tuint Int
c = String -> ShowS
ss String
"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 Types
Tlong Int
c = String -> ShowS
ss String
"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 Types
Tulong Int
c = String -> ShowS
ss String
"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 Types
Tenum Int
c = String -> ShowS
ss String
"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 Types
Tflags Int
c = String -> ShowS
ss String
"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 Types
Tfloat Int
c = String -> ShowS
ss String
"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 Types
Tdouble Int
c = String -> ShowS
ss String
"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 Types
Tstring Int
c = String -> ShowS
ss String
"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 Types
Tmstring Int
c = String -> ShowS
ss String
"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 Types
Tgstring Int
c = String -> ShowS
ss String
"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 Types
Tmgstring Int
c = String -> ShowS
ss String
"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 Types
Tboxed Int
c = String -> ShowS
ss String
"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 Types
Tptr Int
c = String -> ShowS
ss String
"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 Types
Ttobject Int
c = String -> ShowS
ss String
"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 Types
Tmtobject Int
c = String -> ShowS
ss String
"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 Types
Tobject Int
c = String -> ShowS
ss String
"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 Types
Tmobject Int
c = String -> ShowS
ss String
"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
#ifdef USE_GCLOSURE_SIGNALS_IMPL
marshExec :: Types -> ShowS -> Int -> (ShowS -> ShowS)
marshExec :: Types -> ShowS -> Int -> ShowS -> ShowS
marshExec Types
Tbool ShowS
arg Int
_ ShowS
body = ShowS
bodyShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
sc Char
' 'ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
arg
marshExec Types
Tchar ShowS
arg Int
_ ShowS
body = ShowS
bodyShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
sc Char
' 'ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
arg
marshExec Types
Tuchar ShowS
arg Int
_ ShowS
body = ShowS
bodyShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
sc Char
' 'ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
arg
marshExec Types
Tint ShowS
arg Int
_ ShowS
body = ShowS
bodyShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
sc Char
' 'ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
arg
marshExec Types
Tuint ShowS
arg Int
_ ShowS
body = ShowS
bodyShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
sc Char
' 'ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
arg
marshExec Types
Tlong ShowS
arg Int
_ ShowS
body = ShowS
bodyShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
sc Char
' 'ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
arg
marshExec Types
Tulong ShowS
arg Int
_ ShowS
body = ShowS
bodyShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
sc Char
' 'ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
arg
marshExec Types
Tenum ShowS
arg Int
_ ShowS
body = ShowS
bodyShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
ss String
" (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 Char
')'
marshExec Types
Tflags ShowS
arg Int
_ ShowS
body = ShowS
bodyShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
ss String
" (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 Char
')'
marshExec Types
Tfloat ShowS
arg Int
_ ShowS
body = ShowS
bodyShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
sc Char
' 'ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
arg
marshExec Types
Tdouble ShowS
arg Int
_ ShowS
body = ShowS
bodyShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
sc Char
' 'ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
arg
marshExec Types
Tstring ShowS
arg Int
_ ShowS
body = Int -> ShowS
indent Int
5ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
ss String
"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 String
" >>= \\"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 String
"\' ->"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 Char
' '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 Char
'\''
marshExec Types
Tmstring ShowS
arg Int
_ ShowS
body = Int -> ShowS
indent Int
5ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
ss String
"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 String
" >>= \\"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 String
"\' ->"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 Char
' '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 Char
'\''
marshExec Types
Tgstring ShowS
arg Int
_ ShowS
body = Int -> ShowS
indent Int
5ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
ss String
"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 String
" >>= \\"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 String
"\' ->"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 Char
' '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 Char
'\''
marshExec Types
Tmgstring ShowS
arg Int
_ ShowS
body = Int -> ShowS
indent Int
5ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
ss String
"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 String
" >>= \\"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 String
"\' ->"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 Char
' '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 Char
'\''
marshExec Types
Tboxed ShowS
arg Int
n ShowS
body = Int -> ShowS
indent Int
5ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
ss String
"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 String
" (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 String
") >>= \\"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 String
"\' ->"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 Char
' '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 Char
'\''
marshExec Types
Tptr ShowS
arg Int
_ ShowS
body = ShowS
bodyShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
ss String
" (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 Char
')'
marshExec Types
Ttobject ShowS
arg Int
_ ShowS
body = Int -> ShowS
indent Int
5ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> ShowS
ss String
"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 String
") >>= \\"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 String
"\' ->"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 String
" (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 String
"\')"
marshExec Types
Tmtobject ShowS
arg Int
_ ShowS
body = Int -> ShowS
indent Int
5ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> ShowS
ss String
"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 String
") >>= \\"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 String
"\' ->"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 String
" (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 String
"\')"
marshExec Types
Tobject ShowS
arg Int
_ ShowS
body = Int -> ShowS
indent Int
5ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> ShowS
ss String
"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 String
") >>= \\"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 String
"\' ->"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 String
" (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 String
"\')"
marshExec Types
Tmobject ShowS
arg Int
_ ShowS
body = Int -> ShowS
indent Int
5ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> ShowS
ss String
"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 String
") >>= \\"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 String
"\' ->"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 String
" (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 String
"\')"
marshRet :: Types -> (ShowS -> ShowS)
marshRet :: Types -> ShowS -> ShowS
marshRet Types
Tunit ShowS
body = ShowS
body
marshRet Types
Tbool ShowS
body = ShowS
body
marshRet Types
Tint ShowS
body = ShowS
body
marshRet Types
Tuint ShowS
body = ShowS
body
marshRet Types
Tlong ShowS
body = ShowS
body
marshRet Types
Tulong ShowS
body = ShowS
body
marshRet Types
Tenum ShowS
body = Int -> ShowS
indent Int
5ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
ss String
"liftM fromEnum $ "ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
body
marshRet Types
Tflags ShowS
body = Int -> ShowS
indent Int
5ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
ss String
"liftM fromFlags $ "ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
body
marshRet Types
Tfloat ShowS
body = ShowS
body
marshRet Types
Tdouble ShowS
body = ShowS
body
marshRet Types
Tstring ShowS
body = ShowS
bodyShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
indent Int
5ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
ss String
">>= newUTFString"
marshRet Types
Tgstring ShowS
body = ShowS
bodyShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
indent Int
5ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
ss String
">>= newUTFString"
marshRet Types
Tptr ShowS
body = Int -> ShowS
indent Int
5ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
ss String
"liftM castPtr $ "ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
body
marshRet Types
_ ShowS
_ = String -> ShowS
forall a. HasCallStack => String -> a
error String
"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
mkUserType :: Signature -> ShowS
mkUserType :: (Types, [Types]) -> ShowS
mkUserType (Types
ret,[Types]
ts) = let
(ShowS
str,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 (\(ShowS
str,String
cs) Types
t ->
let (ShowS
str',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
" -> ",String
cs'))
(Char -> ShowS
sc Char
'(',[Char
'a'..]) [Types]
ts
(ShowS
str',String
_) = Types -> String -> (ShowS, String)
usertype Types
ret String
cs
str'' :: ShowS
str'' = if Char
' ' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (ShowS
str' String
"") then (Char -> ShowS
sc Char
'('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 Char
')') else ShowS
str'
in ShowS
strShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> ShowS
ss String
"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 Char
')'
mkContext :: Signature -> ShowS
mkContext :: (Types, [Types]) -> ShowS
mkContext (Types
ret,[Types]
ts) = let ctxts :: [ShowS]
ctxts = [Types] -> String -> [ShowS]
context ([Types]
ts[Types] -> [Types] -> [Types]
forall a. [a] -> [a] -> [a]
++[Types
ret]) [Char
'a'..] in
if [ShowS] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ShowS]
ctxts then String -> ShowS
ss String
"GObjectClass obj =>" else Char -> ShowS
sc Char
'('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 (\ShowS
a ShowS
b -> ShowS
aShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> ShowS
ss String
", "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 String
", GObjectClass obj) =>"
mkMarshType :: Signature -> [ShowS]
mkMarshType :: (Types, [Types]) -> [ShowS]
mkMarshType (Types
ret,[Types]
ts) = [Types] -> String -> [ShowS]
marshType ([Types]
ts[Types] -> [Types] -> [Types]
forall a. [a] -> [a] -> [a]
++[Types
ret]) [Char
'a'..]
mkType :: (Types, [Types]) -> ShowS
mkType (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 Int
1) [ShowS]
types
mkMarshArg :: Signature -> [ShowS]
mkMarshArg :: (Types, [Types]) -> [ShowS]
mkMarshArg (Types
ret,[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]) [Int
1..]
mkArg :: (Types, [Types]) -> ShowS
mkArg (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 Char
' ') ([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 (Types
ret,[Types]
ts) = (ShowS -> (ShowS -> ShowS) -> ShowS)
-> ShowS -> [ShowS -> ShowS] -> ShowS
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ShowS
body ShowS -> ShowS
marshaler -> ShowS -> ShowS
marshaler ShowS
body) (Int -> ShowS
indent Int
5ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> ShowS
ss String
"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 | (Types
t,Int
n) <- [Types] -> [Int] -> [(Types, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Types]
ts [Int
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 (Types
ret,[]) = Types -> ShowS
identifier Types
Tunit ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
ss String
"__"ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Types -> ShowS
identifier Types
ret
mkIdentifier (Types
ret,[Types]
ts) = (ShowS -> ShowS -> ShowS) -> [ShowS] -> ShowS
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\ShowS
a ShowS
b -> ShowS
aShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> ShowS
sc Char
'_'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 String
"__"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 (Types
ret,[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 (\Types
ty -> Types -> ShowS
rawtype Types
tyShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> ShowS
ss String
" -> ") [Types]
ts)ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(case Types
ret of
Types
Tboxed -> String -> ShowS
ss String
"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 Char
')'
Types
Tptr -> String -> ShowS
ss String
"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 Char
')'
Types
Ttobject -> String -> ShowS
ss String
"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 Char
')'
Types
Tmtobject -> String -> ShowS
ss String
"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 Char
')'
Types
Tobject -> String -> ShowS
ss String
"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 Char
')'
Types
Tmobject -> String -> ShowS
ss String
"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 Char
')'
Types
_ -> String -> ShowS
ss String
"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 (Types
_,[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 (\Types
a 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 Char
' ') [Types]
ts [Int
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
usage :: IO b
usage = do
Handle -> String -> IO ()
hPutStr Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"Program to generate callback hook for Gtk signals. Usage:\n\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"HookGenerator [--template=<template-file>] --types=<types-file>\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" [--import=<import>] --modname=<moduleName> > <outFile>\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"where\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" <moduleName> the module name for <outFile>\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" <template-file> a path to the Signal.chs.template file\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" <types-file> a path to a gtkmarshal.list file\n"String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
" <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 Int
1
hookGen :: [String] -> IO String
hookGen :: [String] -> IO String
hookGen [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 (String
"-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 (String
"--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 Int
10) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"--modname=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
args) of
(String
modName:[String]
_) -> String
modName
String
templateFile <- case ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
11) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"--template=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
args) of
[String
tplName] -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
tplName
[String]
_ -> String -> IO String
getDataFileName String
"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 Int
8) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"--types=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
args) of
[String
typName] -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
typName
[String]
_ -> 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 Int
9) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"--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 (\String
var ->
case String
var of
String
"MODULE_NAME" -> String -> ShowS
ss String
outModuleName
String
"MODULE_EXPORTS" -> Signatures -> ShowS
genExport Signatures
sigs
String
"MODULE_IMPORTS" -> [String] -> ShowS
genImports [String]
extraImports
String
"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
_ -> String -> ShowS
forall a. HasCallStack => String -> a
error String
var
) String
""
templateSubstitute :: String -> (String -> ShowS) -> ShowS
templateSubstitute :: String -> (String -> ShowS) -> ShowS
templateSubstitute String
template String -> ShowS
varSubst = String -> ShowS
doSubst String
template
where doSubst :: String -> ShowS
doSubst [] = ShowS
forall a. a -> a
id
doSubst (Char
'\\':Char
'@':String
cs) = Char -> ShowS
sc Char
'@' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
doSubst String
cs
doSubst (Char
'@':String
cs) = let (String
var,Char
_:String
cs') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char
'@'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 (Char
c: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
genExport :: Signatures -> ShowS
genExport :: Signatures -> ShowS
genExport 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 (Types, [Types])
sig = String -> ShowS
ss String
"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 Char
','ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> ShowS
indent Int
1
genImports :: [String] -> ShowS
genImports :: [String] -> ShowS
genImports [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 String
m = String -> ShowS
ss String
"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 Int
0
#ifdef USE_GCLOSURE_SIGNALS_IMPL
generate :: Signature -> ShowS
generate :: (Types, [Types]) -> ShowS
generate (Types, [Types])
sig = let ident :: ShowS
ident = (Types, [Types]) -> ShowS
mkIdentifier (Types, [Types])
sig in
Int -> ShowS
indent Int
0ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> ShowS
ss String
"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 String
" :: "ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> ShowS
indent Int
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 String
" 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 Int
1ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> ShowS
ss String
"ConnectAfter -> obj ->"ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> ShowS
indent Int
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 String
" ->"ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> ShowS
indent Int
1ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> ShowS
ss String
"IO (ConnectId obj)"ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> ShowS
indent Int
0ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> ShowS
ss String
"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 String
" 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 String
"after obj user ="ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> ShowS
indent Int
1ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> ShowS
ss String
"connectGeneric signal after obj action"ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> ShowS
indent Int
1ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> ShowS
ss String
"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 Int
1ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> ShowS
ss String
" 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 Char
'='ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> ShowS
indent Int
5ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> ShowS
ss String
"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 Int
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