diff options
Diffstat (limited to 'protocols/codegen/Wayland/CodeGen/Parser.hs')
| -rw-r--r-- | protocols/codegen/Wayland/CodeGen/Parser.hs | 39 |
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 |