    -- |
    -- Module    :  Data.XCB.FromXML
    -- Copyright :  (c) Antoine Latter 2008
    -- License   :  BSD3
    --
    -- Maintainer:  Antoine Latter <aslatter@gmail.com>
    -- Stability :  provisional
    -- Portability: portable
    --
    -- Handls parsing the data structures from XML files.
    --
    -- In order to support copying events and errors across module
    -- boundaries, all modules which may have cross-module event copies and
    -- error copies must be parsed at once.
    --
    -- There is no provision for preserving the event copy and error copy
    -- declarations - the copies are handled during parsing.
    {-# LANGUAGE CPP #-}
    module Data.XCB.FromXML(fromFiles
                           ,fromStrings
                           ) where

    import Data.XCB.Types
    import Data.XCB.Utils

    import Text.XML.Light

    import Data.List as List
    import qualified Data.Map as Map
    import Data.Maybe (catMaybes, mapMaybe, maybeToList)

    import Control.Monad (MonadPlus (mzero, mplus), guard, liftM, liftM2)
    import Control.Monad.Reader (ReaderT, runReaderT, ask, lift, withReaderT)
    #if __GLASGOW_HASKELL__ < 900
    import Control.Monad.Fail (MonadFail)
    #endif
    import System.IO (openFile, IOMode (ReadMode), hSetEncoding, utf8, hGetContents)

    -- |Process the listed XML files.
    -- Any files which fail to parse are silently dropped.
    -- Any declaration in an XML file which fail to parse are
    -- silently dropped.
    fromFiles :: [FilePath] -> IO [XHeader]
    fromFiles :: [Name] -> IO [XHeader]
    fromFiles [Name]
    xs = do
      strings <- [IO Name] -> IO [Name]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence ([IO Name] -> IO [Name]) -> [IO Name] -> IO [Name]
    forall a b. (a -> b) -> a -> b
    $ (Name -> IO Name) -> [Name] -> [IO Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> IO Name
    readFileUTF8 [Name]
    xs
      return $ fromStrings strings

    -- | Like 'readFile', but forces the encoding
    -- of the file to UTF8.
    readFileUTF8 :: FilePath -> IO String
    readFileUTF8 :: Name -> IO Name
    readFileUTF8 Name
    fp = do
      h <- Name -> IOMode -> IO Handle
    openFile Name
    fp IOMode
    ReadMode
      hSetEncoding h utf8
      hGetContents h

    -- |Process the strings as if they were XML files.
    -- Any files which fail to parse are silently dropped.
    -- Any declaration in an XML file which fail to parse are
    -- silently dropped.
    fromStrings :: [String] -> [XHeader]
    fromStrings :: [Name] -> [XHeader]
    fromStrings [Name]
    xs =
       let rs :: ReaderT [XHeader] Maybe [XHeader]
    rs = (Name -> ReaderT [XHeader] Maybe XHeader)
    -> [Name] -> ReaderT [XHeader] Maybe [XHeader]
    forall (f :: * -> *) a b.
    Alternative f =>
    (a -> f b) -> [a] -> f [b]
    mapAlt Name -> ReaderT [XHeader] Maybe XHeader
    fromString [Name]
    xs
           headers :: [XHeader]
    headers = [[XHeader]] -> [XHeader]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[XHeader]] -> [XHeader]) -> [[XHeader]] -> [XHeader]
    forall a b. (a -> b) -> a -> b
    $ Maybe [XHeader] -> [[XHeader]]
    forall a. Maybe a -> [a]
    maybeToList (Maybe [XHeader] -> [[XHeader]]) -> Maybe [XHeader] -> [[XHeader]]
    forall a b. (a -> b) -> a -> b
    $ ReaderT [XHeader] Maybe [XHeader] -> [XHeader] -> Maybe [XHeader]
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT ReaderT [XHeader] Maybe [XHeader]
    rs [XHeader]
    headers
       in [XHeader]
    headers

    -- The 'Parse' monad.  Provides the name of the
    -- current module, and a list of all of the modules.
    type Parse = ReaderT ([XHeader],Name) Maybe

    -- operations in the 'Parse' monad

    localName :: Parse Name
    localName :: Parse Name
    localName = ([XHeader], Name) -> Name
    forall a b. (a, b) -> b
    snd (([XHeader], Name) -> Name)
    -> ReaderT ([XHeader], Name) Maybe ([XHeader], Name) -> Parse Name
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` ReaderT ([XHeader], Name) Maybe ([XHeader], Name)
    forall r (m :: * -> *). MonadReader r m => m r
    ask

    allModules :: Parse [XHeader]
    allModules :: Parse [XHeader]
    allModules = ([XHeader], Name) -> [XHeader]
    forall a b. (a, b) -> a
    fst (([XHeader], Name) -> [XHeader])
    -> ReaderT ([XHeader], Name) Maybe ([XHeader], Name)
    -> Parse [XHeader]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` ReaderT ([XHeader], Name) Maybe ([XHeader], Name)
    forall r (m :: * -> *). MonadReader r m => m r
    ask

    -- Extract an Alignment from a list of Elements. This assumes that the
    -- required_start_align is the first element if it exists at all.
    extractAlignment :: (MonadPlus m, Functor m) => [Element] -> m (Maybe Alignment, [Element])
    extractAlignment :: forall (m :: * -> *).
    (MonadPlus m, Functor m) =>
    [Element] -> m (Maybe Alignment, [Element])
    extractAlignment (Element
    el : [Element]
    xs) | Element
    el Element -> Name -> Bool
    `named` Name
    "required_start_align" = do
                                   align <- Element
    el Element -> Name -> m Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "align" m Name -> (Name -> m Int) -> m Int
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Name -> m Int
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Name -> m a
    readM
                                   offset <- el `attr` "offset" >>= readM
                                   return (Just (Alignment align offset), xs)
                               | Bool
    otherwise = (Maybe Alignment, [Element]) -> m (Maybe Alignment, [Element])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Alignment
    forall a. Maybe a
    Nothing, Element
    el Element -> [Element] -> [Element]
    forall a. a -> [a] -> [a]
    : [Element]
    xs)
    extractAlignment [Element]
    xs = (Maybe Alignment, [Element]) -> m (Maybe Alignment, [Element])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Alignment
    forall a. Maybe a
    Nothing, [Element]
    xs)

    -- a generic function for looking up something from
    -- a named XHeader.
    --
    -- this implements searching both the current module and
    -- the xproto module if the name is not specified.
    lookupThingy :: ([XDecl] -> Maybe a)
                 -> (Maybe Name)
                 -> Parse (Maybe a)
    lookupThingy :: forall a. ([XDecl] -> Maybe a) -> Maybe Name -> Parse (Maybe a)
    lookupThingy [XDecl] -> Maybe a
    f Maybe Name
    Nothing = do
      lname <- Parse Name
    localName
      liftM2 mplus (lookupThingy f $ Just lname)
                   (lookupThingy f $ Just "xproto") -- implicit xproto import
    lookupThingy [XDecl] -> Maybe a
    f (Just Name
    mname) = do
      xs <- Parse [XHeader]
    allModules
      return $ do
        x <- findXHeader mname xs
        f $ xheader_decls x

    -- lookup an event declaration by name.
    lookupEvent :: Maybe Name -> Name -> Parse (Maybe EventDetails)
    lookupEvent :: Maybe Name -> Name -> Parse (Maybe EventDetails)
    lookupEvent Maybe Name
    mname Name
    evname = (([XDecl] -> Maybe EventDetails)
     -> Maybe Name -> Parse (Maybe EventDetails))
    -> Maybe Name
    -> ([XDecl] -> Maybe EventDetails)
    -> Parse (Maybe EventDetails)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ([XDecl] -> Maybe EventDetails)
    -> Maybe Name -> Parse (Maybe EventDetails)
    forall a. ([XDecl] -> Maybe a) -> Maybe Name -> Parse (Maybe a)
    lookupThingy Maybe Name
    mname (([XDecl] -> Maybe EventDetails) -> Parse (Maybe EventDetails))
    -> ([XDecl] -> Maybe EventDetails) -> Parse (Maybe EventDetails)
    forall a b. (a -> b) -> a -> b
    $ \[XDecl]
    decls ->
                     Name -> [XDecl] -> Maybe EventDetails
    findEvent Name
    evname [XDecl]
    decls

    -- lookup an error declaration by name.
    lookupError :: Maybe Name -> Name -> Parse (Maybe ErrorDetails)
    lookupError :: Maybe Name -> Name -> Parse (Maybe ErrorDetails)
    lookupError Maybe Name
    mname Name
    ername = (([XDecl] -> Maybe ErrorDetails)
     -> Maybe Name -> Parse (Maybe ErrorDetails))
    -> Maybe Name
    -> ([XDecl] -> Maybe ErrorDetails)
    -> Parse (Maybe ErrorDetails)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ([XDecl] -> Maybe ErrorDetails)
    -> Maybe Name -> Parse (Maybe ErrorDetails)
    forall a. ([XDecl] -> Maybe a) -> Maybe Name -> Parse (Maybe a)
    lookupThingy Maybe Name
    mname (([XDecl] -> Maybe ErrorDetails) -> Parse (Maybe ErrorDetails))
    -> ([XDecl] -> Maybe ErrorDetails) -> Parse (Maybe ErrorDetails)
    forall a b. (a -> b) -> a -> b
    $ \[XDecl]
    decls ->
                     Name -> [XDecl] -> Maybe ErrorDetails
    findError Name
    ername [XDecl]
    decls

    findXHeader :: Name -> [XHeader] -> Maybe XHeader
    findXHeader :: Name -> [XHeader] -> Maybe XHeader
    findXHeader Name
    name = (XHeader -> Bool) -> [XHeader] -> Maybe XHeader
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    List.find ((XHeader -> Bool) -> [XHeader] -> Maybe XHeader)
    -> (XHeader -> Bool) -> [XHeader] -> Maybe XHeader
    forall a b. (a -> b) -> a -> b
    $ \ XHeader
    x -> XHeader -> Name
    forall typ. GenXHeader typ -> Name
    xheader_header XHeader
    x Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    name

    findError :: Name -> [XDecl] -> Maybe ErrorDetails
    findError :: Name -> [XDecl] -> Maybe ErrorDetails
    findError Name
    pname [XDecl]
    xs =
          case (XDecl -> Bool) -> [XDecl] -> Maybe XDecl
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    List.find XDecl -> Bool
    forall {typ}. GenXDecl typ -> Bool
    f [XDecl]
    xs of
            Maybe XDecl
    Nothing -> Maybe ErrorDetails
    forall a. Maybe a
    Nothing
            Just (XError Name
    name Int
    code Maybe Alignment
    alignment [GenStructElem Type]
    elems) -> ErrorDetails -> Maybe ErrorDetails
    forall a. a -> Maybe a
    Just (ErrorDetails -> Maybe ErrorDetails)
    -> ErrorDetails -> Maybe ErrorDetails
    forall a b. (a -> b) -> a -> b
    $ Name
    -> Int -> Maybe Alignment -> [GenStructElem Type] -> ErrorDetails
    ErrorDetails Name
    name Int
    code Maybe Alignment
    alignment [GenStructElem Type]
    elems
            Maybe XDecl
    _ -> Name -> Maybe ErrorDetails
    forall a. HasCallStack => Name -> a
    error Name
    "impossible: fatal error in Data.XCB.FromXML.findError"
        where  f :: GenXDecl typ -> Bool
    f (XError Name
    name Int
    _ Maybe Alignment
    _ [GenStructElem typ]
    _) | Name
    name Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    pname = Bool
    True
               f GenXDecl typ
    _ = Bool
    False

    findEvent :: Name -> [XDecl] -> Maybe EventDetails
    findEvent :: Name -> [XDecl] -> Maybe EventDetails
    findEvent Name
    pname [XDecl]
    xs =
          case (XDecl -> Bool) -> [XDecl] -> Maybe XDecl
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    List.find XDecl -> Bool
    forall {typ}. GenXDecl typ -> Bool
    f [XDecl]
    xs of
            Maybe XDecl
    Nothing -> Maybe EventDetails
    forall a. Maybe a
    Nothing
            Just (XEvent Name
    name Int
    code Maybe Alignment
    alignment Maybe Bool
    xge [GenStructElem Type]
    elems Maybe Bool
    noseq) ->
                EventDetails -> Maybe EventDetails
    forall a. a -> Maybe a
    Just (EventDetails -> Maybe EventDetails)
    -> EventDetails -> Maybe EventDetails
    forall a b. (a -> b) -> a -> b
    $ Name
    -> Int
    -> Maybe Alignment
    -> Maybe Bool
    -> [GenStructElem Type]
    -> Maybe Bool
    -> EventDetails
    EventDetails Name
    name Int
    code Maybe Alignment
    alignment Maybe Bool
    xge [GenStructElem Type]
    elems Maybe Bool
    noseq
            Maybe XDecl
    _ -> Name -> Maybe EventDetails
    forall a. HasCallStack => Name -> a
    error Name
    "impossible: fatal error in Data.XCB.FromXML.findEvent"
       where f :: GenXDecl typ -> Bool
    f (XEvent Name
    name Int
    _ Maybe Alignment
    _ Maybe Bool
    _ [GenStructElem typ]
    _ Maybe Bool
    _) | Name
    name Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    pname = Bool
    True
             f GenXDecl typ
    _ = Bool
    False

    data EventDetails = EventDetails Name Int (Maybe Alignment) (Maybe Bool) [StructElem] (Maybe Bool)
    data ErrorDetails = ErrorDetails Name Int (Maybe Alignment) [StructElem]

    ---

    -- extract a single XHeader from a single XML document
    fromString :: String -> ReaderT [XHeader] Maybe XHeader
    fromString :: Name -> ReaderT [XHeader] Maybe XHeader
    fromString Name
    str = do
      el@(Element _qname _ats cnt _) <- Maybe Element -> ReaderT [XHeader] Maybe Element
    forall (m :: * -> *) a. Monad m => m a -> ReaderT [XHeader] m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Maybe Element -> ReaderT [XHeader] Maybe Element)
    -> Maybe Element -> ReaderT [XHeader] Maybe Element
    forall a b. (a -> b) -> a -> b
    $ Name -> Maybe Element
    forall s. XmlSource s => s -> Maybe Element
    parseXMLDoc Name
    str
      guard $ el `named` "xcb"
      header <- el `attr` "header"
      let name = Element
    el Element -> Name -> Maybe Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "extension-name"
          xname = Element
    el Element -> Name -> Maybe Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "extension-xname"
          maj_ver = Element
    el Element -> Name -> Maybe Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "major-version" Maybe Name -> (Name -> Maybe Int) -> Maybe Int
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Name -> Maybe Int
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Name -> m a
    readM
          min_ver = Element
    el Element -> Name -> Maybe Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "minor-version" Maybe Name -> (Name -> Maybe Int) -> Maybe Int
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Name -> Maybe Int
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Name -> m a
    readM
          multiword = Element
    el Element -> Name -> Maybe Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "extension-multiword" Maybe Name -> (Name -> Maybe Bool) -> Maybe Bool
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Name -> Maybe Bool
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Name -> m a
    readM (Name -> Maybe Bool) -> (Name -> Name) -> Name -> Maybe Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Name
    ensureUpper
      decls <- withReaderT (\[XHeader]
    r -> ([XHeader]
    r,Name
    header)) $ extractDecls cnt
      return $ XHeader {xheader_header = header
                       ,xheader_xname = xname
                       ,xheader_name = name
                       ,xheader_multiword = multiword
                       ,xheader_major_version = maj_ver
                       ,xheader_minor_version = min_ver
                       ,xheader_decls = decls
                       }

    -- attempts to extract declarations from XML content, discarding failures.
    extractDecls :: [Content] -> Parse [XDecl]
    extractDecls :: [Content] -> ReaderT ([XHeader], Name) Maybe [XDecl]
    extractDecls = (Element -> ReaderT ([XHeader], Name) Maybe XDecl)
    -> [Element] -> ReaderT ([XHeader], Name) Maybe [XDecl]
    forall (f :: * -> *) a b.
    Alternative f =>
    (a -> f b) -> [a] -> f [b]
    mapAlt Element -> ReaderT ([XHeader], Name) Maybe XDecl
    declFromElem ([Element] -> ReaderT ([XHeader], Name) Maybe [XDecl])
    -> ([Content] -> [Element])
    -> [Content]
    -> ReaderT ([XHeader], Name) Maybe [XDecl]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Content] -> [Element]
    onlyElems

    -- attempt to extract a module declaration from an XML element
    declFromElem :: Element -> Parse XDecl
    declFromElem :: Element -> ReaderT ([XHeader], Name) Maybe XDecl
    declFromElem Element
    el
        | Element
    el Element -> Name -> Bool
    `named` Name
    "request" = Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xrequest Element
    el
        | Element
    el Element -> Name -> Bool
    `named` Name
    "event"   = Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xevent Element
    el
        | Element
    el Element -> Name -> Bool
    `named` Name
    "eventcopy" = Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xevcopy Element
    el
        | Element
    el Element -> Name -> Bool
    `named` Name
    "error" = Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xerror Element
    el
        | Element
    el Element -> Name -> Bool
    `named` Name
    "errorcopy" = Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xercopy Element
    el
        | Element
    el Element -> Name -> Bool
    `named` Name
    "struct" = Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xstruct Element
    el
        | Element
    el Element -> Name -> Bool
    `named` Name
    "union" = Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xunion Element
    el
        | Element
    el Element -> Name -> Bool
    `named` Name
    "xidtype" = Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xidtype Element
    el
        | Element
    el Element -> Name -> Bool
    `named` Name
    "xidunion" = Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xidunion Element
    el
        | Element
    el Element -> Name -> Bool
    `named` Name
    "typedef" = Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xtypedef Element
    el
        | Element
    el Element -> Name -> Bool
    `named` Name
    "enum" = Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xenum Element
    el
        | Element
    el Element -> Name -> Bool
    `named` Name
    "import" = Element -> ReaderT ([XHeader], Name) Maybe XDecl
    ximport Element
    el
        | Element
    el Element -> Name -> Bool
    `named` Name
    "eventstruct" = Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xeventstruct Element
    el
        | Bool
    otherwise = ReaderT ([XHeader], Name) Maybe XDecl
    forall a. ReaderT ([XHeader], Name) Maybe a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    ximport :: Element -> Parse XDecl
    ximport :: Element -> ReaderT ([XHeader], Name) Maybe XDecl
    ximport = XDecl -> ReaderT ([XHeader], Name) Maybe XDecl
    forall a. a -> ReaderT ([XHeader], Name) Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XDecl -> ReaderT ([XHeader], Name) Maybe XDecl)
    -> (Element -> XDecl)
    -> Element
    -> ReaderT ([XHeader], Name) Maybe XDecl
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> XDecl
    forall typ. Name -> GenXDecl typ
    XImport (Name -> XDecl) -> (Element -> Name) -> Element -> XDecl
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Element -> Name
    strContent

    xenum :: Element -> Parse XDecl
    xenum :: Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xenum Element
    el = do
      nm <- Element
    el Element -> Name -> Parse Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "name"
      fields <- mapAlt enumField $ elChildren el
      guard $ not $ null fields
      return $ XEnum nm fields

    enumField :: Element -> Parse (EnumElem Type)
    enumField :: Element -> ReaderT ([XHeader], Name) Maybe (EnumElem Type)
    enumField Element
    el = do
      Bool -> ReaderT ([XHeader], Name) Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> ReaderT ([XHeader], Name) Maybe ())
    -> Bool -> ReaderT ([XHeader], Name) Maybe ()
    forall a b. (a -> b) -> a -> b
    $ Element
    el Element -> Name -> Bool
    `named` Name
    "item"
      name <- Element
    el Element -> Name -> Parse Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "name"
      let expr = Element -> Maybe Element
    forall (m :: * -> *). MonadPlus m => Element -> m Element
    firstChild Element
    el Maybe Element
    -> (Element -> Maybe XExpression) -> Maybe XExpression
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Element -> Maybe XExpression
    forall (m :: * -> *).
    (MonadFail m, MonadPlus m, Functor m) =>
    Element -> m XExpression
    expression
      return $ EnumElem name expr

    xrequest :: Element -> Parse XDecl
    xrequest :: Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xrequest Element
    el = do
      nm <- Element
    el Element -> Name -> Parse Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "name"
      code <- el `attr` "opcode" >>= readM
      -- TODO - I don't think I like 'mapAlt' here.
      -- I don't want to be silently dropping fields
      (alignment, xs) <- extractAlignment $ elChildren el
      fields <- mapAlt structField $ xs
      let reply = Element -> Maybe XReply
    getReply Element
    el
      return $ XRequest nm code alignment fields reply

    getReply :: Element -> Maybe XReply
    getReply :: Element -> Maybe XReply
    getReply Element
    el = do
      childElem <- Name -> QName
    unqual Name
    "reply" QName -> Element -> Maybe Element
    `findChild` Element
    el
      (alignment, xs) <- extractAlignment $ elChildren childElem
      fields <- mapM structField xs
      guard $ not $ null fields
      return $ GenXReply alignment fields

    xevent :: Element -> Parse XDecl
    xevent :: Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xevent Element
    el = do
      name <- Element
    el Element -> Name -> Parse Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "name"
      number <- el `attr` "number" >>= readM
      let xge = Name -> Name
    ensureUpper (Name -> Name) -> Maybe Name -> Maybe Name
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` (Element
    el Element -> Name -> Maybe Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "xge") Maybe Name -> (Name -> Maybe Bool) -> Maybe Bool
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Name -> Maybe Bool
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Name -> m a
    readM
      let noseq = Name -> Name
    ensureUpper (Name -> Name) -> Maybe Name -> Maybe Name
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` (Element
    el Element -> Name -> Maybe Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "no-sequence-number") Maybe Name -> (Name -> Maybe Bool) -> Maybe Bool
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Name -> Maybe Bool
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Name -> m a
    readM
      (alignment, xs) <- extractAlignment (elChildren el)
      fields <- mapM structField $ xs
      guard $ not $ null fields
      return $ XEvent name number alignment xge fields noseq

    xevcopy :: Element -> Parse XDecl
    xevcopy :: Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xevcopy Element
    el = do
      name <- Element
    el Element -> Name -> Parse Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "name"
      number <- el `attr` "number" >>= readM
      ref <- el `attr` "ref"
      -- do we have a qualified ref?
      let (mname,evname) = splitRef ref
      details <- lookupEvent mname evname
      return $ let EventDetails _ _ alignment xge fields noseq =
                     case details of
                       Maybe EventDetails
    Nothing ->
                           Name -> EventDetails
    forall a. HasCallStack => Name -> a
    error (Name -> EventDetails) -> Name -> EventDetails
    forall a b. (a -> b) -> a -> b
    $ Name
    "Unresolved event: " Name -> Name -> Name
    forall a. [a] -> [a] -> [a]
    ++ Maybe Name -> Name
    forall a. Show a => a -> Name
    show Maybe Name
    mname Name -> Name -> Name
    forall a. [a] -> [a] -> [a]
    ++ Name
    " " Name -> Name -> Name
    forall a. [a] -> [a] -> [a]
    ++ Name
    ref
                       Just EventDetails
    x -> EventDetails
    x
               in XEvent name number alignment xge fields noseq

    -- we need to do string processing to distinguish qualified from
    -- unqualified types.
    mkType :: String -> Type
    mkType :: Name -> Type
    mkType Name
    str =
        let (Maybe Name
    mname, Name
    name) = Name -> (Maybe Name, Name)
    splitRef Name
    str
        in case Maybe Name
    mname of
             Just Name
    modifier -> Name -> Name -> Type
    QualType Name
    modifier Name
    name
             Maybe Name
    Nothing  -> Name -> Type
    UnQualType Name
    name

    splitRef :: Name -> (Maybe Name, Name)
    splitRef :: Name -> (Maybe Name, Name)
    splitRef Name
    ref = case Char -> Name -> (Name, Name)
    split Char
    ':' Name
    ref of
                     (Name
    x,Name
    "") -> (Maybe Name
    forall a. Maybe a
    Nothing, Name
    x)
                     (Name
    a, Name
    b) -> (Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    a, Name
    b)

    -- |Neither returned string contains the first occurance of the
    -- supplied Char.
    split :: Char -> String -> (String, String)
    split :: Char -> Name -> (Name, Name)
    split Char
    c = Name -> (Name, Name)
    go
        where go :: Name -> (Name, Name)
    go [] = ([],[])
              go (Char
    x:Name
    xs) | Char
    x Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c = ([],Name
    xs)
                        | Bool
    otherwise =
                            let (Name
    lefts, Name
    rights) = Name -> (Name, Name)
    go Name
    xs
                            in (Char
    xChar -> Name -> Name
    forall a. a -> [a] -> [a]
    :Name
    lefts,Name
    rights)

    xerror :: Element -> Parse XDecl
    xerror :: Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xerror Element
    el = do
      name <- Element
    el Element -> Name -> Parse Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "name"
      number <- el `attr` "number" >>= readM
      (alignment, xs) <- extractAlignment $ elChildren el
      fields <- mapM structField $ xs
      return $ XError name number alignment fields

    xercopy :: Element -> Parse XDecl
    xercopy :: Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xercopy Element
    el = do
      name <- Element
    el Element -> Name -> Parse Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "name"
      number <- el `attr` "number" >>= readM
      ref <- el `attr` "ref"
      let (mname, ername) = splitRef ref
      details <- lookupError mname ername
      return $ uncurry (XError name number) $ case details of
                   Maybe ErrorDetails
    Nothing -> Name -> (Maybe Alignment, [GenStructElem Type])
    forall a. HasCallStack => Name -> a
    error (Name -> (Maybe Alignment, [GenStructElem Type]))
    -> Name -> (Maybe Alignment, [GenStructElem Type])
    forall a b. (a -> b) -> a -> b
    $ Name
    "Unresolved error: " Name -> Name -> Name
    forall a. [a] -> [a] -> [a]
    ++ Maybe Name -> Name
    forall a. Show a => a -> Name
    show Maybe Name
    mname Name -> Name -> Name
    forall a. [a] -> [a] -> [a]
    ++ Name
    " " Name -> Name -> Name
    forall a. [a] -> [a] -> [a]
    ++ Name
    ref
                   Just (ErrorDetails Name
    _ Int
    _ Maybe Alignment
    alignment [GenStructElem Type]
    elems) -> (Maybe Alignment
    alignment, [GenStructElem Type]
    elems)

    xstruct :: Element -> Parse XDecl
    xstruct :: Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xstruct Element
    el = do
      name <- Element
    el Element -> Name -> Parse Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "name"
      (alignment, xs) <- extractAlignment $ elChildren el
      fields <- mapAlt structField $ xs
      guard $ not $ null fields
      return $ XStruct name alignment fields

    xunion :: Element -> Parse XDecl
    xunion :: Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xunion Element
    el = do
      name <- Element
    el Element -> Name -> Parse Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "name"
      (alignment, xs) <- extractAlignment $ elChildren el
      fields <- mapAlt structField $ xs
      guard $ not $ null fields
      return $ XUnion name alignment fields

    xidtype :: Element -> Parse XDecl
    xidtype :: Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xidtype Element
    el = (Name -> XDecl)
    -> Parse Name -> ReaderT ([XHeader], Name) Maybe XDecl
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Name -> XDecl
    forall typ. Name -> GenXDecl typ
    XidType (Parse Name -> ReaderT ([XHeader], Name) Maybe XDecl)
    -> Parse Name -> ReaderT ([XHeader], Name) Maybe XDecl
    forall a b. (a -> b) -> a -> b
    $ Element
    el Element -> Name -> Parse Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "name"

    xidunion :: Element -> Parse XDecl
    xidunion :: Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xidunion Element
    el = do
      name <- Element
    el Element -> Name -> Parse Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "name"
      let types = (Element -> Maybe XidUnionElem) -> [Element] -> [XidUnionElem]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Element -> Maybe XidUnionElem
    xidUnionElem ([Element] -> [XidUnionElem]) -> [Element] -> [XidUnionElem]
    forall a b. (a -> b) -> a -> b
    $ Element -> [Element]
    elChildren Element
    el
      guard $ not $ null types
      return $ XidUnion name types

    xidUnionElem :: Element -> Maybe XidUnionElem
    xidUnionElem :: Element -> Maybe XidUnionElem
    xidUnionElem Element
    el = do
      Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Maybe ()) -> Bool -> Maybe ()
    forall a b. (a -> b) -> a -> b
    $ Element
    el Element -> Name -> Bool
    `named` Name
    "type"
      XidUnionElem -> Maybe XidUnionElem
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XidUnionElem -> Maybe XidUnionElem)
    -> XidUnionElem -> Maybe XidUnionElem
    forall a b. (a -> b) -> a -> b
    $ Type -> XidUnionElem
    forall typ. typ -> GenXidUnionElem typ
    XidUnionElem (Type -> XidUnionElem) -> Type -> XidUnionElem
    forall a b. (a -> b) -> a -> b
    $ Name -> Type
    mkType (Name -> Type) -> Name -> Type
    forall a b. (a -> b) -> a -> b
    $ Element -> Name
    strContent Element
    el

    xtypedef :: Element -> Parse XDecl
    xtypedef :: Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xtypedef Element
    el = do
      oldtyp <- (Name -> Type)
    -> Parse Name -> ReaderT ([XHeader], Name) Maybe Type
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Name -> Type
    mkType (Parse Name -> ReaderT ([XHeader], Name) Maybe Type)
    -> Parse Name -> ReaderT ([XHeader], Name) Maybe Type
    forall a b. (a -> b) -> a -> b
    $ Element
    el Element -> Name -> Parse Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "oldname"
      newname <- el `attr` "newname"
      return $ XTypeDef newname oldtyp

    xeventstruct :: Element -> Parse XDecl
    xeventstruct :: Element -> ReaderT ([XHeader], Name) Maybe XDecl
    xeventstruct Element
    el = do
      name <- Element
    el Element -> Name -> Parse Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "name"
      allowed <- mapAlt allowedEvent $ elChildren el
      return $ XEventStruct name allowed

    allowedEvent :: (MonadPlus m, Functor m) => Element -> m AllowedEvent
    allowedEvent :: forall (m :: * -> *).
    (MonadPlus m, Functor m) =>
    Element -> m AllowedEvent
    allowedEvent Element
    el = do
      extension <- Element
    el Element -> Name -> m Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "name"
      xge <- el `attr` "xge" >>= readM
      opMin <- el `attr` "opcode-min" >>= readM
      opMax <- el `attr` "opcode-max" >>= readM
      return $ AllowedEvent extension xge opMin opMax

    structField :: (MonadFail m, MonadPlus m, Functor m) => Element -> m StructElem
    structField :: forall (m :: * -> *).
    (MonadFail m, MonadPlus m, Functor m) =>
    Element -> m (GenStructElem Type)
    structField Element
    el
        | Element
    el Element -> Name -> Bool
    `named` Name
    "field" = do
            typ <- (Name -> Type) -> m Name -> m Type
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Name -> Type
    mkType (m Name -> m Type) -> m Name -> m Type
    forall a b. (a -> b) -> a -> b
    $ Element
    el Element -> Name -> m Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "type"
            let enum = (Name -> Type) -> Maybe Name -> Maybe Type
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Name -> Type
    mkType (Maybe Name -> Maybe Type) -> Maybe Name -> Maybe Type
    forall a b. (a -> b) -> a -> b
    $ Element
    el Element -> Name -> Maybe Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "enum"
            let mask = (Name -> Type) -> Maybe Name -> Maybe Type
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Name -> Type
    mkType (Maybe Name -> Maybe Type) -> Maybe Name -> Maybe Type
    forall a b. (a -> b) -> a -> b
    $ Element
    el Element -> Name -> Maybe Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "mask"
            name <- el `attr` "name"
            return $ SField name typ enum mask

        | Element
    el Element -> Name -> Bool
    `named` Name
    "pad" = do
            let bytes :: Maybe (GenStructElem typ)
    bytes = (Int -> GenStructElem typ)
    -> Maybe Int -> Maybe (GenStructElem typ)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (PadType -> Int -> GenStructElem typ
    forall typ. PadType -> Int -> GenStructElem typ
    Pad PadType
    PadBytes) (Maybe Int -> Maybe (GenStructElem typ))
    -> Maybe Int -> Maybe (GenStructElem typ)
    forall a b. (a -> b) -> a -> b
    $ Element
    el Element -> Name -> Maybe Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "bytes" Maybe Name -> (Name -> Maybe Int) -> Maybe Int
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Name -> Maybe Int
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Name -> m a
    readM
            let align :: Maybe (GenStructElem typ)
    align = (Int -> GenStructElem typ)
    -> Maybe Int -> Maybe (GenStructElem typ)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (PadType -> Int -> GenStructElem typ
    forall typ. PadType -> Int -> GenStructElem typ
    Pad PadType
    PadAlignment) (Maybe Int -> Maybe (GenStructElem typ))
    -> Maybe Int -> Maybe (GenStructElem typ)
    forall a b. (a -> b) -> a -> b
    $ Element
    el Element -> Name -> Maybe Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "align" Maybe Name -> (Name -> Maybe Int) -> Maybe Int
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Name -> Maybe Int
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Name -> m a
    readM

            GenStructElem Type -> m (GenStructElem Type)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenStructElem Type -> m (GenStructElem Type))
    -> GenStructElem Type -> m (GenStructElem Type)
    forall a b. (a -> b) -> a -> b
    $ [GenStructElem Type] -> GenStructElem Type
    forall a. HasCallStack => [a] -> a
    head ([GenStructElem Type] -> GenStructElem Type)
    -> [GenStructElem Type] -> GenStructElem Type
    forall a b. (a -> b) -> a -> b
    $ [Maybe (GenStructElem Type)] -> [GenStructElem Type]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe (GenStructElem Type)] -> [GenStructElem Type])
    -> [Maybe (GenStructElem Type)] -> [GenStructElem Type]
    forall a b. (a -> b) -> a -> b
    $ [Maybe (GenStructElem Type)
    forall {typ}. Maybe (GenStructElem typ)
    bytes, Maybe (GenStructElem Type)
    forall {typ}. Maybe (GenStructElem typ)
    align]

        | Element
    el Element -> Name -> Bool
    `named` Name
    "list" = do
            typ <- (Name -> Type) -> m Name -> m Type
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Name -> Type
    mkType (m Name -> m Type) -> m Name -> m Type
    forall a b. (a -> b) -> a -> b
    $ Element
    el Element -> Name -> m Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "type"
            name <- el `attr` "name"
            let enum = (Name -> Type) -> Maybe Name -> Maybe Type
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Name -> Type
    mkType (Maybe Name -> Maybe Type) -> Maybe Name -> Maybe Type
    forall a b. (a -> b) -> a -> b
    $ Element
    el Element -> Name -> Maybe Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "enum"
            let expr = Element -> Maybe Element
    forall (m :: * -> *). MonadPlus m => Element -> m Element
    firstChild Element
    el Maybe Element
    -> (Element -> Maybe XExpression) -> Maybe XExpression
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Element -> Maybe XExpression
    forall (m :: * -> *).
    (MonadFail m, MonadPlus m, Functor m) =>
    Element -> m XExpression
    expression
            return $ List name typ expr enum

        | Element
    el Element -> Name -> Bool
    `named` Name
    "valueparam" = do
            mask_typ <- (Name -> Type) -> m Name -> m Type
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Name -> Type
    mkType (m Name -> m Type) -> m Name -> m Type
    forall a b. (a -> b) -> a -> b
    $ Element
    el Element -> Name -> m Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "value-mask-type"
            mask_name <- el `attr` "value-mask-name"
            let mask_pad = Element
    el Element -> Name -> Maybe Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "value-mask-pad" Maybe Name -> (Name -> Maybe Int) -> Maybe Int
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Name -> Maybe Int
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Name -> m a
    readM
            list_name <- el `attr` "value-list-name"
            return $ ValueParam mask_typ mask_name mask_pad list_name

        | Element
    el Element -> Name -> Bool
    `named` Name
    "switch" = do
            nm <- Element
    el Element -> Name -> m Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "name"
            (exprEl,caseEls) <- unconsChildren el
            expr <- expression exprEl
            (alignment, xs) <- extractAlignment $ caseEls
            cases <- mapM bitCase xs
            return $ Switch nm expr alignment cases

        | Element
    el Element -> Name -> Bool
    `named` Name
    "exprfield" = do
            typ <- (Name -> Type) -> m Name -> m Type
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Name -> Type
    mkType (m Name -> m Type) -> m Name -> m Type
    forall a b. (a -> b) -> a -> b
    $ Element
    el Element -> Name -> m Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "type"
            name <- el `attr` "name"
            expr <- firstChild el >>= expression
            return $ ExprField name typ expr

        | Element
    el Element -> Name -> Bool
    `named` Name
    "reply" = Name -> m (GenStructElem Type)
    forall a. Name -> m a
    forall (m :: * -> *) a. MonadFail m => Name -> m a
    fail Name
    "" -- handled separate

        | Element
    el Element -> Name -> Bool
    `named` Name
    "doc" = do
            fields <- Element
    el Element -> Name -> m [Element]
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m [Element]
    `children` Name
    "field"
            let mkField = \Element
    x -> (Name -> (Name, Name)) -> Maybe Name -> Maybe (Name, Name)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\Name
    y -> (Name
    y, Element -> Name
    strContent Element
    x)) (Maybe Name -> Maybe (Name, Name))
    -> Maybe Name -> Maybe (Name, Name)
    forall a b. (a -> b) -> a -> b
    $ Element
    x Element -> Name -> Maybe Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "name"
                fields' = [(Name, Name)] -> Map Name Name
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(Name, Name)] -> Map Name Name)
    -> [(Name, Name)] -> Map Name Name
    forall a b. (a -> b) -> a -> b
    $ [Maybe (Name, Name)] -> [(Name, Name)]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe (Name, Name)] -> [(Name, Name)])
    -> [Maybe (Name, Name)] -> [(Name, Name)]
    forall a b. (a -> b) -> a -> b
    $ (Element -> Maybe (Name, Name))
    -> [Element] -> [Maybe (Name, Name)]
    forall a b. (a -> b) -> [a] -> [b]
    map Element -> Maybe (Name, Name)
    mkField [Element]
    fields
                sees = QName -> Element -> [Element]
    findChildren (Name -> QName
    unqual Name
    "see") Element
    el
                sees' = [Maybe (Name, Name)] -> [(Name, Name)]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe (Name, Name)] -> [(Name, Name)])
    -> [Maybe (Name, Name)] -> [(Name, Name)]
    forall a b. (a -> b) -> a -> b
    $ ((Element -> Maybe (Name, Name))
     -> [Element] -> [Maybe (Name, Name)])
    -> [Element]
    -> (Element -> Maybe (Name, Name))
    -> [Maybe (Name, Name)]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Element -> Maybe (Name, Name))
    -> [Element] -> [Maybe (Name, Name)]
    forall a b. (a -> b) -> [a] -> [b]
    map [Element]
    sees ((Element -> Maybe (Name, Name)) -> [Maybe (Name, Name)])
    -> (Element -> Maybe (Name, Name)) -> [Maybe (Name, Name)]
    forall a b. (a -> b) -> a -> b
    $ \Element
    s -> do typ <- Element
    s Element -> Name -> Maybe Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "type"
                                                             name <- s `attr` "name"
                                                             return (typ, name)
                brief = (Element -> Name) -> Maybe Element -> Maybe Name
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Element -> Name
    strContent (Maybe Element -> Maybe Name) -> Maybe Element -> Maybe Name
    forall a b. (a -> b) -> a -> b
    $ QName -> Element -> Maybe Element
    findChild (Name -> QName
    unqual Name
    "brief") Element
    el
            return $ Doc brief fields' sees'

        | Element
    el Element -> Name -> Bool
    `named` Name
    "fd" = do
            name <- Element
    el Element -> Name -> m Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "name"
            return $ Fd name

        | Element
    el Element -> Name -> Bool
    `named` Name
    "length" = do
            expr <- Element -> m Element
    forall (m :: * -> *). MonadPlus m => Element -> m Element
    firstChild Element
    el m Element -> (Element -> m XExpression) -> m XExpression
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Element -> m XExpression
    forall (m :: * -> *).
    (MonadFail m, MonadPlus m, Functor m) =>
    Element -> m XExpression
    expression
            let typ = Name -> Type
    mkType Name
    "CARD32"
            return $ Length typ expr

        | Bool
    otherwise = let name :: QName
    name = Element -> QName
    elName Element
    el
                      in Name -> m (GenStructElem Type)
    forall a. HasCallStack => Name -> a
    error (Name -> m (GenStructElem Type)) -> Name -> m (GenStructElem Type)
    forall a b. (a -> b) -> a -> b
    $ Name
    "I don't know what to do with structelem "
     Name -> Name -> Name
    forall a. [a] -> [a] -> [a]
    ++ QName -> Name
    forall a. Show a => a -> Name
    show QName
    name

    bitCase :: (MonadFail m, MonadPlus m, Functor m) => Element -> m BitCase
    bitCase :: forall (m :: * -> *).
    (MonadFail m, MonadPlus m, Functor m) =>
    Element -> m BitCase
    bitCase Element
    el | Element
    el Element -> Name -> Bool
    `named` Name
    "bitcase" Bool -> Bool -> Bool
    || Element
    el Element -> Name -> Bool
    `named` Name
    "case" = do
                  let mName :: Maybe Name
    mName = Element
    el Element -> Name -> Maybe Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "name"
                  (exprEl, fieldEls) <- Element -> m (Element, [Element])
    forall (m :: * -> *).
    MonadPlus m =>
    Element -> m (Element, [Element])
    unconsChildren Element
    el
                  expr <- expression exprEl
                  (alignment, xs) <- extractAlignment $ fieldEls
                  fields <- mapM structField xs
                  return $ BitCase mName expr alignment fields
               | Bool
    otherwise =
                  let name :: QName
    name = Element -> QName
    elName Element
    el
                  in Name -> m BitCase
    forall a. HasCallStack => Name -> a
    error (Name -> m BitCase) -> Name -> m BitCase
    forall a b. (a -> b) -> a -> b
    $ Name
    "Invalid bitCase: " Name -> Name -> Name
    forall a. [a] -> [a] -> [a]
    ++ QName -> Name
    forall a. Show a => a -> Name
    show QName
    name

    expression :: (MonadFail m, MonadPlus m, Functor m) => Element -> m XExpression
    expression :: forall (m :: * -> *).
    (MonadFail m, MonadPlus m, Functor m) =>
    Element -> m XExpression
    expression Element
    el | Element
    el Element -> Name -> Bool
    `named` Name
    "fieldref"
                        = XExpression -> m XExpression
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XExpression -> m XExpression) -> XExpression -> m XExpression
    forall a b. (a -> b) -> a -> b
    $ Name -> XExpression
    forall typ. Name -> Expression typ
    FieldRef (Name -> XExpression) -> Name -> XExpression
    forall a b. (a -> b) -> a -> b
    $ Element -> Name
    strContent Element
    el
                  | Element
    el Element -> Name -> Bool
    `named` Name
    "enumref" = do
                       enumTy <- Name -> Type
    mkType (Name -> Type) -> m Name -> m Type
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Element
    el Element -> Name -> m Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "ref"
                       let enumVal = Element -> Name
    strContent Element
    el
                       guard $ enumVal /= ""
                       return $ EnumRef enumTy enumVal
                  | Element
    el Element -> Name -> Bool
    `named` Name
    "value"
                        = Int -> XExpression
    forall typ. Int -> Expression typ
    Value (Int -> XExpression) -> m Int -> m XExpression
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` Name -> m Int
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Name -> m a
    readM (Element -> Name
    strContent Element
    el)
                  | Element
    el Element -> Name -> Bool
    `named` Name
    "bit"
                        = Int -> XExpression
    forall typ. Int -> Expression typ
    Bit (Int -> XExpression) -> m Int -> m XExpression
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` do
                            n <- Name -> m Int
    forall (m :: * -> *) a. (MonadPlus m, Read a) => Name -> m a
    readM (Element -> Name
    strContent Element
    el)
                            guard $ n >= 0
                            return n
                  | Element
    el Element -> Name -> Bool
    `named` Name
    "op" = do
                        binop <- Element
    el Element -> Name -> m Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "op" m Name -> (Name -> m Binop) -> m Binop
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Name -> m Binop
    forall (m :: * -> *). MonadPlus m => Name -> m Binop
    toBinop
                        [exprLhs,exprRhs] <- mapM expression $ elChildren el
                        return $ Op binop exprLhs exprRhs
                  | Element
    el Element -> Name -> Bool
    `named` Name
    "unop" = do
                        op <- Element
    el Element -> Name -> m Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "op" m Name -> (Name -> m Unop) -> m Unop
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Name -> m Unop
    forall (m :: * -> *). MonadPlus m => Name -> m Unop
    toUnop
                        expr <- firstChild el >>= expression
                        return $ Unop op expr
                  | Element
    el Element -> Name -> Bool
    `named` Name
    "popcount" = do
                        expr <- Element -> m Element
    forall (m :: * -> *). MonadPlus m => Element -> m Element
    firstChild Element
    el m Element -> (Element -> m XExpression) -> m XExpression
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Element -> m XExpression
    forall (m :: * -> *).
    (MonadFail m, MonadPlus m, Functor m) =>
    Element -> m XExpression
    expression
                        return $ PopCount expr
                  | Element
    el Element -> Name -> Bool
    `named` Name
    "sumof" = do
                        ref <- Element
    el Element -> Name -> m Name
    forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    "ref"
                        return $ SumOf ref
                  | Element
    el Element -> Name -> Bool
    `named` Name
    "paramref"
                        =  XExpression -> m XExpression
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XExpression -> m XExpression) -> XExpression -> m XExpression
    forall a b. (a -> b) -> a -> b
    $ Name -> XExpression
    forall typ. Name -> Expression typ
    ParamRef (Name -> XExpression) -> Name -> XExpression
    forall a b. (a -> b) -> a -> b
    $ Element -> Name
    strContent Element
    el
                  | Bool
    otherwise =
                      let nm :: QName
    nm = Element -> QName
    elName Element
    el
                      in Name -> m XExpression
    forall a. HasCallStack => Name -> a
    error (Name -> m XExpression) -> Name -> m XExpression
    forall a b. (a -> b) -> a -> b
    $ Name
    "Unknown epression " Name -> Name -> Name
    forall a. [a] -> [a] -> [a]
    ++ QName -> Name
    forall a. Show a => a -> Name
    show QName
    nm Name -> Name -> Name
    forall a. [a] -> [a] -> [a]
    ++ Name
    " in Data.XCB.FromXML.expression"

    toBinop :: MonadPlus m => String -> m Binop
    toBinop :: forall (m :: * -> *). MonadPlus m => Name -> m Binop
    toBinop Name
    "+"  = Binop -> m Binop
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Binop
    Add
    toBinop Name
    "-"  = Binop -> m Binop
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Binop
    Sub
    toBinop Name
    "*"  = Binop -> m Binop
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Binop
    Mult
    toBinop Name
    "/"  = Binop -> m Binop
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Binop
    Div
    toBinop Name
    "&"  = Binop -> m Binop
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Binop
    And
    toBinop Name
    "&amp;" = Binop -> m Binop
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Binop
    And
    toBinop Name
    ">>" = Binop -> m Binop
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Binop
    RShift
    toBinop Name
    _ = m Binop
    forall a. m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    toUnop :: MonadPlus m => String -> m Unop
    toUnop :: forall (m :: * -> *). MonadPlus m => Name -> m Unop
    toUnop Name
    "~" = Unop -> m Unop
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Unop
    Complement
    toUnop Name
    _ = m Unop
    forall a. m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    ----
    ----
    -- Utility functions
    ----
    ----

    firstChild :: MonadPlus m => Element -> m Element
    firstChild :: forall (m :: * -> *). MonadPlus m => Element -> m Element
    firstChild = [Element] -> m Element
    forall (m :: * -> *) a. MonadPlus m => [a] -> m a
    listToM ([Element] -> m Element)
    -> (Element -> [Element]) -> Element -> m Element
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Element -> [Element]
    elChildren

    unconsChildren :: MonadPlus m => Element -> m (Element, [Element])
    unconsChildren :: forall (m :: * -> *).
    MonadPlus m =>
    Element -> m (Element, [Element])
    unconsChildren Element
    el
        = case Element -> [Element]
    elChildren Element
    el of
            (Element
    x:[Element]
    xs) -> (Element, [Element]) -> m (Element, [Element])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Element
    x,[Element]
    xs)
            [Element]
    _ -> m (Element, [Element])
    forall a. m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    listToM :: MonadPlus m => [a] -> m a
    listToM :: forall (m :: * -> *) a. MonadPlus m => [a] -> m a
    listToM [] = m a
    forall a. m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
    listToM (a
    x:[a]
    _) = a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x

    named :: Element -> String -> Bool
    named :: Element -> Name -> Bool
    named (Element QName
    qname [Attr]
    _ [Content]
    _ Maybe Line
    _) Name
    name | QName
    qname QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> QName
    unqual Name
    name = Bool
    True
    named Element
    _ Name
    _ = Bool
    False

    attr :: MonadPlus m => Element -> String -> m String
    (Element QName
    _ [Attr]
    xs [Content]
    _ Maybe Line
    _) attr :: forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
    `attr` Name
    name = case (Attr -> Bool) -> [Attr] -> Maybe Attr
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    List.find Attr -> Bool
    p [Attr]
    xs of
          Just (Attr QName
    _ Name
    res) -> Name -> m Name
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    res
          Maybe Attr
    _ -> m Name
    forall a. m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
        where p :: Attr -> Bool
    p (Attr QName
    qname Name
    _) | QName
    qname QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> QName
    unqual Name
    name = Bool
    True
              p Attr
    _ = Bool
    False

    children :: MonadPlus m => Element -> String -> m [Element]
    (Element QName
    _ [Attr]
    _ [Content]
    xs Maybe Line
    _) children :: forall (m :: * -> *). MonadPlus m => Element -> Name -> m [Element]
    `children` Name
    name = case (Content -> Bool) -> [Content] -> [Content]
    forall a. (a -> Bool) -> [a] -> [a]
    List.filter Content -> Bool
    p [Content]
    xs of
          [] -> m [Element]
    forall a. m a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
          [Content]
    some -> [Element] -> m [Element]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Element] -> m [Element]) -> [Element] -> m [Element]
    forall a b. (a -> b) -> a -> b
    $ [Content] -> [Element]
    onlyElems [Content]
    some
        where p :: Content -> Bool
    p (Elem (Element QName
    n [Attr]
    _ [Content]
    _ Maybe Line
    _)) | QName
    n QName -> QName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> QName
    unqual Name
    name = Bool
    True
              p Content
    _ = Bool
    False

    -- adapted from Network.CGI.Protocol
    readM :: (MonadPlus m, Read a) => String -> m a
    readM :: forall (m :: * -> *) a. (MonadPlus m, Read a) => Name -> m a
    readM = ((a, Name) -> a) -> m (a, Name) -> m a
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (a, Name) -> a
    forall a b. (a, b) -> a
    fst (m (a, Name) -> m a) -> (Name -> m (a, Name)) -> Name -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(a, Name)] -> m (a, Name)
    forall (m :: * -> *) a. MonadPlus m => [a] -> m a
    listToM ([(a, Name)] -> m (a, Name))
    -> (Name -> [(a, Name)]) -> Name -> m (a, Name)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> [(a, Name)]
    forall a. Read a => ReadS a
    reads