wip codegen

1 files changed, 20 insertions, 19 deletions

diff --git a/protocols/codegen/Wayland/CodeGen/Parser.hs b/protocols/codegen/Wayland/CodeGen/Parser.hs
index 63ba2c4..e2f6c23 100644
--- a/protocols/codegen/Wayland/CodeGen/Parser.hs
+++ b/protocols/codegen/Wayland/CodeGen/Parser.hs
@@ -2,6 +2,7 @@ module Wayland.CodeGen.Parser
   ( parseProtocolSpec
   ) where
 
+import Data.Maybe (fromMaybe)
 import Text.XML.Light (Element(..), findAttrBy, QName(..), filterChildName, filterChildrenName, strContent, parseXMLDoc)
 import Text.Read (readEither)
 import Wayland.CodeGen.Types
@@ -34,7 +35,7 @@ processInterface :: Element -> Either String InterfaceDesc
 processInterface el = do
   name        <- requireAttr "name" el
   version     <- requireAttr "version" el >>= readEither
-  description <- traverse processDescription (filterChildName (matchName "description") el)
+  description <- mapM processDescription (filterChildName (matchName "description") el)
   enums       <- mapM processEnum (filterChildrenName (matchName "enum") el)
   requests    <- mapM processMessage (filterChildrenName (matchName "request") el)
   events      <- mapM processMessage (filterChildrenName (matchName "event") el)
@@ -49,14 +50,14 @@ processInterface el = do
 processEnum :: Element -> Either String EnumDesc
 processEnum el = do
   name        <- requireAttr "name" el
-  description <- traverse processDescription (filterChildName (matchName "description") el)
-  since       <- traverse readEither (findAttrBy (matchName "since") el)
-  bitfield    <- traverse readBool (findAttrBy (matchName "bitfield") el)
+  description <- mapM processDescription (filterChildName (matchName "description") el)
+  since       <- mapM readEither (findAttrBy (matchName "since") el)
+  bitfield    <- mapM readBool (findAttrBy (matchName "bitfield") el)
   entries     <- mapM processEntry (filterChildrenName (matchName "entry") el)
   pure $ EnumDesc { enumName        = name
                   , enumDescription = description
-                  , enumSince       = since
-                  , enumBitfield    = bitfield
+                  , enumSince       = fromMaybe 1 since
+                  , enumBitfield    = fromMaybe False bitfield
                   , enumEntries     = entries
                   }
 
@@ -64,30 +65,30 @@ processEntry :: Element -> Either String EntryDesc
 processEntry el = do
   name            <- requireAttr "name" el
   value           <- requireAttr "value" el >>= readEither
-  description     <- traverse processDescription (filterChildName (matchName "description") el)
-  since           <- traverse readEither (findAttrBy (matchName "since") el)
-  deprecatedSince <- traverse readEither (findAttrBy (matchName "deprecated-since") el)
+  description     <- mapM processDescription (filterChildName (matchName "description") el)
+  since           <- mapM readEither (findAttrBy (matchName "since") el)
+  deprecatedSince <- mapM readEither (findAttrBy (matchName "deprecated-since") el)
   let summary = findAttrBy (matchName "summary") el
   pure $ EntryDesc { entryName            = name
                    , entryValue           = value
                    , entryDescription     = description
                    , entrySummary         = summary
-                   , entrySince           = since
+                   , entrySince           = fromMaybe 1 since
                    , entryDeprecatedSince = deprecatedSince
                    }
 
 processMessage :: Element -> Either String MessageDesc
 processMessage el = do
   name            <- requireAttr "name" el
-  description     <- traverse processDescription (filterChildName (matchName "description") el)
-  type'           <- traverse readMessageType (findAttrBy (matchName "type") el)
-  since           <- traverse readEither (findAttrBy (matchName "since") el)
-  deprecatedSince <- traverse readEither (findAttrBy (matchName "deprecated-since") el)
+  description     <- mapM processDescription (filterChildName (matchName "description") el)
+  type'           <- mapM readMessageType (findAttrBy (matchName "type") el)
+  since           <- mapM readEither (findAttrBy (matchName "since") el)
+  deprecatedSince <- mapM readEither (findAttrBy (matchName "deprecated-since") el)
   arguments       <- mapM processArgument (filterChildrenName (matchName "arg") el)
   pure $ MessageDesc { msgName            = name
                      , msgDescription     = description
-                     , msgType            = type'
-                     , msgSince           = since
+                     , msgType            = fromMaybe MessageNormal type'
+                     , msgSince           = fromMaybe 1 since
                      , msgDeprecatedSince = deprecatedSince
                      , msgArguments       = arguments
                      }
@@ -96,8 +97,8 @@ processArgument :: Element -> Either String ArgumentDesc
 processArgument el = do
   name        <- requireAttr "name" el
   type'       <- requireAttr "type" el >>= readArgumentType
-  description <- traverse processDescription (filterChildName (matchName "description") el)
-  allowNull   <- traverse readBool (findAttrBy (matchName "allow-null") el)
+  description <- mapM processDescription (filterChildName (matchName "description") el)
+  allowNull   <- mapM readBool (findAttrBy (matchName "allow-null") el)
   let summary   = findAttrBy (matchName "summary") el
   let interface = findAttrBy (matchName "interface") el
   let enum      = findAttrBy (matchName "enum") el
@@ -106,8 +107,8 @@ processArgument el = do
                       , argDescription = description
                       , argSummary     = summary
                       , argInterface   = interface
-                      , argAllowNull   = allowNull
                       , argEnum        = enum
+                      , argAllowNull   = fromMaybe False allowNull
                       }
 
 requireAttr :: String -> Element -> Either String String