module TypeGen (typeGen) where
import Data.Char (isAlpha, isAlphaNum, toLower, toUpper, isUpper)
import Data.List (isPrefixOf)
import Control.Monad (when)
import System.Exit (exitWith, ExitCode(..))
import System.IO (stderr, hPutStr)
import Paths_gtk2hs_buildtools (getDataFileName)
type ObjectSpec = [(Int,String)]
type TypeQuery = (String, TypeInfo)
data TypeInfo = TypeInfo {
TypeInfo -> String
tiQueryFunction :: String,
TypeInfo -> Maybe String
tiAlternateName :: Maybe String,
TypeInfo -> Bool
tiNoEqualInst :: Bool,
TypeInfo -> Bool
tiDefaultDestr :: Bool
}
type TypeTable = [TypeQuery]
type Tag = String
data ParserState = ParserState {
ParserState -> Int
line :: Int,
ParserState -> Int
col :: Int,
ParserState -> ObjectSpec
hierObjs :: ObjectSpec,
ParserState -> [String]
onlyTags :: [Tag]
}
freshParserState :: [Tag] -> ParserState
freshParserState :: [String] -> ParserState
freshParserState = Int -> Int -> ObjectSpec -> [String] -> ParserState
ParserState Int
1 Int
1 []
pFreshLine :: ParserState -> String -> [(ObjectSpec, TypeQuery)]
pFreshLine :: ParserState -> String -> [(ObjectSpec, TypeQuery)]
pFreshLine ParserState
ps String
input = ParserState -> String -> [(ObjectSpec, TypeQuery)]
pFL ParserState
ps String
input
where
pFL :: ParserState -> String -> [(ObjectSpec, TypeQuery)]
pFL ParserState
ps (Char
'#':String
rem) = ParserState -> String -> [(ObjectSpec, TypeQuery)]
pFL ParserState
ps ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Char
'\n') String
rem)
pFL ParserState
ps (Char
'\n':String
rem) = ParserState -> String -> [(ObjectSpec, TypeQuery)]
pFL (ParserState
ps {line :: Int
line = ParserState -> Int
line ParserState
psInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, col :: Int
col=Int
1}) String
rem
pFL ParserState
ps (Char
' ':String
rem) = ParserState -> String -> [(ObjectSpec, TypeQuery)]
pFL (ParserState
ps {col :: Int
col=ParserState -> Int
col ParserState
psInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1}) String
rem
pFL ParserState
ps (Char
'\t':String
rem) = ParserState -> String -> [(ObjectSpec, TypeQuery)]
pFL (ParserState
ps {col :: Int
col=ParserState -> Int
col ParserState
psInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
8}) String
rem
pFL ParserState
ps all :: String
all@(Char
'G':Char
't':Char
'k':String
rem)= ParserState -> String -> String -> [(ObjectSpec, TypeQuery)]
pGetObject ParserState
ps String
all String
rem
pFL ParserState
ps all :: String
all@(Char
'G':Char
'd':Char
'k':String
rem)= ParserState -> String -> String -> [(ObjectSpec, TypeQuery)]
pGetObject ParserState
ps String
all String
rem
pFL ParserState
ps all :: String
all@(Char
'G':Char
's':Char
't':String
rem)= ParserState -> String -> String -> [(ObjectSpec, TypeQuery)]
pGetObject ParserState
ps String
all String
rem
pFL ParserState
ps all :: String
all@(Char
'G':Char
'n':Char
'o':Char
'm':Char
'e':String
rem)= ParserState -> String -> String -> [(ObjectSpec, TypeQuery)]
pGetObject ParserState
ps String
all String
rem
pFL ParserState
ps [] = []
pFL ParserState
ps String
all = ParserState -> String -> String -> [(ObjectSpec, TypeQuery)]
pGetObject ParserState
ps String
all String
all
pGetObject :: ParserState -> String -> String -> [(ObjectSpec, TypeQuery)]
pGetObject :: ParserState -> String -> String -> [(ObjectSpec, TypeQuery)]
pGetObject ps :: ParserState
ps@ParserState { onlyTags :: ParserState -> [String]
onlyTags=[String]
tags } String
txt String
txt' =
(if String
readTag String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
tags then (:) (ObjectSpec
spec, TypeQuery
specialQuery) else [(ObjectSpec, TypeQuery)] -> [(ObjectSpec, TypeQuery)]
forall a. a -> a
id) ([(ObjectSpec, TypeQuery)] -> [(ObjectSpec, TypeQuery)])
-> [(ObjectSpec, TypeQuery)] -> [(ObjectSpec, TypeQuery)]
forall a b. (a -> b) -> a -> b
$
ParserState -> String -> [(ObjectSpec, TypeQuery)]
pFreshLine (ParserState
ps { hierObjs :: ObjectSpec
hierObjs=ObjectSpec
spec}) ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Char
'\n') String
rem''')
where
isBlank :: Char -> Bool
isBlank Char
c = Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ' Bool -> Bool -> Bool
|| Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\t'
isAlphaNum_ :: Char -> Bool
isAlphaNum_ Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'_'
isTagName :: Char -> Bool
isTagName Char
c = Char -> Bool
isAlphaNum_ Char
c Bool -> Bool -> Bool
|| Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'-' Bool -> Bool -> Bool
|| Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.'
(String
origCName,String
rem) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isAlphaNum String
txt
(String
origHsName,String
_) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isAlphaNum String
txt'
(Bool
eqInst,String
rem') =
let r :: String
r = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isBlank String
rem in
if String
"noEq" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
r then (Bool
True, Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
4 String
r) else (Bool
False, String
r)
(Bool
defDestr,String
rem'') =
let r :: String
r = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isBlank String
rem' in
if String
"noDestr" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
r then (Bool
True, Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
7 String
r) else (Bool
False, String
r)
(String
name,TypeQuery
specialQuery,String
rem''') = case ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isBlank String
rem'') of
(Char
'a':Char
's':String
r) ->
let (String
tyName,String
r') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isAlphaNum_ ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isBlank String
r) in
case ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isBlank String
r') of
(Char
',':String
r) ->
let (String
tyQuery,String
r') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isAlphaNum_ ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isBlank String
r) in
(String
tyName, (String
tyName, String -> Maybe String -> Bool -> Bool -> TypeInfo
TypeInfo String
origCName (String -> Maybe String
forall a. a -> Maybe a
Just String
tyQuery) Bool
eqInst Bool
defDestr), String
r')
String
r -> (String
tyName, (String
tyName, String -> Maybe String -> Bool -> Bool -> TypeInfo
TypeInfo String
origCName Maybe String
forall a. Maybe a
Nothing Bool
eqInst Bool
defDestr), String
r)
String
r -> (String
origHsName, (String
origHsName, String -> Maybe String -> Bool -> Bool -> TypeInfo
TypeInfo String
origCName Maybe String
forall a. Maybe a
Nothing Bool
eqInst Bool
defDestr), String
r)
parents :: ObjectSpec
parents = ((Int, String) -> Bool) -> ObjectSpec -> ObjectSpec
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\(Int
c,String
_) -> Int
cInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=ParserState -> Int
col ParserState
ps) (ParserState -> ObjectSpec
hierObjs ParserState
ps)
spec :: ObjectSpec
spec = (ParserState -> Int
col ParserState
ps,String
name)(Int, String) -> ObjectSpec -> ObjectSpec
forall a. a -> [a] -> [a]
:ObjectSpec
parents
(String
readTag, String
rem'''') = case ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isBlank String
rem''') of
(Char
'i':Char
'f':String
r) -> (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isTagName ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isBlank String
r)
String
r -> (String
"default",String
r)
ss :: String -> String -> String
ss = String -> String -> String
showString
sc :: Char -> String -> String
sc = Char -> String -> String
showChar
indent :: Int -> ShowS
indent :: Int -> String -> String
indent Int
c = String -> String -> String
ss (String
"\n"String -> String -> String
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
' ')
typeGen :: [String] -> IO String
typeGen :: [String] -> IO String
typeGen [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 rem :: [String]
rem = [String]
args
let tags :: [String]
tags = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
6) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"--tag=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
rem)
let lib :: String
lib = case (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
6) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"--lib=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
rem) of
[] -> String
"gtk"
(String
lib:[String]
_) -> String
lib
let prefix :: String
prefix = case (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
9) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"--prefix=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
rem) of
[] -> String
"gtk"
(String
prefix:[String]
_) -> String
prefix
let modName :: String
modName = case (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
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]
rem) of
[] -> String
"Hierarchy"
(String
modName:[String]
_) -> String
modName
where bareFName :: String -> String
bareFName = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isAlphaNum (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isAlpha (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> String
forall a. [a] -> [a]
reverse
let extraNames :: [String]
extraNames = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
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]
rem)
let rootObject :: String
rootObject = case (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
7) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"--root=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
rem) of
[] -> String
"GObject"
(String
rootObject:[String]
_) -> String
rootObject
let forwardNames :: [String]
forwardNames = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
10) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"--forward=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
rem)
let destrFun :: String
destrFun = case (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
13) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"--destructor=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
rem) of
[] -> String
"objectUnref"
(String
destrFun:[String]
_) -> String
destrFun
String
hierFile <- case (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
12) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"--hierarchy=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
rem) of
[] -> String -> IO String
getDataFileName String
"hierarchyGen/hierarchy.list"
(String
hierFile:[String]
_) -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
hierFile
String
hierarchy <- String -> IO String
readFile String
hierFile
String
templateFile <- String -> IO String
getDataFileName String
"hierarchyGen/Hierarchy.chs.template"
String
template <- String -> IO String
readFile String
templateFile
let ([ObjectSpec]
objs', [TypeQuery]
specialQueries) = [(ObjectSpec, TypeQuery)] -> ([ObjectSpec], [TypeQuery])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ObjectSpec, TypeQuery)] -> ([ObjectSpec], [TypeQuery]))
-> [(ObjectSpec, TypeQuery)] -> ([ObjectSpec], [TypeQuery])
forall a b. (a -> b) -> a -> b
$
ParserState -> String -> [(ObjectSpec, TypeQuery)]
pFreshLine ([String] -> ParserState
freshParserState [String]
tags) String
hierarchy
objs :: [[String]]
objs = (ObjectSpec -> [String]) -> [ObjectSpec] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, String) -> String) -> ObjectSpec -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, String) -> String
forall a b. (a, b) -> b
snd) [ObjectSpec]
objs'
let showImport :: String -> String -> String
showImport (Char
'*':String
m ) = String -> String -> String
ss String
"{#import " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
m (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"#}" (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
indent Int
0
showImport String
m = String -> String -> String
ss String
"import " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
ss String
m (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
indent Int
0
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 -> String -> String) -> String -> String
templateSubstitute String
template (\String
var ->
case String
var of
String
"MODULE_NAME" -> String -> String -> String
ss String
modName
String
"MODULE_EXPORTS" -> String -> [String] -> [[String]] -> String -> String
generateExports String
rootObject ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) Char
'*')) [String]
forwardNames) [[String]]
objs
String
"MODULE_IMPORTS" -> ((String -> String) -> (String -> String) -> String -> String)
-> (String -> String) -> [String -> String] -> String -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) String -> String
forall a. a -> a
id ((String -> String -> String) -> [String] -> [String -> String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String -> String
showImport ([String]
extraNames[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String]
forwardNames))
String
"CONTEXT_LIB" -> String -> String -> String
ss String
lib
String
"CONTEXT_PREFIX" -> String -> String -> String
ss String
prefix
String
"DECLARATIONS" -> String
-> String
-> String
-> [[String]]
-> [TypeQuery]
-> String
-> String
generateDeclarations String
rootObject String
destrFun String
prefix [[String]]
objs [TypeQuery]
specialQueries
String
"ROOTOBJECT" -> String -> String -> String
ss String
rootObject
String
_ -> String -> String -> String
ss String
""
) String
""
usage :: IO b
usage = do
Handle -> String -> IO ()
hPutStr Handle
stderr String
"\nProgram to generate Gtk's object hierarchy in Haskell. Usage:\n\
\TypeGenerator {--tag=<tag>} [--lib=<lib>] [--prefix=<prefix>]\n\
\ [--modname=<modName>] {--import=<*><importName>}\n\
\ {--forward=<*><fwdName>} [--destructor=<destrName>]\n\
\ [--hierarchy=<hierName>]\n\
\where\n\
\ <tag> generate entries that have the tag <tag>\n\
\ specify `default' for types without tags\n\
\ <lib> set the lib to use in the c2hs {#context #}\n\
\ declaration (the default is \"gtk\")\n\
\ <prefix> set the prefix to use in the c2hs {#context #}\n\
\ declaration (the default is \"gtk\")\n\
\ <modName> specify module name if it does not match the\n\
\ file name, eg a hierarchical module name\n\
\ <importName> additionally import this module without\n\
\ re-exporting it\n\
\ <fwdName> specify a number of modules that are imported\n\
\ <*> use an asterix as prefix if the import should\n\
\ be a .chs import statement\n\
\ as well as exported from the generated module\n\
\ <destrName> specify a non-standard C function pointer that\n\
\ is called to destroy the objects\n\
\ <hierName> the name of the file containing the hierarchy list,\n\
\ defaults to the built-in list\n\
\\n\
\The resulting Haskell module is written to the standard output.\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
generateExports :: String -> [String] -> [[String]] -> ShowS
generateExports :: String -> [String] -> [[String]] -> String -> String
generateExports String
rootObject [String]
forwardNames [[String]]
objs =
Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((String -> String) -> (String -> String) -> String -> String)
-> (String -> String) -> [String -> String] -> String -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\String -> String
s1 String -> String
s2 -> String -> String
s1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
","(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> String -> String
indent Int
1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"module "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String
s2) String -> String
forall a. a -> a
id
((String -> String -> String) -> [String] -> [String -> String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String -> String
ss [String]
forwardNames)(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((String -> String) -> (String -> String) -> String -> String)
-> (String -> String) -> [String -> String] -> String -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\String -> String
s1 String -> String
s2 -> String -> String
s1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
","(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String
s2) String -> String
forall a. a -> a
id
[ Int -> String -> String
indent Int
1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
n(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"("(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
n(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"), "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
n(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"Class,"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"to"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
n(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
", "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"mk"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
n(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
", un"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
n(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> String -> String
sc Char
','(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"castTo"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
n(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
", gType"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
n
| (String
n:[String]
_) <- [[String]]
objs
, String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
rootObject ]
generateDeclarations :: String -> String -> String -> [[String]] -> TypeTable -> ShowS
generateDeclarations :: String
-> String
-> String
-> [[String]]
-> [TypeQuery]
-> String
-> String
generateDeclarations String
rootObject String
destr String
prefix [[String]]
objs [TypeQuery]
typeTable =
((String -> String) -> (String -> String) -> String -> String)
-> (String -> String) -> [String -> String] -> String -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) String -> String
forall a. a -> a
id
[ String
-> String -> String -> [TypeQuery] -> [String] -> String -> String
makeClass String
rootObject String
destr String
prefix [TypeQuery]
typeTable [String]
obj
(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String -> String
makeUpcast String
rootObject [String]
obj
(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TypeQuery] -> [String] -> String -> String
makeGType [TypeQuery]
typeTable [String]
obj
| [String]
obj <- [[String]]
objs ]
makeUpcast :: String -> [String] -> ShowS
makeUpcast :: String -> [String] -> String -> String
makeUpcast String
rootObject [String
obj] = String -> String
forall a. a -> a
id
makeUpcast String
rootObject (String
obj:String
_:[String]
_) =
Int -> String -> String
indent Int
0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"castTo"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
obj(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
" :: "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
rootObject(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"Class obj => obj -> "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
obj(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"castTo"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
obj(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
" = castTo gType"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
obj(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
" \""(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
obj(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"\""(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
0
makeGType :: TypeTable -> [String] -> ShowS
makeGType :: [TypeQuery] -> [String] -> String -> String
makeGType [TypeQuery]
table [String
obj] = String -> String
forall a. a -> a
id
makeGType [TypeQuery]
table (String
obj:String
_:[String]
_) =
Int -> String -> String
indent Int
0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"gType"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
obj(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
" :: GType"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"gType"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
obj(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
" ="(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"{# call fun unsafe "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> String -> String
ss (case String -> [TypeQuery] -> Maybe TypeInfo
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
obj [TypeQuery]
table of
(Just TypeInfo { tiAlternateName :: TypeInfo -> Maybe String
tiAlternateName = Just String
get_type_func }) ->
String
get_type_func
(Just TypeInfo { tiQueryFunction :: TypeInfo -> String
tiQueryFunction = String
cname}) ->
String -> String
forall a. [a] -> [a]
tail (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Bool -> String -> String
c2u Bool
True String
cnameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"_get_type")(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> String -> String
ss String
" #}"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
0
where
c2u :: Bool -> String -> String
c2u :: Bool -> String -> String
c2u Bool
True (Char
x:String
xs) | Char -> Bool
isUpper Char
x = Char
'_'Char -> String -> String
forall a. a -> [a] -> [a]
:Char -> Char
toLower Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:Bool -> String -> String
c2u Bool
False String
xs
c2u Bool
False (Char
x:String
xs) | Char -> Bool
isUpper Char
x = Char -> Char
toLower Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:Bool -> String -> String
c2u Bool
True String
xs
c2u Bool
_ (Char
x:String
xs) | Bool
otherwise = Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:Bool -> String -> String
c2u Bool
True String
xs
c2u Bool
_ [] = []
makeOrd :: (String -> String -> String) -> [String] -> String -> String
makeOrd String -> String -> String
fill [] = String -> String
forall a. a -> a
id
makeOrd String -> String -> String
fill (String
obj:[String]
preds) = Int -> String -> String
indent Int
1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"compare "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
obj(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"Tag "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> String -> String
fill String
obj(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
obj(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"Tag"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
fill String
obj(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> String -> String
ss String
" = EQ"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [String] -> String -> String
makeGT String
obj [String]
preds
where
makeGT :: String -> [String] -> String -> String
makeGT String
obj [] = String -> String
forall a. a -> a
id
makeGT String
obj (String
pr:[String]
eds) = Int -> String -> String
indent Int
1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"compare "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
obj(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"Tag "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> String -> String
fill String
obj(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
pr(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"Tag"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
fill String
pr(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> String -> String
ss String
" = GT"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [String] -> String -> String
makeGT String
obj [String]
eds
makeClass :: String -> String -> String -> TypeTable -> [String] -> ShowS
makeClass :: String
-> String -> String -> [TypeQuery] -> [String] -> String -> String
makeClass String
rootObject String
destr String
prefix [TypeQuery]
table (String
name:[]) = String -> String
forall a. a -> a
id
makeClass String
rootObject String
destr String
prefix [TypeQuery]
table (String
name:[String]
parents) =
Int -> String -> String
indent Int
0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"-- "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
75Int -> Int -> Int
forall a. Num a => a -> a -> a
-String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
name) Char
'*')(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> String -> String
sc Char
' '(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
name(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"{#pointer *"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(case String -> [TypeQuery] -> Maybe TypeInfo
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [TypeQuery]
table of
(Just TypeInfo { tiQueryFunction :: TypeInfo -> String
tiQueryFunction = String
cname }) -> String -> String -> String
ss String
cname(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
" as "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
name
)(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> String -> String
ss String
" foreign newtype #}"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(case String -> [TypeQuery] -> Maybe TypeInfo
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [TypeQuery]
table of
(Just (TypeInfo { tiNoEqualInst :: TypeInfo -> Bool
tiNoEqualInst = Bool
False })) -> String -> String -> String
ss String
" deriving (Eq,Ord)"
Maybe TypeInfo
_ -> String -> String
forall a. a -> a
id
)(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"mk"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
name(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
" = ("(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
name(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
", "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(case String -> [TypeQuery] -> Maybe TypeInfo
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [TypeQuery]
table of Just TypeInfo { tiDefaultDestr :: TypeInfo -> Bool
tiDefaultDestr = Bool
False } -> String -> String -> String
ss String
destr
Just TypeInfo { tiDefaultDestr :: TypeInfo -> Bool
tiDefaultDestr = Bool
True } -> String -> String -> String
ss String
"objectUnref")(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
")"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"un"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
name(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
" ("(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
name(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
" o) = o"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"class "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss ([String] -> String
forall a. [a] -> a
head [String]
parents)(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"Class o => "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
name(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"Class o"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"to"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
name(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
" :: "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
name(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"Class o => o -> "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
name(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"to"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
name(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
" = unsafeCast"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
rootObject(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
" . to"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
rootObject(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> [String] -> String -> String
makeInstance String
name (String
nameString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String] -> [String]
forall a. [a] -> [a]
init [String]
parents)(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> String -> String -> String
makeRootInstance String
rootObject String
name(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
0
makeInstance :: String -> [String] -> ShowS
makeInstance :: String -> [String] -> String -> String
makeInstance String
name [] = String -> String
forall a. a -> a
id
makeInstance String
name (String
par:[String]
ents) =
Int -> String -> String
indent Int
0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"instance "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
par(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"Class "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
name(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> [String] -> String -> String
makeInstance String
name [String]
ents
makeRootInstance :: String -> String -> ShowS
makeRootInstance :: String -> String -> String -> String
makeRootInstance String
rootObject String
name =
Int -> String -> String
indent Int
0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"instance "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
rootObject(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"Class "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
name(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
" where"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"to"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
rootObject(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
" = "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
rootObject(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ssString
" . castForeignPtr . un"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
name(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent Int
1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
"unsafeCast"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
rootObject(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
" = "(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
name(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
" . castForeignPtr . un"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
rootObject
templateSubstitute :: String -> (String -> ShowS) -> ShowS
templateSubstitute :: String -> (String -> String -> String) -> String -> String
templateSubstitute String
template String -> String -> String
varSubst = String -> String -> String
doSubst String
template
where doSubst :: String -> String -> String
doSubst [] = String -> String
forall a. a -> a
id
doSubst (Char
'\\':Char
'@':String
cs) = Char -> String -> String
sc Char
'@' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
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 -> String -> String
varSubst String
var (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
doSubst String
cs'
doSubst (Char
c:String
cs) = Char -> String -> String
sc Char
c (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
doSubst String
cs