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 1 1 []
pFreshLine :: ParserState -> String -> [(ObjectSpec, TypeQuery)]
pFreshLine :: ParserState -> String -> [(ObjectSpec, TypeQuery)]
pFreshLine ps :: ParserState
ps input :: String
input = ParserState -> String -> [(ObjectSpec, TypeQuery)]
pFL ParserState
ps String
input
where
pFL :: ParserState -> String -> [(ObjectSpec, TypeQuery)]
pFL ps :: ParserState
ps ('#':rem :: 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
(/=) '\n') String
rem)
pFL ps :: ParserState
ps ('\n':rem :: 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
+1, col :: Int
col=1}) String
rem
pFL ps :: ParserState
ps (' ':rem :: 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
+1}) String
rem
pFL ps :: ParserState
ps ('\t':rem :: 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
+8}) String
rem
pFL ps :: ParserState
ps all :: String
all@('G':'t':'k':rem :: String
rem)= ParserState -> String -> String -> [(ObjectSpec, TypeQuery)]
pGetObject ParserState
ps String
all String
rem
pFL ps :: ParserState
ps all :: String
all@('G':'d':'k':rem :: String
rem)= ParserState -> String -> String -> [(ObjectSpec, TypeQuery)]
pGetObject ParserState
ps String
all String
rem
pFL ps :: ParserState
ps all :: String
all@('G':'s':'t':rem :: String
rem)= ParserState -> String -> String -> [(ObjectSpec, TypeQuery)]
pGetObject ParserState
ps String
all String
rem
pFL ps :: ParserState
ps all :: String
all@('G':'n':'o':'m':'e':rem :: String
rem)= ParserState -> String -> String -> [(ObjectSpec, TypeQuery)]
pGetObject ParserState
ps String
all String
rem
pFL ps :: ParserState
ps [] = []
pFL ps :: ParserState
ps all :: 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 } txt :: String
txt 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
(/=) '\n') String
rem''')
where
isBlank :: Char -> Bool
isBlank c :: Char
c = Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==' ' Bool -> Bool -> Bool
|| Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='\t'
isAlphaNum_ :: Char -> Bool
isAlphaNum_ c :: Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='_'
isTagName :: Char -> Bool
isTagName c :: Char
c = Char -> Bool
isAlphaNum_ Char
c Bool -> Bool -> Bool
|| Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='-' Bool -> Bool -> Bool
|| Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='.'
(origCName :: String
origCName,rem :: String
rem) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isAlphaNum String
txt
(origHsName :: String
origHsName,_) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isAlphaNum String
txt'
(eqInst :: Bool
eqInst,rem' :: String
rem') =
let r :: String
r = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isBlank String
rem in
if "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 4 String
r) else (Bool
False, String
r)
(defDestr :: Bool
defDestr,rem'' :: String
rem'') =
let r :: String
r = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isBlank String
rem' in
if "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 7 String
r) else (Bool
False, String
r)
(name :: String
name,specialQuery :: TypeQuery
specialQuery,rem''' :: String
rem''') = case ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isBlank String
rem'') of
('a':'s':r :: String
r) ->
let (tyName :: String
tyName,r' :: 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
(',':r :: String
r) ->
let (tyQuery :: String
tyQuery,r' :: 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')
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)
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 (\(c :: Int
c,_) -> 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
(readTag :: String
readTag, rem'''' :: String
rem'''') = case ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isBlank String
rem''') of
('i':'f':r :: 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)
r :: String
r -> ("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 c :: Int
c = String -> String -> String
ss ("\n"String -> String -> String
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) ' ')
typeGen :: [String] -> IO String
typeGen :: [String] -> IO String
typeGen 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 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 6) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ("--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 6) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ("--lib=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
rem) of
[] -> "gtk"
(lib :: String
lib:_) -> 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 9) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ("--prefix=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
rem) of
[] -> "gtk"
(prefix :: String
prefix:_) -> 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 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]
rem) of
[] -> "Hierarchy"
(modName :: String
modName:_) -> 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 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 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]
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 7) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ("--root=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
rem) of
[] -> "GObject"
(rootObject :: String
rootObject:_) -> 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 10) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ("--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 13) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ("--destructor=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
rem) of
[] -> "objectUnref"
(destrFun :: String
destrFun:_) -> 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 12) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ("--hierarchy=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
rem) of
[] -> String -> IO String
getDataFileName "hierarchyGen/hierarchy.list"
(hierFile :: String
hierFile:_) -> 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 "hierarchyGen/Hierarchy.chs.template"
String
template <- String -> IO String
readFile String
templateFile
let (objs' :: [ObjectSpec]
objs', specialQueries :: [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 ('*':m :: String
m ) = String -> String -> String
ss "{#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
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
indent 0
showImport m :: String
m = String -> String -> String
ss "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 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 (\var :: String
var ->
case String
var of
"MODULE_NAME" -> String -> String -> String
ss String
modName
"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
(==) '*')) [String]
forwardNames) [[String]]
objs
"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))
"CONTEXT_LIB" -> String -> String -> String
ss String
lib
"CONTEXT_PREFIX" -> String -> String -> String
ss String
prefix
"DECLARATIONS" -> String
-> String
-> String
-> [[String]]
-> [TypeQuery]
-> String
-> String
generateDeclarations String
rootObject String
destrFun String
prefix [[String]]
objs [TypeQuery]
specialQueries
"ROOTOBJECT" -> String -> String -> String
ss String
rootObject
_ -> String -> String -> String
ss ""
) ""
usage :: IO b
usage = do
Handle -> String -> IO ()
hPutStr Handle
stderr "\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 1
generateExports :: String -> [String] -> [[String]] -> ShowS
generateExports :: String -> [String] -> [[String]] -> String -> String
generateExports rootObject :: String
rootObject forwardNames :: [String]
forwardNames objs :: [[String]]
objs =
Int -> String -> String
forall a. Int -> [a] -> [a]
drop 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 (\s1 :: String -> String
s1 s2 :: 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
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> String -> String
indent 1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "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 (\s1 :: String -> String
s1 s2 :: 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
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String
s2) String -> String
forall a. a -> a
id
[ Int -> String -> String
indent 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
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
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 "Class,"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent 1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "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
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent 1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "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 ", 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 ','(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent 1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "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 ", gType"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss String
n
| (n :: String
n:_) <- [[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 rootObject :: String
rootObject destr :: String
destr prefix :: String
prefix objs :: [[String]]
objs typeTable :: [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 rootObject :: String
rootObject [obj :: String
obj] = String -> String
forall a. a -> a
id
makeUpcast rootObject :: String
rootObject (obj :: String
obj:_:_) =
Int -> String -> String
indent 0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "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
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 "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 0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "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 " = 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
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
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent 0
makeGType :: TypeTable -> [String] -> ShowS
makeGType :: [TypeQuery] -> [String] -> String -> String
makeGType table :: [TypeQuery]
table [obj :: String
obj] = String -> String
forall a. a -> a
id
makeGType table :: [TypeQuery]
table (obj :: String
obj:_:_) =
Int -> String -> String
indent 0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "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 " :: GType"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent 0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "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
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent 1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "{# 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 get_type_func :: 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]
++"_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
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent 0
where
c2u :: Bool -> String -> String
c2u :: Bool -> String -> String
c2u True (x :: Char
x:xs :: String
xs) | Char -> Bool
isUpper Char
x = '_'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 False (x :: Char
x:xs :: 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 _ (x :: Char
x:xs :: String
xs) | Bool
otherwise = Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:Bool -> String -> String
c2u Bool
True String
xs
c2u _ [] = []
makeOrd :: (String -> String -> String) -> [String] -> String -> String
makeOrd fill :: String -> String -> String
fill [] = String -> String
forall a. a -> a
id
makeOrd fill :: String -> String -> String
fill (obj :: String
obj:preds :: [String]
preds) = Int -> String -> String
indent 1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "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 "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 "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 " = 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 obj :: String
obj [] = String -> String
forall a. a -> a
id
makeGT obj :: String
obj (pr :: String
pr:eds :: [String]
eds) = Int -> String -> String
indent 1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "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 "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 "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 " = 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 rootObject :: String
rootObject destr :: String
destr prefix :: String
prefix table :: [TypeQuery]
table (name :: String
name:[]) = String -> String
forall a. a -> a
id
makeClass rootObject :: String
rootObject destr :: String
destr prefix :: String
prefix table :: [TypeQuery]
table (name :: String
name:parents :: [String]
parents) =
Int -> String -> String
indent 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
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (75Int -> Int -> Int
forall a. Num a => a -> a -> a
-String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
name) '*')(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> String -> String
sc ' '(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 0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent 0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "{#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 " 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 " 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 " deriving (Eq,Ord)"
_ -> 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 0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent 0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "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
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
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 "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
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent 0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "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
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 " o) = o"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent 0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent 0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "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 "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 "Class o"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent 0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "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
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 "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 0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "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 " = 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 " . 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 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 0
makeInstance :: String -> [String] -> ShowS
makeInstance :: String -> [String] -> String -> String
makeInstance name :: String
name [] = String -> String
forall a. a -> a
id
makeInstance name :: String
name (par :: String
par:ents :: [String]
ents) =
Int -> String -> String
indent 0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "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 "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 rootObject :: String
rootObject name :: String
name =
Int -> String -> String
indent 0(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "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 "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 " where"(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> String -> String
indent 1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "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
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" . 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 1(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String -> String
ss "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
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 " . 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 template :: String
template varSubst :: String -> String -> String
varSubst = String -> String -> String
doSubst String
template
where doSubst :: String -> String -> String
doSubst [] = String -> String
forall a. a -> a
id
doSubst ('\\':'@':cs :: String
cs) = Char -> String -> String
sc '@' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
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 -> 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 (c :: Char
c:cs :: 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