[hoc-cvs] hoc/InterfaceGenerator Headers.hs,1.4,1.5

[Wolfgang T. <wth...@us...>]

Update of /cvsroot/hoc/hoc/InterfaceGenerator
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11762/InterfaceGenerator

Modified Files:
	Headers.hs 
Log Message:
Deal with strange characters in module names (required for GNUstep)


Index: Headers.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/InterfaceGenerator/Headers.hs,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- Headers.hs	31 Mar 2005 20:50:32 -0000	1.4
+++ Headers.hs	18 Apr 2005 01:37:22 -0000	1.5
@@ -4,6 +4,7 @@
 import SyntaxTree(Declaration)
 
 import Control.Exception(evaluate)
+import Data.Char(isAlphaNum, toUpper)
 import Data.List(isPrefixOf,isSuffixOf,partition)
 import Data.Maybe(mapMaybe)
 import System.Directory(getDirectoryContents)
@@ -32,15 +33,17 @@
 
 headersIn dirName prefix = do
     files <- getDirectoryContents dirName
-    return [ (fn, dirName ++ fn, prefix ++ "." ++ takeWhile (/= '.') fn)
+    return [ (fn, dirName ++ fn, haskellizeModuleName $
+                                 prefix ++ "." ++ takeWhile (/= '.') fn)
            | fn <- files, ".h" `isSuffixOf` fn {- , fn /= (prefix ++ ".h") -} ]
 
 headersForFramework framework =
     if System.Info.os == "darwin"
         then headersIn ("/System/Library/Frameworks/" ++ framework ++ ".framework/Headers/") framework
-        else headersIn ("/usr/GNUstep/System/Library/Headers/" ++ framework ++ "/") framework
+        else headersIn ("/usr/lib/GNUstep/System/Library/Headers/" ++ framework ++ "/") framework
 
-translateObjCImport imp = map slashToDot $ takeWhile (/= '.') $ imp
+translateObjCImport imp = haskellizeModuleName $
+                          map slashToDot $ takeWhile (/= '.') $ imp
     where
         slashToDot '/' = '.'
         slashToDot c = c
@@ -71,3 +74,9 @@
         -- names | any ("Foundation." `isPrefixOf`) names' = "Foundation.Foundation" : names'
         --     | otherwise = names'
 
+
+haskellizeModuleName = firstUpper . concatMap translateChar
+    where firstUpper [] = []
+          firstUpper (x:xs) = toUpper x : xs
+          translateChar c | isAlphaNum c || c `elem` "/." = [c]
+                          | otherwise = []