diff --git a/src/CompileClassInfo.hs b/src/CompileClassInfo.hs --- a/src/CompileClassInfo.hs +++ b/src/CompileClassInfo.hs @@ -103,7 +103,8 @@ , "" ] ] - prologue <- getPrologue moduleName "class info" (show defCount ++ " class info definitions.") [] + prologue = getPrologue moduleName "class info" + (show defCount ++ " class info definitions.") [] putStrLn ("generating: " ++ outputFile) writeFileLazy outputFile (unlines (prologue ++ export ++ classDefs ++ downcDefs)) diff --git a/src/CompileClassTypes.hs b/src/CompileClassTypes.hs --- a/src/CompileClassTypes.hs +++ b/src/CompileClassTypes.hs @@ -33,23 +33,18 @@ classCount = length exportsClass export = concat [ ["module " ++ moduleRoot ++ moduleName - , " ( -- * Version" - , " classTypesVersion" - , " -- * Classes" ] + , " ( -- * Classes" ] , exportsClassClasses , [ " ) where" , "" , "import " ++ moduleRoot ++ "WxcObject" - , "" - , "classTypesVersion :: String" - , "classTypesVersion = \"" ++ show time ++ "\"" , "" ] ] - prologue <- getPrologue moduleName "class" - (show classCount ++ " class definitions.") - inputFiles - let output = unlines (prologue ++ export ++ classDecls) + prologue = getPrologue moduleName "class" + (show classCount ++ " class definitions.") + inputFiles + output = unlines (prologue ++ export ++ classDecls) putStrLn ("generating: " ++ outputFile) writeFileLazy outputFile output @@ -63,17 +58,17 @@ exportDefs :: [(ClassName,[String])] -> [String] exportDefs classExports = let classMap = Map.fromListWith (++) classExports - in concatMap exportDef (Map.toAscList classMap) + in concatMap exportDef $ zip [0..] (Map.toAscList classMap) where - exportDef (className,exports) - = [heading 2 className] ++ commaSep exports + exportDef (n, (className,exports)) + = [heading 2 className] ++ (commaSep n) exports - commaSep xs - = map (exportComma++) xs + commaSep n xs + = zipWith (exportComma n) [0..] xs heading i name = exportSpaces ++ "-- " ++ replicate i '*' ++ " " ++ name - exportComma = exportSpaces ++ "," + exportComma n m str = exportSpaces ++ (if n == 0 && m == 0 then " " else ",") ++ str exportSpaces = " " diff --git a/src/CompileClasses.hs b/src/CompileClasses.hs --- a/src/CompileClasses.hs +++ b/src/CompileClasses.hs @@ -66,9 +66,9 @@ let methodCount = m1 + m2 classCount = c1 + c2 - prologue <- getPrologue moduleName "class" - (show methodCount ++ " methods for " ++ show classCount ++ " classes.") - inputFiles + prologue = getPrologue moduleName "class" + (show methodCount ++ " methods for " ++ show classCount ++ " classes.") + inputFiles let output = unlines (prologue ++ export) putStrLn ("generating: " ++ outputFile ++ ".hs") @@ -100,7 +100,6 @@ , "" , "import qualified Data.ByteString as B (ByteString, useAsCStringLen)" , "import qualified Data.ByteString.Lazy as LB (ByteString, length, unpack)" - , "import Foreign.C.Types" , "import System.IO.Unsafe( unsafePerformIO )" , "import " ++ moduleRoot ++ "WxcTypes" , "import " ++ moduleRoot ++ moduleClassTypesName @@ -108,10 +107,10 @@ ] ] - prologue <- getPrologue moduleName "class" - (show methodCount ++ " methods for " ++ show classCount ++ " classes.") - inputFiles - let output = unlines (ghcoptions ++ prologue ++ export ++ marshalDecls) + prologue = getPrologue moduleName "class" + (show methodCount ++ " methods for " ++ show classCount ++ " classes.") + inputFiles + output = unlines (ghcoptions ++ prologue ++ export ++ marshalDecls) putStrLn ("generating: " ++ outputFile ++ ".hs") writeFileLazy (outputFile ++ ".hs") output diff --git a/src/CompileDefs.hs b/src/CompileDefs.hs deleted file mode 100644 --- a/src/CompileDefs.hs +++ /dev/null @@ -1,81 +0,0 @@ ------------------------------------------------------------------------------------------ -{-| Module : CompileDefs - Copyright : (c) Daan Leijen 2003 - License : BSD-style - - Maintainer : wxhaskell-devel@lists.sourceforge.net - Stability : provisional - Portability : portable - - Module that compiles constant definitions to Haskell. --} ------------------------------------------------------------------------------------------ -module CompileDefs( compileDefs ) where - -import Data.List( sortBy, sort ) - -import Types -import HaskellNames -import ParseEiffel( parseEiffel ) - - -{----------------------------------------------------------------------------------------- - Compile ------------------------------------------------------------------------------------------} -compileDefs :: Bool -> String -> String -> FilePath -> [FilePath] -> IO () -compileDefs verbose moduleRoot moduleName outputFile inputFiles - = do defss <- mapM parseEiffel inputFiles - let defs = concat defss - (haskellExports,haskellDefs) = unzip (map toHaskellDef defs) - - defCount = length defs - - export = concat [ ["module " ++ moduleRoot ++ moduleName - , " ( -- * Types" - , " BitFlag" - , " -- * Constants" - ] - , map (exportComma++) haskellExports - , [ " ) where" - , "" - , "-- | A flag can be combined with other flags to a bit mask." - , "type BitFlag = Int" - , "" - ] - ] - prologue <- getPrologue moduleName "constant" - (show defCount ++ " constant definitions.") inputFiles - - putStrLn ("generating: " ++ outputFile) - writeFile outputFile (unlines (prologue ++ export ++ haskellDefs)) - putStrLn ("generated " ++ show defCount ++ " constant definitions") - putStrLn "ok." - -cmpDef def1 def2 - = compare (defName def1) (defName def2) - -exportComma = exportSpaces ++ "," -exportSpaces = " " - - -{----------------------------------------------------------------------------------------- - ------------------------------------------------------------------------------------------} -toHaskellDef :: Def -> (String,String) -toHaskellDef def - = (haskellUnderscoreName (defName def) - ,haskellUnderscoreName (defName def) ++ " :: " ++ haskellDefType def ++ "\n" ++ - haskellUnderscoreName (defName def) ++ " = " ++ haskellDefValue def ++ "\n" - ) - -haskellDefValue def - = showNum (defValue def) - where - showNum x | x >= 0 = show x - | otherwise = "(" ++ show x ++ ")" - - -haskellDefType def - = case defType def of - DefInt -> "Int" - DefMask -> "BitFlag" diff --git a/src/CompileHeader.hs b/src/CompileHeader.hs --- a/src/CompileHeader.hs +++ b/src/CompileHeader.hs @@ -26,6 +26,7 @@ import Classes( isClassName, classNames, classExtends ) import ParseC( parseC ) import DeriveTypes( deriveTypesAll, classifyName, Name(..), Method(..), ClassName, MethodName, PropertyName ) +import IOExtra {----------------------------------------------------------------------------------------- Compile @@ -49,7 +50,7 @@ ) putStrLn ("generating: " ++ outputFile) - writeFile outputFile output + writeFileLazy outputFile output putStrLn ("generated " ++ show methodCount ++ " declarations.") putStrLn ("ok.\n") diff --git a/src/CompileSTC.hs b/src/CompileSTC.hs --- a/src/CompileSTC.hs +++ b/src/CompileSTC.hs @@ -19,6 +19,7 @@ import Control.Monad import Types +import IOExtra compileSTC :: Bool -- ^ Verbose -> FilePath -- ^ Outputdir @@ -32,9 +33,9 @@ h_target = outputDir ++ "include/stc_gen.h" cpp_target = outputDir ++ "src/stc_gen.cpp" putStrLn $ "generating: " ++ h_target - writeFile h_target $ (glue "\n\n" $ map headerfunc f) ++ "\n" + writeFileLazy h_target $ (glue "\n\n" $ map headerfunc f) ++ "\n" putStrLn $ "generating: " ++ cpp_target - writeFile cpp_target $ (glue "\n" $ map cppfunc f) ++ "\n" + writeFileLazy cpp_target $ (glue "\n" $ map cppfunc f) ++ "\n" when verbose $ putStrLn $ "Wrote type macros and c wrappers for " ++ show (length f) ++ " functions." diff --git a/src/HaskellNames.hs b/src/HaskellNames.hs --- a/src/HaskellNames.hs +++ b/src/HaskellNames.hs @@ -148,43 +148,37 @@ Haddock prologue -----------------------------------------------------------------------------------------} getPrologue moduleName content contains inputFiles - = do time <- getCurrentTime - return (prologue time) + = [line + ,"{-|\tModule : " ++ moduleName + ,"\tCopyright : Copyright (c) Daan Leijen 2003, 2004" + ,"\tLicense : wxWidgets" + ,"" + ,"\tMaintainer : wxhaskell-devel@lists.sourceforge.net" + ,"\tStability : provisional" + ,"\tPortability : portable" + ,"" + ,"Haskell " ++ content ++ " definitions for the wxWidgets C library (@wxc.dll@)." + ,"" + ,"Do not edit this file manually!" + ,"This file was automatically generated by wxDirect." + ] + ++ + (if (null inputFiles) + then [] + else (["","From the files:"] ++ concatMap showFile inputFiles)) + ++ + ["" + ,"And contains " ++ contains + ,"-}" + ,line + ] where - prologue time - = [line - ,"{-|\tModule : " ++ moduleName - ,"\tCopyright : Copyright (c) Daan Leijen 2003, 2004" - ,"\tLicense : wxWidgets" - ,"" - ,"\tMaintainer : wxhaskell-devel@lists.sourceforge.net" - ,"\tStability : provisional" - ,"\tPortability : portable" - ,"" - ,"Haskell " ++ content ++ " definitions for the wxWidgets C library (@wxc.dll@)." - ,"" - ,"Do not edit this file manually!" - ,"This file was automatically generated by wxDirect on: " - , "" - ," * @" ++ show time ++ "@" - ] - ++ - (if (null inputFiles) - then [] - else (["","From the files:"] ++ concatMap showFile inputFiles)) - ++ - ["" - ,"And contains " ++ contains - ,"-}" - ,line - ] - where - line = replicate 80 '-' + line = replicate 80 '-' - showFile fname - = [""," * @" ++ concatMap escapeSlash fname ++ "@"] + showFile fname + = [""," * @" ++ concatMap escapeSlash fname ++ "@"] - escapeSlash c - | c == '/' = "\\/" - | c == '\"' = "\\\"" - | otherwise = [c] + escapeSlash c + | c == '/' = "\\/" + | c == '\"' = "\\\"" + | otherwise = [c] diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -24,7 +24,6 @@ import CompileClasses ( compileClasses) import CompileHeader ( compileHeader ) -import CompileDefs ( compileDefs ) import CompileClassTypes( compileClassTypes ) import CompileClassInfo ( compileClassInfo ) import CompileSTC ( compileSTC ) @@ -45,9 +44,6 @@ ModeClassTypes outputDir inputFiles verbose -> compileClassTypes verbose moduleRootWxCore moduleClassTypesName (outputDir ++ moduleClassTypesName ++ ".hs") inputFiles - ModeDefs outputDir inputFiles verbose - -> compileDefs verbose moduleRootWxCore moduleDefsName - (outputDir ++ moduleDefsName ++ ".hs") inputFiles ModeClassInfo outputDir verbose -> compileClassInfo verbose moduleRootWxCore moduleClassesName moduleClassTypesName moduleClassInfoName (outputDir ++ moduleClassInfoName ++ ".hs") @@ -76,17 +72,7 @@ defaultOutputDirWxh = "../wxcore/src/" ++ moduleRootDir moduleRootWxCore -getDefaultFiles - = do hs <- getDefaultHeaderFiles - es <- getDefaultEiffelFiles - return (hs++es) - -getDefaultEiffelFiles :: IO [FilePath] -getDefaultEiffelFiles - = do wxcdir <- getWxcDir - return [wxcdir ++ "/include/wxc_defs.e" - ,wxcdir ++ "/ewxw/eiffel/spec/r_2_4/wx_defs.e"] - +getDefaultFiles = getDefaultHeaderFiles getDefaultHeaderFiles :: IO [FilePath] getDefaultHeaderFiles @@ -110,13 +96,12 @@ data Target - = TDefs | TClasses | TClassTypes | THeader | TClassInfo | TSTC + = TClasses | TClassTypes | THeader | TClassInfo | TSTC data Mode = ModeHelp | ModeClasses { outputDir :: FilePath, inputFiles :: [FilePath], verbose :: Bool } | ModeClassTypes{ outputDir :: FilePath, inputFiles :: [FilePath], verbose :: Bool } - | ModeDefs { outputDir :: FilePath, inputFiles :: [FilePath], verbose :: Bool } | ModeClassInfo { outputDir :: FilePath, verbose :: Bool } | ModeCHeader { outputDir :: FilePath, inputFiles :: [FilePath], verbose :: Bool } | ModeSTC { outputDir :: FilePath, inputFiles :: [FilePath], verbose :: Bool } @@ -136,8 +121,7 @@ options :: [OptDescr Flag] options = - [ Option ['d'] ["definitions"] (NoArg (Target TDefs)) "generate constant definitions from .e files" - , Option ['c'] ["classes"] (NoArg (Target TClasses)) "generate class method definitions from .h files" + [ Option ['c'] ["classes"] (NoArg (Target TClasses)) "generate class method definitions from .h files" , Option ['t'] ["classtypes"] (NoArg (Target TClassTypes)) "generate class type definitions from .h files" , Option ['i'] ["classinfo"] (NoArg (Target TClassInfo)) "generate class info definitions" , Option ['h'] ["header"] (NoArg (Target THeader)) "generate typed C header file -- development use only" @@ -158,10 +142,6 @@ then return ModeHelp else case filter isTarget flags of [] -> invokeError ["you need to specify a target: methods, definitions or classes.\n"] - [Target TDefs] -> do defaultEiffelFiles <- getDefaultEiffelFiles - inputFiles <- getInputFiles ".e" defaultEiffelFiles files - outputDir <- getOutputDir flags defaultOutputDirWxh - return (ModeDefs outputDir inputFiles (any isVerbose flags)) [Target TClassInfo] -> do outputDir <- getOutputDir flags defaultOutputDirWxh return (ModeClassInfo outputDir (any isVerbose flags)) @@ -236,4 +216,4 @@ return (usageInfo header options ++ "\ndefault input files:\n" ++ unlines (map (" "++) defaultFiles)) - where header = "usage: wxDirect -[dcti] [other options] [header-files..] [eiffel-files..]" + where header = "usage: wxDirect -[dcti] [other options] [header-files..]" diff --git a/src/ParseEiffel.hs b/src/ParseEiffel.hs deleted file mode 100644 --- a/src/ParseEiffel.hs +++ /dev/null @@ -1,156 +0,0 @@ ------------------------------------------------------------------------------------------ -{-| Module : ParseEiffel - Copyright : (c) Daan Leijen 2003 - License : BSD-style - - Maintainer : wxhaskell-devel@lists.sourceforge.net - Stability : provisional - Portability : portable - - Parse the wxc Eiffel definition file. --} ------------------------------------------------------------------------------------------ -module ParseEiffel( parseEiffel ) where - -import Data.Char( digitToInt ) -import Text.ParserCombinators.Parsec -import qualified Text.ParserCombinators.Parsec.Token as P -import Text.ParserCombinators.Parsec.Language - -import Types - -import System.Environment ( getEnv ) -import System.IO.Error (catchIOError) - -{----------------------------------------------------------------------------------------- - Testing ------------------------------------------------------------------------------------------} -test - = do files <- getDefaultEiffelFiles - defss <- mapM parseEiffel files - let defs = concat defss - haskellDefs = map show defs - writeFile "../../wxh/Graphics/UI/WXH/WxcDefs.hs" (unlines haskellDefs) - -getDefaultEiffelFiles :: IO [FilePath] -getDefaultEiffelFiles - = do wxwin <- getEnv "WXWIN" `catchIOError` \err -> return "" - return [wxwin ++ "/wxc/include/wxc_defs.e" - ,wxwin ++ "/wxc/ewxw/eiffel/spec/r_2_4/wx_defs.e"] - -{----------------------------------------------------------------------------------------- - Parse Eiffel ------------------------------------------------------------------------------------------} -parseEiffel :: FilePath -> IO [Def] -parseEiffel fname - = do putStrLn ("parsing: " ++ fname) - input <- readFile fname - defss <- mapM (parseDef fname) (lines input) - -- putStrLn ("ok.") - return (concat defss) - -parseDef :: FilePath -> String -> IO [Def] -parseDef fname line - = case parse pdef fname line of - Left err -> do putStrLn ("ignore: parse error : " ++ line) - return [] - Right mbd -> case mbd of - Just d -> return [d] - Nothing -> return [] -- empty line - - -{----------------------------------------------------------------------------------------- - Parse a constant definition ------------------------------------------------------------------------------------------} --- parse a definition: return Nothing on an empty definition -pdef :: Parser (Maybe Def) -pdef - = do whiteSpace - x <- option Nothing (pconstDef <|> pignore) - eof - return x - -pconstDef :: Parser (Maybe Def) -pconstDef - = do name <- identifier - symbol ":" - tp <- pdefType - reserved "is" - (do x <- pdefValue - return (Just (Def name x tp)) - <|> - return Nothing) -- external definition - "constant definition" - - -pignore - = do{ reserved "external"; stringLiteral; return Nothing } - <|> do{ reserved "alias"; stringLiteral; return Nothing } - <|> do{ reserved "end"; return Nothing } - <|> do{ reserved "class"; identifier; return Nothing } - <|> do{ reserved "feature"; symbol "{"; reserved "NONE"; symbol "}"; return Nothing } - "" - - -pdefType :: Parser DefType -pdefType - = do reserved "BIT" - bits <- natural - return DefMask - <|> do reserved "INTEGER" - return DefInt - "integer type" - -pdefValue :: Parser Int -pdefValue - = lexeme $ - do sign <- option id (do{ symbol "-"; return negate }) - ds <- many1 digit - base <- option 10 (do{char 'B'; return 2}) - return (sign (convertNum base ds)) - where - convertNum :: Int -> String -> Int - convertNum base digits - = foldl convert 0 digits - where - convert x c = base*x + digitToInt c - - -{----------------------------------------------------------------------------------------- - The lexer ------------------------------------------------------------------------------------------} -lexer :: P.TokenParser () -lexer - = P.makeTokenParser $ - emptyDef - { commentStart = "/*" - , commentEnd = "*/" - , commentLine = "--" -- ignore pre-processor stuff, but fail to recognise "//" - , nestedComments = True - , identStart = letter <|> char '_' - , identLetter = alphaNum <|> oneOf "_'" - , caseSensitive = True - , reservedNames = ["is","feature","class","end","NONE","BIT","INTEGER","external","alias"] - } - -whiteSpace = P.whiteSpace lexer -lexeme = P.lexeme lexer -symbol = P.symbol lexer -parens = P.parens lexer -semi = P.semi lexer -comma = P.comma lexer -commaSep = P.commaSep lexer -identifier = P.identifier lexer -natural = P.natural lexer -reserved = P.reserved lexer - -stringLiteral - = lexeme $ - do char '"' - many stringChar - char '"' - return () - -stringChar - = noneOf "\"%\n\v" - <|> do{ char '%'; anyChar } diff --git a/wxdirect.cabal b/wxdirect.cabal --- a/wxdirect.cabal +++ b/wxdirect.cabal @@ -1,5 +1,5 @@ name: wxdirect -version: 0.13.1.3 +version: 0.90 license: BSD3 license-file: LICENSE author: Daan Leijen @@ -10,7 +10,7 @@ wxHaskell is a portable and native GUI library for Haskell. It is built on top of wxWidgets, a comprehensive C++ library that is portable across all major GUI platforms, including GTK, Windows, X11, and MacOS X. This version - works with wxWidgets 2.8 only. + works with wxWidgets 2.9 only. homepage: http://haskell.org/haskellwiki/WxHaskell cabal-version: >= 1.2 @@ -45,7 +45,6 @@ , CompileClasses , CompileClassInfo , CompileClassTypes - , CompileDefs , CompileHeader , CompileSTC , DeriveTypes @@ -53,22 +52,21 @@ , IOExtra , MultiSet , ParseC - , ParseEiffel , Types hs-source-dirs: src build-depends: + directory, parsec >= 2.1.0 && < 4, - time >= 1.0 && < 1.5, - strict >= 0.3 && < 1.0, - directory >= 1.0 && < 2.0 + strict, + time >= 1.0 && < 1.3 if flag(splitBase) build-depends: base >= 4 && < 5, - containers >= 0.2 && < 0.6 + containers >= 0.2 && < 0.5 else build-depends: base >= 3 && < 4,