{-# 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 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))
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) ' ')
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
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
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 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)
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 [] _ = []
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
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
#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
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
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
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