Permalink
Browse files

Merge branch 'interface' into develop

  • Loading branch information...
2 parents 3b68e05 + 2ac9103 commit 7f02c7ef0801be2ab057f81c85b86077ecec4c30 @Laar committed Feb 22, 2013
Showing with 90 additions and 1 deletion.
  1. +2 −1 OpenGLRawgen.cabal
  2. BIN referenceoutput.tar.gz
  3. +83 −0 src/Interface/Module.hs
  4. +5 −0 src/Main.hs
View
@@ -41,7 +41,8 @@ executable OpenGLRawgen
haskell-src-exts -any,
mtl -any,
opengl-api -any,
- parsec -any
+ parsec -any,
+ xml
ghc-options: -Wall -O2 -rtsopts
ghc-shared-options:
ghc-prof-options: -Wall -O2 -rtsopts -prof -auto-all -caf-all
View
Binary file not shown.
View
@@ -0,0 +1,83 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Interface.Module (
+ moduleToRenderedInterface,
+ moduleToInterface
+) where
+
+import Language.Haskell.Exts.Syntax hiding (QName)
+import Code.Generating.Utils
+import Data.String
+import Text.XML.Light
+
+import Modules.Types
+
+moduleToRenderedInterface :: RawModule -> String
+moduleToRenderedInterface = ppTopElement . moduleToInterface
+
+moduleToInterface :: RawModule -> Element
+moduleToInterface rawMod =
+ node "moduledefinition"
+ ([Attr "module" . moduleNameToName $ rawModuleName rawMod
+ , Attr "exported" $ if externalRawModule rawMod then "True" else "False"
+ ], parts)
+ where
+ parts = node "parts"
+ . map modulePartToElement $ rawModuleParts rawMod
+
+modulePartToElement :: ModulePart -> Element
+modulePartToElement p = case p of
+ DefineEnum n gln t _ -> enumElem n gln t
+ ReDefineLEnum n gln t _ -> enumElem n gln t
+ ReDefineIEnum n gln t _ -> enumElem n gln t
+ ReExport (n, m) gln -> reExportElem n gln m
+ DefineFunc n rt ats gln _ -> functionElem n gln rt ats
+ ReExportModule m -> moduleReexport m
+
+-- To make constructing xml easier
+instance IsString QName where
+ fromString = unqual
+
+functionElem :: Name -> GLName -> FType -> [FType] -> Element
+functionElem name glname rettype argtypes =
+ node "function"
+ ([ Attr "glname" glname
+ , Attr "name" $ unname name
+ ], typeContents)
+ where
+ typeContents =
+ node "return" (toElem rettype)
+ : map toArgElem argtypes
+ toArgElem = node "argument" . toElem
+ toElem :: FType -> Element
+ toElem (TCon n) = node "con" [Attr "type" n]
+ toElem TVar = node "var" ()
+ toElem (TPtr ft) = node "ptr" $ toElem ft
+ toElem UnitTCon = node "unit" ()
+
+enumElem :: Name -> GLName -> ValueType -> Element
+enumElem name glname vt =
+ node "enum"
+ [ Attr "glname" glname
+ , Attr "name" $ unname name
+ , Attr "type" valType
+ ]
+ where
+ valType = case vt of
+ EnumValue -> "enum"
+ BitfieldValue -> "bitfield"
+
+reExportElem :: Name -> GLName -> ModuleName -> Element
+reExportElem name glname (ModuleName modName) =
+ node "reexported"
+ [ Attr "glname" glname
+ , Attr "name" $ unname name
+ , Attr "module" modName
+ ]
+
+moduleReexport :: ModuleName -> Element
+moduleReexport (ModuleName modName) =
+ node "exportedmodule"
+ [ Attr "module" modName]
+
+
View
@@ -38,6 +38,8 @@ import Main.Options
import Spec
import Spec.Parsing(parseSpecs, parseReuses)
+
+import Interface.Module
-- needed for the version
import Data.Version(showVersion)
import Paths_OpenGLRawgen(version)
@@ -111,9 +113,12 @@ outputModule rmodule = do
modu <- toModule rmodule
oDir <- asksOptions outputDir
let modu' = replaceCallConv "CALLCONV" $ prettyPrint modu
+ interf = moduleToRenderedInterface rmodule
path = oDir </> moduleNameToPath mname ++ ".hs"
+ ipath = oDir </> "interface" </> moduleNameToPath mname ++ ".xml"
-- logMessage $ "Writing: " ++ moduleNameToName mname
liftIO $ safeWriteFile path modu'
+ liftIO $ safeWriteFile ipath interf
writeModuleListing :: FilePath -> [RawModule] -> RawGenIO ()
writeModuleListing fp mods = do

0 comments on commit 7f02c7e

Please sign in to comment.