    -- TypeGen.hs
    -- Takes a hierarchical list of all objects in GTK+ and produces
    -- Haskell class that reflect this hierarchy.
    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)

    -- The current object and its inheritance relationship is defined by all
    -- ancestors and their column position.
    type ObjectSpec = [(Int,String)]

    -- This is a mapping from a type name to a) the type name in Haskell and
    -- b) the info on this type 'TypeInfo'.
    type TypeQuery  = (String, TypeInfo)

    -- The information of on the type.
    data TypeInfo = TypeInfo {
      TypeInfo -> String
    tiQueryFunction :: String, -- the GTK blah_get_type function
      TypeInfo -> Maybe String
    tiAlternateName :: Maybe String,
      TypeInfo -> Bool
    tiNoEqualInst   :: Bool,
      TypeInfo -> Bool
    tiDefaultDestr  :: Bool
      }

    type TypeTable  = [TypeQuery]

    -- A Tag is a string restricting the generation of type entries to
    -- those lines that have the appropriate "if <tag>" at the end.
    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 []

    -- The parser returns a list of ObjectSpec and possibly a special type query
    -- function. Each ObjectSpec describes one object with all its parents.

    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 = line ps+1, col=1}) String
    rem
        pFL ParserState
    ps (Char
    ' ':String
    rem)            = ParserState -> String -> [(ObjectSpec, TypeQuery)]
    pFL (ParserState
    ps {col=col ps+1}) String
    rem
        pFL ParserState
    ps (Char
    '\t':String
    rem)           = ParserState -> String -> [(ObjectSpec, TypeQuery)]
    pFL (ParserState
    ps {col=col ps+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 a. Eq a => a -> [a] -> 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=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
    '.'  --to allow tag 'gtk-2.4'
        (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)

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

    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
    ' ')

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

    typeGen :: [String] -> IO String
    typeGen :: [String] -> IO String
    typeGen [String]
    args = do
      let showHelp :: Bool
    showHelp = Bool -> Bool
    not ([String] -> Bool
    forall a. [a] -> 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 a. [a] -> 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

      -----------------------------------------------------------------------------
      -- Parse command line parameters
      --
      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
      -----------------------------------------------------------------------------
      -- Read in the hierarchy and template files
      --
      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 a. a -> IO a
    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

      -----------------------------------------------------------------------------
      -- Parse the contents of the hierarchy file
      --
      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
      -----------------------------------------------------------------------------
      -- return the result after substituting values into the template file
      --
      String -> IO String
    forall a. a -> IO a
    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 b a. (b -> a -> b) -> b -> [a] -> b
    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

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

    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 b a. (b -> a -> b) -> b -> [a] -> b
    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 b a. (b -> a -> b) -> b -> [a] -> b
    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 b a. (b -> a -> b) -> b -> [a] -> b
    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 -- no casting for root
    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 -- no GType for root
    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. HasCallStack => [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
        -- case to underscore translation: the boolean arg specifies whether
        -- the first uppercase letter X is to be replaced by _x (True) or by x.
        --
        -- translation:     HButtonBox -> hbutton_box
        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 a. [a] -> 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. HasCallStack => [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. HasCallStack => [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