<commit_before>-- TypeGenerator.hs
-- Takes a hierarchical list of all objects in GTK+ and produces
-- Haskell class that reflect this hierarchy.
module Main(main) where

import Char(showLitChar,isAlphaNum, isSpace, toLower, isUpper)
import List(nub)
import Maybe(catMaybes, fromMaybe)
import System(getArgs, exitWith, ExitCode(..))

type ObjectSpec = [(Int,String)]

-- This is a mapping from a type name to the GTK blah_get_type function.
type TypeQuery  = Maybe (String, String)

data ParserState = ParserState {
  line		:: Int,
  col	        :: Int,
  hierObjs	:: ObjectSpec
  }

freshParserState = ParserState 1 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 ps ('#':rem)		= pFreshLine ps (dropWhile ((/=) '\n') rem)
pFreshLine ps ('\n':rem)	= pFreshLine (ps {line = line ps+1, col=1}) rem
pFreshLine ps (' ':rem)		= pFreshLine (ps {col=col ps+1}) rem
pFreshLine ps ('\t':rem)	= pFreshLine (ps {col=col ps+8}) rem
pFreshLine ps ('G':'t':'k':rem) = pGetObject ps rem
pFreshLine ps []		= []
pFreshLine ps all		= pGetObject ps all

pGetObject :: ParserState -> String -> [(ObjectSpec, TypeQuery)]
pGetObject ps txt = (spec, specialQuery):
  pFreshLine (ps { hierObjs=spec}) (dropWhile ((/=) '\n') rem')
  where
    isBlank     c = c==' ' || c=='\t'
    isAlphaNum_ c = isAlphaNum c || c=='_'
    (name,rem) = span isAlphaNum txt
    (specialQuery,rem') = case (dropWhile isBlank rem) of
      ('q':'u':'e':'r':'y':r) ->
        let (tyQuery,r') = span isAlphaNum_ (dropWhile isBlank r) in
          (Just (name, tyQuery), r')
      r -> (Nothing, r)
    parents = dropWhile (\(c,_) -> c>=col ps) (hierObjs ps)
    spec = (col ps,name):parents

    


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

ss = showString
sc = showChar

indent :: Int -> ShowS
indent c = ss ("\n"++replicate (2*c) ' ')

-------------------------------------------------------------------------------
-- Tables of code fragments
-------------------------------------------------------------------------------


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


main = do
  args <- getArgs
  if (length args/=2) then usage else do
    let [hierFile, goalFile] = args
    content <- readFile hierFile
    let (objs, specialQueries) = unzip $ pFreshLine freshParserState content
    writeFile goalFile $
      generate (map (map snd) objs) (catMaybes specialQueries) ""


usage = do
 putStr "\nProgram to generate Gtk's object hierarchy in Haskell. Usage:\n\
	\TypeGenerator <hierFile> <outFile>\n\
	\where\n\
	\  <hierFile>	   a list of all possible objects, the hierarchy is\n\
	\		   taken from the indentation\n\
	\  <outFile>	   is the name and path of the output file\n"
 exitWith $ ExitFailure 1



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

generate :: [[String]] -> [(String, String)] -> ShowS
generate objs typeTable = 
  let fillCol str = ss $ replicate 
		    (maximum (map (length.head) objs)-length str) ' ' 
  in
           ss "-- -*-haskell-*-".
  indent 0.ss "-- ******************** automatically generated file - do not edit **********".
  indent 0.ss "--  Object hierarchy for the GIMP Toolkit (GTK) Binding for Haskell".
  indent 0.ss "--".
  indent 0.ss "--  Author : <NAME>".
  indent 0.ss "--".
  indent 0.ss "--  Copyright (c) 2001 <NAME>".
  indent 0.ss "--".
  indent 0.ss "--  This file is free software; you can redistribute it and/or modify".
  indent 0.ss "--  it under the terms of the GNU General Public License as published by".
  indent 0.ss "--  the Free Software Foundation; either version 2 of the License, or".
  indent 0.ss "--  (at your option) any later version.".
  indent 0.ss "--".
  indent 0.ss "--  This file is distributed in the hope that it will be useful,".
  indent 0.ss "--  but WITHOUT ANY WARRANTY; without even the implied warranty of".
  indent 0.ss "--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the".
  indent 0.ss "--  GNU General Public License for more details.".
  indent 0.ss "--".
  indent 0.ss "--- DESCRIPTION ---------------------------------------------------------------".
  indent 0.ss "--".
  indent 0.ss "--  * This file reflects the Gtk object hierarchy in terms of Haskell classes.".
  indent 0.ss "--".
  indent 0.ss "--- DOCU ----------------------------------------------------------------------".
  indent 0.ss "--".
  indent 0.ss "--".
  indent 0.ss "--- TODO ----------------------------------------------------------------------".
  indent 0.ss "--".
  indent 0.ss "--".
  indent 0.ss "module Hierarchy(".
--  indent 1.ss "ObjectTag(..)".
  foldl (.) id (map (\(n:_) -> ss ", ".indent 1.ss n.ss ", ".ss n.
		ss "Class(..),".indent 1.ss "mk".ss n.ss ", un".ss n.sc ','.
		indent 1.ss "castTo".ss n) objs).
  indent 1.ss ") where".<commit_msg>[project @ 2002-10-01 15:00:34 by as49]<commit_after>-- TypeGenerator.hs
-- Takes a hierarchical list of all objects in GTK+ and produces
-- Haskell class that reflect this hierarchy.
module Main(main) where

import Char(showLitChar,isAlphaNum, isSpace, toLower, isUpper)
import List(nub)
import Maybe(catMaybes, fromMaybe)
import System(getArgs, exitWith, ExitCode(..))

type ObjectSpec = [(Int,String)]

-- This is a mapping from a type name to the GTK blah_get_type function.
type TypeQuery  = Maybe (String, String)

data ParserState = ParserState {
  line		:: Int,
  col	        :: Int,
  hierObjs	:: ObjectSpec
  }

freshParserState = ParserState 1 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 ps ('#':rem)		= pFreshLine ps (dropWhile ((/=) '\n') rem)
pFreshLine ps ('\n':rem)	= pFreshLine (ps {line = line ps+1, col=1}) rem
pFreshLine ps (' ':rem)		= pFreshLine (ps {col=col ps+1}) rem
pFreshLine ps ('\t':rem)	= pFreshLine (ps {col=col ps+8}) rem
pFreshLine ps ('G':'t':'k':rem) = pGetObject ps rem
pFreshLine ps []		= []
pFreshLine ps all		= pGetObject ps all

pGetObject :: ParserState -> String -> [(ObjectSpec, TypeQuery)]
pGetObject ps txt = (spec, specialQuery):
  pFreshLine (ps { hierObjs=spec}) (dropWhile ((/=) '\n') rem')
  where
    isBlank     c = c==' ' || c=='\t'
    isAlphaNum_ c = isAlphaNum c || c=='_'
    (name,rem) = span isAlphaNum txt
    (specialQuery,rem') = case (dropWhile isBlank rem) of
      ('q':'u':'e':'r':'y':r) ->
        let (tyQuery,r') = span isAlphaNum_ (dropWhile isBlank r) in
          (Just (name, tyQuery), r')
      r -> (Nothing, r)
    parents = dropWhile (\(c,_) -> c>=col ps) (hierObjs ps)
    spec = (col ps,name):parents

    


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

ss = showString
sc = showChar

indent :: Int -> ShowS
indent c = ss ("\n"++replicate (2*c) ' ')

-------------------------------------------------------------------------------
-- Tables of code fragments
-------------------------------------------------------------------------------


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


main = do
  args <- getArgs
  if (length args/=2) then usage else do
    let [hierFile, goalFile] = args
    content <- readFile hierFile
    let (objs, specialQueries) = unzip $ pFreshLine freshParserState content
    writeFile goalFile $
      generate (map (map snd) objs) (catMaybes specialQueries) ""


usage = do
 putStr "\nProgram to generate Gtk's object hierarchy in Haskell. Usage:\n\
	\TypeGenerator <hierFile> <outFile>\n\
	\where\n\
	\  <hierFile>	   a list of all possible objects, the hierarchy is\n\
	\		   taken from the indentation\n\
	\  <outFile>	   is the name and path of the output file\n"
 exitWith $ ExitFailure 1



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

generate :: [[String]] -> [(String, String)] -> ShowS
generate objs typeTable = 
  let fillCol str = ss $ replicate 
		    (maximum (map (length.head) objs)-length str) ' ' 
  in
           ss "-- -*-haskell-*-".
  indent 0.ss "-- ******************** automatically generated file - do not edit **********".
  indent 0.ss "--  Object hierarchy for the GIMP Toolkit (GTK) Binding for Haskell".
  indent 0.ss "--".
  indent 0.ss "--  Author : <NAME>".
  indent 0.ss "--".
  indent 0.ss "--  Copyright (c) 2001 <NAME>".
  indent 0.ss "--".
  indent 0.ss "--  This file is free software; you can redistribute it and/or modify".
  indent 0.ss "--  it under the terms of the GNU General Public License as published by".
  indent 0.ss "--  the Free Software Foundation; either version 2 of the License, or".
  indent 0.ss "--  (at your option) any later version.".
  indent 0.ss "--".
  indent 0.ss "--  This file is distributed in the hope that it will be useful,".
  indent 0.ss "--  but WITHOUT ANY WARRANTY; without even the implied warranty of".
  indent 0.ss "--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the".
  indent 0.ss "--  GNU General Public License for more details.".
  indent 0.ss "--".
  indent 0.ss "--- @description@ -------------------------------------------------------------".
  indent 0.ss "--".
  indent 0.ss "--  * This file reflects the Gtk object hierarchy in terms of Haskell classes.".
  indent 0.ss "--".
  indent 0.ss "--- @documentation@ -----------------------------------------------------------".
  indent 0.ss "--".
  indent 0.ss "--".
  indent 0.ss "--- @todo@ --------------------------------------------------------------------".
  indent 0.ss "--".
  indent 0.ss "--".
  indent 0.ss "module Hierarchy(".
--  indent 1.ss "ObjectTag(..)".
  foldl (.) id (map (\(n:_) -> ss ", ".indent 1.ss n.ss ", ".ss n.
		ss "Class(..),".indent 1.ss "mk".ss n.ss ", un".ss n.sc ','.
		indent 1.ss "castTo".ss n) objs).
  indent 1.ss ") where".
{'fraction_non_alphanumeric': 0.2852588147036759, 'fraction_numerical': 0.010315078769692423, 'mean_word_length': 1.6938620863854508, 'pattern_counts': {'":': 0, '<': 19, '<?xml version=': 0, '>': 39, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7460679', 'n_tokens_mistral': 3205, 'n_tokens_neox': 2987, 'n_words': 1069}