-- |
-- 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.
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

import Control.Applicative ((<$>))
import Control.Monad
import Control.Monad.Fail (MonadFail)
import Control.Monad.Reader

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 :: [FilePath] -> IO [XHeader]
fromFiles xs :: [FilePath]
xs = do
  [FilePath]
strings <- [IO FilePath] -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([IO FilePath] -> IO [FilePath]) -> [IO FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO FilePath) -> [FilePath] -> [IO FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> IO FilePath
readFileUTF8 [FilePath]
xs
  [XHeader] -> IO [XHeader]
forall (m :: * -> *) a. Monad m => a -> m a
return ([XHeader] -> IO [XHeader]) -> [XHeader] -> IO [XHeader]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [XHeader]
fromStrings [FilePath]
strings

-- | Like 'readFile', but forces the encoding
-- of the file to UTF8.
readFileUTF8 :: FilePath -> IO String
readFileUTF8 :: FilePath -> IO FilePath
readFileUTF8 fp :: FilePath
fp = do
  Handle
h <- FilePath -> IOMode -> IO Handle
openFile FilePath
fp IOMode
ReadMode
  Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8
  Handle -> IO FilePath
hGetContents Handle
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 :: [FilePath] -> [XHeader]
fromStrings xs :: [FilePath]
xs =
   let rs :: ReaderT [XHeader] Maybe [XHeader]
rs = (FilePath -> ReaderT [XHeader] Maybe XHeader)
-> [FilePath] -> ReaderT [XHeader] Maybe [XHeader]
forall (f :: * -> *) a b.
Alternative f =>
(a -> f b) -> [a] -> f [b]
mapAlt FilePath -> ReaderT [XHeader] Maybe XHeader
fromString [FilePath]
xs
       Just headers :: [XHeader]
headers = 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 FilePath
localName = ([XHeader], FilePath) -> FilePath
forall a b. (a, b) -> b
snd (([XHeader], FilePath) -> FilePath)
-> ReaderT ([XHeader], FilePath) Maybe ([XHeader], FilePath)
-> Parse FilePath
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ReaderT ([XHeader], FilePath) Maybe ([XHeader], FilePath)
forall r (m :: * -> *). MonadReader r m => m r
ask

allModules :: Parse [XHeader]
allModules :: Parse [XHeader]
allModules = ([XHeader], FilePath) -> [XHeader]
forall a b. (a, b) -> a
fst (([XHeader], FilePath) -> [XHeader])
-> ReaderT ([XHeader], FilePath) Maybe ([XHeader], FilePath)
-> Parse [XHeader]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ReaderT ([XHeader], FilePath) Maybe ([XHeader], FilePath)
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 :: [Element] -> m (Maybe Alignment, [Element])
extractAlignment (el :: Element
el : xs :: [Element]
xs) | Element
el Element -> FilePath -> Bool
`named` "required_start_align" = do
                               Int
align <- Element
el Element -> FilePath -> m FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "align" m FilePath -> (FilePath -> m Int) -> m Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> m Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => FilePath -> m a
readM
                               Int
offset <- Element
el Element -> FilePath -> m FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "offset" m FilePath -> (FilePath -> m Int) -> m Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> m Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => FilePath -> m a
readM
                               (Maybe Alignment, [Element]) -> m (Maybe Alignment, [Element])
forall (m :: * -> *) a. Monad m => a -> m a
return (Alignment -> Maybe Alignment
forall a. a -> Maybe a
Just (Int -> Int -> Alignment
Alignment Int
align Int
offset), [Element]
xs)
                           | Bool
otherwise = (Maybe Alignment, [Element]) -> m (Maybe Alignment, [Element])
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 xs :: [Element]
xs = (Maybe Alignment, [Element]) -> m (Maybe Alignment, [Element])
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 :: ([XDecl] -> Maybe a) -> Maybe FilePath -> Parse (Maybe a)
lookupThingy f :: [XDecl] -> Maybe a
f Nothing = do
  FilePath
lname <- Parse FilePath
localName
  (Maybe a -> Maybe a -> Maybe a)
-> Parse (Maybe a) -> Parse (Maybe a) -> Parse (Maybe a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (([XDecl] -> Maybe a) -> Maybe FilePath -> Parse (Maybe a)
forall a. ([XDecl] -> Maybe a) -> Maybe FilePath -> Parse (Maybe a)
lookupThingy [XDecl] -> Maybe a
f (Maybe FilePath -> Parse (Maybe a))
-> Maybe FilePath -> Parse (Maybe a)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
lname)
               (([XDecl] -> Maybe a) -> Maybe FilePath -> Parse (Maybe a)
forall a. ([XDecl] -> Maybe a) -> Maybe FilePath -> Parse (Maybe a)
lookupThingy [XDecl] -> Maybe a
f (Maybe FilePath -> Parse (Maybe a))
-> Maybe FilePath -> Parse (Maybe a)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "xproto") -- implicit xproto import
lookupThingy f :: [XDecl] -> Maybe a
f (Just mname :: FilePath
mname) = do
  [XHeader]
xs <- Parse [XHeader]
allModules
  Maybe a -> Parse (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Parse (Maybe a)) -> Maybe a -> Parse (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
    XHeader
x <- FilePath -> [XHeader] -> Maybe XHeader
findXHeader FilePath
mname [XHeader]
xs
    [XDecl] -> Maybe a
f ([XDecl] -> Maybe a) -> [XDecl] -> Maybe a
forall a b. (a -> b) -> a -> b
$ XHeader -> [XDecl]
forall typ. GenXHeader typ -> [GenXDecl typ]
xheader_decls XHeader
x

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

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

findXHeader :: Name -> [XHeader] -> Maybe XHeader
findXHeader :: FilePath -> [XHeader] -> Maybe XHeader
findXHeader name :: FilePath
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
$ \ x :: XHeader
x -> XHeader -> FilePath
forall typ. GenXHeader typ -> FilePath
xheader_header XHeader
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
name

findError :: Name -> [XDecl] -> Maybe ErrorDetails
findError :: FilePath -> [XDecl] -> Maybe ErrorDetails
findError pname :: FilePath
pname xs :: [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
        Nothing -> Maybe ErrorDetails
forall a. Maybe a
Nothing
        Just (XError name :: FilePath
name code :: Int
code alignment :: Maybe Alignment
alignment elems :: [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
$ FilePath
-> Int -> Maybe Alignment -> [GenStructElem Type] -> ErrorDetails
ErrorDetails FilePath
name Int
code Maybe Alignment
alignment [GenStructElem Type]
elems
        _ -> FilePath -> Maybe ErrorDetails
forall a. HasCallStack => FilePath -> a
error "impossible: fatal error in Data.XCB.FromXML.findError"
    where  f :: GenXDecl typ -> Bool
f (XError name :: FilePath
name _ _ _) | FilePath
name FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
pname = Bool
True
           f _ = Bool
False 
                                       
findEvent :: Name -> [XDecl] -> Maybe EventDetails
findEvent :: FilePath -> [XDecl] -> Maybe EventDetails
findEvent pname :: FilePath
pname xs :: [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
        Nothing -> Maybe EventDetails
forall a. Maybe a
Nothing
        Just (XEvent name :: FilePath
name code :: Int
code alignment :: Maybe Alignment
alignment elems :: [GenStructElem Type]
elems noseq :: 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
$ FilePath
-> Int
-> Maybe Alignment
-> [GenStructElem Type]
-> Maybe Bool
-> EventDetails
EventDetails FilePath
name Int
code Maybe Alignment
alignment [GenStructElem Type]
elems Maybe Bool
noseq
        _ -> FilePath -> Maybe EventDetails
forall a. HasCallStack => FilePath -> a
error "impossible: fatal error in Data.XCB.FromXML.findEvent"
   where f :: GenXDecl typ -> Bool
f (XEvent name :: FilePath
name _ _ _ _) | FilePath
name FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
pname = Bool
True
         f _ = Bool
False 

data EventDetails = EventDetails Name Int (Maybe Alignment) [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 :: FilePath -> ReaderT [XHeader] Maybe XHeader
fromString str :: FilePath
str = do
  el :: Element
el@(Element _qname :: QName
_qname _ats :: [Attr]
_ats cnt :: [Content]
cnt _) <- Maybe Element -> ReaderT [XHeader] Maybe Element
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
$ FilePath -> Maybe Element
forall s. XmlSource s => s -> Maybe Element
parseXMLDoc FilePath
str
  Bool -> ReaderT [XHeader] Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ReaderT [XHeader] Maybe ())
-> Bool -> ReaderT [XHeader] Maybe ()
forall a b. (a -> b) -> a -> b
$ Element
el Element -> FilePath -> Bool
`named` "xcb"
  FilePath
header <- Element
el Element -> FilePath -> ReaderT [XHeader] Maybe FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "header"
  let name :: Maybe FilePath
name = Element
el Element -> FilePath -> Maybe FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "extension-name"
      xname :: Maybe FilePath
xname = Element
el Element -> FilePath -> Maybe FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "extension-xname"
      maj_ver :: Maybe Int
maj_ver = Element
el Element -> FilePath -> Maybe FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "major-version" Maybe FilePath -> (FilePath -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => FilePath -> m a
readM
      min_ver :: Maybe Int
min_ver = Element
el Element -> FilePath -> Maybe FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "minor-version" Maybe FilePath -> (FilePath -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => FilePath -> m a
readM
      multiword :: Maybe Bool
multiword = Element
el Element -> FilePath -> Maybe FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "extension-multiword" Maybe FilePath -> (FilePath -> Maybe Bool) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Maybe Bool
forall (m :: * -> *) a. (MonadPlus m, Read a) => FilePath -> m a
readM (FilePath -> Maybe Bool)
-> (FilePath -> FilePath) -> FilePath -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
ensureUpper
  [XDecl]
decls <- ([XHeader] -> ([XHeader], FilePath))
-> ReaderT ([XHeader], FilePath) Maybe [XDecl]
-> ReaderT [XHeader] Maybe [XDecl]
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (\r :: [XHeader]
r -> ([XHeader]
r,FilePath
header)) (ReaderT ([XHeader], FilePath) Maybe [XDecl]
 -> ReaderT [XHeader] Maybe [XDecl])
-> ReaderT ([XHeader], FilePath) Maybe [XDecl]
-> ReaderT [XHeader] Maybe [XDecl]
forall a b. (a -> b) -> a -> b
$ [Content] -> ReaderT ([XHeader], FilePath) Maybe [XDecl]
extractDecls [Content]
cnt
  XHeader -> ReaderT [XHeader] Maybe XHeader
forall (m :: * -> *) a. Monad m => a -> m a
return (XHeader -> ReaderT [XHeader] Maybe XHeader)
-> XHeader -> ReaderT [XHeader] Maybe XHeader
forall a b. (a -> b) -> a -> b
$ XHeader :: forall typ.
FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe Bool
-> Maybe Int
-> Maybe Int
-> [GenXDecl typ]
-> GenXHeader typ
XHeader {xheader_header :: FilePath
xheader_header = FilePath
header
                   ,xheader_xname :: Maybe FilePath
xheader_xname = Maybe FilePath
xname
                   ,xheader_name :: Maybe FilePath
xheader_name = Maybe FilePath
name
                   ,xheader_multiword :: Maybe Bool
xheader_multiword = Maybe Bool
multiword
                   ,xheader_major_version :: Maybe Int
xheader_major_version = Maybe Int
maj_ver
                   ,xheader_minor_version :: Maybe Int
xheader_minor_version = Maybe Int
min_ver
                   ,xheader_decls :: [XDecl]
xheader_decls = [XDecl]
decls
                   }

-- attempts to extract declarations from XML content, discarding failures.
extractDecls :: [Content] -> Parse [XDecl]
extractDecls :: [Content] -> ReaderT ([XHeader], FilePath) Maybe [XDecl]
extractDecls = (Element -> ReaderT ([XHeader], FilePath) Maybe XDecl)
-> [Element] -> ReaderT ([XHeader], FilePath) Maybe [XDecl]
forall (f :: * -> *) a b.
Alternative f =>
(a -> f b) -> [a] -> f [b]
mapAlt Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
declFromElem ([Element] -> ReaderT ([XHeader], FilePath) Maybe [XDecl])
-> ([Content] -> [Element])
-> [Content]
-> ReaderT ([XHeader], FilePath) 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], FilePath) Maybe XDecl
declFromElem el :: Element
el
    | Element
el Element -> FilePath -> Bool
`named` "request" = Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xrequest Element
el
    | Element
el Element -> FilePath -> Bool
`named` "event"   = Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xevent Element
el
    | Element
el Element -> FilePath -> Bool
`named` "eventcopy" = Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xevcopy Element
el
    | Element
el Element -> FilePath -> Bool
`named` "error" = Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xerror Element
el
    | Element
el Element -> FilePath -> Bool
`named` "errorcopy" = Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xercopy Element
el
    | Element
el Element -> FilePath -> Bool
`named` "struct" = Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xstruct Element
el
    | Element
el Element -> FilePath -> Bool
`named` "union" = Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xunion Element
el
    | Element
el Element -> FilePath -> Bool
`named` "xidtype" = Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xidtype Element
el
    | Element
el Element -> FilePath -> Bool
`named` "xidunion" = Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xidunion Element
el
    | Element
el Element -> FilePath -> Bool
`named` "typedef" = Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xtypedef Element
el
    | Element
el Element -> FilePath -> Bool
`named` "enum" = Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xenum Element
el
    | Element
el Element -> FilePath -> Bool
`named` "import" = Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
ximport Element
el
    | Element
el Element -> FilePath -> Bool
`named` "eventstruct" = Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xeventstruct Element
el
    | Bool
otherwise = ReaderT ([XHeader], FilePath) Maybe XDecl
forall (m :: * -> *) a. MonadPlus m => m a
mzero


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

xenum :: Element -> Parse XDecl
xenum :: Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xenum el :: Element
el = do
  FilePath
nm <- Element
el Element -> FilePath -> Parse FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "name"
  [EnumElem Type]
fields <- (Element -> ReaderT ([XHeader], FilePath) Maybe (EnumElem Type))
-> [Element] -> ReaderT ([XHeader], FilePath) Maybe [EnumElem Type]
forall (f :: * -> *) a b.
Alternative f =>
(a -> f b) -> [a] -> f [b]
mapAlt Element -> ReaderT ([XHeader], FilePath) Maybe (EnumElem Type)
enumField ([Element] -> ReaderT ([XHeader], FilePath) Maybe [EnumElem Type])
-> [Element] -> ReaderT ([XHeader], FilePath) Maybe [EnumElem Type]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
el
  Bool -> ReaderT ([XHeader], FilePath) Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ReaderT ([XHeader], FilePath) Maybe ())
-> Bool -> ReaderT ([XHeader], FilePath) Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [EnumElem Type] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EnumElem Type]
fields
  XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl)
-> XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl
forall a b. (a -> b) -> a -> b
$ FilePath -> [EnumElem Type] -> XDecl
forall typ. FilePath -> [EnumElem typ] -> GenXDecl typ
XEnum FilePath
nm [EnumElem Type]
fields

enumField :: Element -> Parse (EnumElem Type)
enumField :: Element -> ReaderT ([XHeader], FilePath) Maybe (EnumElem Type)
enumField el :: Element
el = do
  Bool -> ReaderT ([XHeader], FilePath) Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ReaderT ([XHeader], FilePath) Maybe ())
-> Bool -> ReaderT ([XHeader], FilePath) Maybe ()
forall a b. (a -> b) -> a -> b
$ Element
el Element -> FilePath -> Bool
`named` "item"
  FilePath
name <- Element
el Element -> FilePath -> Parse FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "name"
  let expr :: Maybe XExpression
expr = Element -> Maybe Element
forall (m :: * -> *). MonadPlus m => Element -> m Element
firstChild Element
el Maybe Element
-> (Element -> Maybe XExpression) -> Maybe XExpression
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
  EnumElem Type
-> ReaderT ([XHeader], FilePath) Maybe (EnumElem Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumElem Type
 -> ReaderT ([XHeader], FilePath) Maybe (EnumElem Type))
-> EnumElem Type
-> ReaderT ([XHeader], FilePath) Maybe (EnumElem Type)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe XExpression -> EnumElem Type
forall typ. FilePath -> Maybe (Expression typ) -> EnumElem typ
EnumElem FilePath
name Maybe XExpression
expr

xrequest :: Element -> Parse XDecl
xrequest :: Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xrequest el :: Element
el = do
  FilePath
nm <- Element
el Element -> FilePath -> Parse FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "name"
  Int
code <- Element
el Element -> FilePath -> Parse FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "opcode" Parse FilePath
-> (FilePath -> ReaderT ([XHeader], FilePath) Maybe Int)
-> ReaderT ([XHeader], FilePath) Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> ReaderT ([XHeader], FilePath) Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => FilePath -> m a
readM
  -- TODO - I don't think I like 'mapAlt' here.
  -- I don't want to be silently dropping fields
  (alignment :: Maybe Alignment
alignment, xs :: [Element]
xs) <- [Element]
-> ReaderT ([XHeader], FilePath) Maybe (Maybe Alignment, [Element])
forall (m :: * -> *).
(MonadPlus m, Functor m) =>
[Element] -> m (Maybe Alignment, [Element])
extractAlignment ([Element]
 -> ReaderT
      ([XHeader], FilePath) Maybe (Maybe Alignment, [Element]))
-> [Element]
-> ReaderT ([XHeader], FilePath) Maybe (Maybe Alignment, [Element])
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
el
  [GenStructElem Type]
fields <- (Element
 -> ReaderT ([XHeader], FilePath) Maybe (GenStructElem Type))
-> [Element]
-> ReaderT ([XHeader], FilePath) Maybe [GenStructElem Type]
forall (f :: * -> *) a b.
Alternative f =>
(a -> f b) -> [a] -> f [b]
mapAlt Element -> ReaderT ([XHeader], FilePath) Maybe (GenStructElem Type)
forall (m :: * -> *).
(MonadFail m, MonadPlus m, Functor m) =>
Element -> m (GenStructElem Type)
structField ([Element]
 -> ReaderT ([XHeader], FilePath) Maybe [GenStructElem Type])
-> [Element]
-> ReaderT ([XHeader], FilePath) Maybe [GenStructElem Type]
forall a b. (a -> b) -> a -> b
$ [Element]
xs
  let reply :: Maybe XReply
reply = Element -> Maybe XReply
getReply Element
el
  XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl)
-> XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl
forall a b. (a -> b) -> a -> b
$ FilePath
-> Int
-> Maybe Alignment
-> [GenStructElem Type]
-> Maybe XReply
-> XDecl
forall typ.
FilePath
-> Int
-> Maybe Alignment
-> [GenStructElem typ]
-> Maybe (GenXReply typ)
-> GenXDecl typ
XRequest FilePath
nm Int
code Maybe Alignment
alignment [GenStructElem Type]
fields Maybe XReply
reply

getReply :: Element -> Maybe XReply
getReply :: Element -> Maybe XReply
getReply el :: Element
el = do
  Element
childElem <- FilePath -> QName
unqual "reply" QName -> Element -> Maybe Element
`findChild` Element
el
  (alignment :: Maybe Alignment
alignment, xs :: [Element]
xs) <- [Element] -> Maybe (Maybe Alignment, [Element])
forall (m :: * -> *).
(MonadPlus m, Functor m) =>
[Element] -> m (Maybe Alignment, [Element])
extractAlignment ([Element] -> Maybe (Maybe Alignment, [Element]))
-> [Element] -> Maybe (Maybe Alignment, [Element])
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
childElem
  [GenStructElem Type]
fields <- (Element -> Maybe (GenStructElem Type))
-> [Element] -> Maybe [GenStructElem Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> Maybe (GenStructElem Type)
forall (m :: * -> *).
(MonadFail m, MonadPlus m, Functor m) =>
Element -> m (GenStructElem Type)
structField [Element]
xs
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [GenStructElem Type] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenStructElem Type]
fields
  XReply -> Maybe XReply
forall (m :: * -> *) a. Monad m => a -> m a
return (XReply -> Maybe XReply) -> XReply -> Maybe XReply
forall a b. (a -> b) -> a -> b
$ Maybe Alignment -> [GenStructElem Type] -> XReply
forall typ. Maybe Alignment -> [GenStructElem typ] -> GenXReply typ
GenXReply Maybe Alignment
alignment [GenStructElem Type]
fields

xevent :: Element -> Parse XDecl
xevent :: Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xevent el :: Element
el = do
  FilePath
name <- Element
el Element -> FilePath -> Parse FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "name"
  Int
number <- Element
el Element -> FilePath -> Parse FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "number" Parse FilePath
-> (FilePath -> ReaderT ([XHeader], FilePath) Maybe Int)
-> ReaderT ([XHeader], FilePath) Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> ReaderT ([XHeader], FilePath) Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => FilePath -> m a
readM
  let noseq :: Maybe Bool
noseq = FilePath -> FilePath
ensureUpper (FilePath -> FilePath) -> Maybe FilePath -> Maybe FilePath
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (Element
el Element -> FilePath -> Maybe FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "no-sequence-number") Maybe FilePath -> (FilePath -> Maybe Bool) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Maybe Bool
forall (m :: * -> *) a. (MonadPlus m, Read a) => FilePath -> m a
readM
  (alignment :: Maybe Alignment
alignment, xs :: [Element]
xs) <- [Element]
-> ReaderT ([XHeader], FilePath) Maybe (Maybe Alignment, [Element])
forall (m :: * -> *).
(MonadPlus m, Functor m) =>
[Element] -> m (Maybe Alignment, [Element])
extractAlignment (Element -> [Element]
elChildren Element
el)
  [GenStructElem Type]
fields <- (Element
 -> ReaderT ([XHeader], FilePath) Maybe (GenStructElem Type))
-> [Element]
-> ReaderT ([XHeader], FilePath) Maybe [GenStructElem Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> ReaderT ([XHeader], FilePath) Maybe (GenStructElem Type)
forall (m :: * -> *).
(MonadFail m, MonadPlus m, Functor m) =>
Element -> m (GenStructElem Type)
structField ([Element]
 -> ReaderT ([XHeader], FilePath) Maybe [GenStructElem Type])
-> [Element]
-> ReaderT ([XHeader], FilePath) Maybe [GenStructElem Type]
forall a b. (a -> b) -> a -> b
$ [Element]
xs
  Bool -> ReaderT ([XHeader], FilePath) Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ReaderT ([XHeader], FilePath) Maybe ())
-> Bool -> ReaderT ([XHeader], FilePath) Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [GenStructElem Type] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenStructElem Type]
fields
  XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl)
-> XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl
forall a b. (a -> b) -> a -> b
$ FilePath
-> Int
-> Maybe Alignment
-> [GenStructElem Type]
-> Maybe Bool
-> XDecl
forall typ.
FilePath
-> Int
-> Maybe Alignment
-> [GenStructElem typ]
-> Maybe Bool
-> GenXDecl typ
XEvent FilePath
name Int
number Maybe Alignment
alignment [GenStructElem Type]
fields Maybe Bool
noseq

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

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

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

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

xerror :: Element -> Parse XDecl
xerror :: Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xerror el :: Element
el = do
  FilePath
name <- Element
el Element -> FilePath -> Parse FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "name"
  Int
number <- Element
el Element -> FilePath -> Parse FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "number" Parse FilePath
-> (FilePath -> ReaderT ([XHeader], FilePath) Maybe Int)
-> ReaderT ([XHeader], FilePath) Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> ReaderT ([XHeader], FilePath) Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => FilePath -> m a
readM
  (alignment :: Maybe Alignment
alignment, xs :: [Element]
xs) <- [Element]
-> ReaderT ([XHeader], FilePath) Maybe (Maybe Alignment, [Element])
forall (m :: * -> *).
(MonadPlus m, Functor m) =>
[Element] -> m (Maybe Alignment, [Element])
extractAlignment ([Element]
 -> ReaderT
      ([XHeader], FilePath) Maybe (Maybe Alignment, [Element]))
-> [Element]
-> ReaderT ([XHeader], FilePath) Maybe (Maybe Alignment, [Element])
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
el
  [GenStructElem Type]
fields <- (Element
 -> ReaderT ([XHeader], FilePath) Maybe (GenStructElem Type))
-> [Element]
-> ReaderT ([XHeader], FilePath) Maybe [GenStructElem Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> ReaderT ([XHeader], FilePath) Maybe (GenStructElem Type)
forall (m :: * -> *).
(MonadFail m, MonadPlus m, Functor m) =>
Element -> m (GenStructElem Type)
structField ([Element]
 -> ReaderT ([XHeader], FilePath) Maybe [GenStructElem Type])
-> [Element]
-> ReaderT ([XHeader], FilePath) Maybe [GenStructElem Type]
forall a b. (a -> b) -> a -> b
$ [Element]
xs
  XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl)
-> XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl
forall a b. (a -> b) -> a -> b
$ FilePath -> Int -> Maybe Alignment -> [GenStructElem Type] -> XDecl
forall typ.
FilePath
-> Int -> Maybe Alignment -> [GenStructElem typ] -> GenXDecl typ
XError FilePath
name Int
number Maybe Alignment
alignment [GenStructElem Type]
fields


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

xstruct :: Element -> Parse XDecl
xstruct :: Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xstruct el :: Element
el = do
  FilePath
name <- Element
el Element -> FilePath -> Parse FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "name"
  (alignment :: Maybe Alignment
alignment, xs :: [Element]
xs) <- [Element]
-> ReaderT ([XHeader], FilePath) Maybe (Maybe Alignment, [Element])
forall (m :: * -> *).
(MonadPlus m, Functor m) =>
[Element] -> m (Maybe Alignment, [Element])
extractAlignment ([Element]
 -> ReaderT
      ([XHeader], FilePath) Maybe (Maybe Alignment, [Element]))
-> [Element]
-> ReaderT ([XHeader], FilePath) Maybe (Maybe Alignment, [Element])
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
el
  [GenStructElem Type]
fields <- (Element
 -> ReaderT ([XHeader], FilePath) Maybe (GenStructElem Type))
-> [Element]
-> ReaderT ([XHeader], FilePath) Maybe [GenStructElem Type]
forall (f :: * -> *) a b.
Alternative f =>
(a -> f b) -> [a] -> f [b]
mapAlt Element -> ReaderT ([XHeader], FilePath) Maybe (GenStructElem Type)
forall (m :: * -> *).
(MonadFail m, MonadPlus m, Functor m) =>
Element -> m (GenStructElem Type)
structField ([Element]
 -> ReaderT ([XHeader], FilePath) Maybe [GenStructElem Type])
-> [Element]
-> ReaderT ([XHeader], FilePath) Maybe [GenStructElem Type]
forall a b. (a -> b) -> a -> b
$ [Element]
xs
  Bool -> ReaderT ([XHeader], FilePath) Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ReaderT ([XHeader], FilePath) Maybe ())
-> Bool -> ReaderT ([XHeader], FilePath) Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [GenStructElem Type] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenStructElem Type]
fields
  XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl)
-> XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe Alignment -> [GenStructElem Type] -> XDecl
forall typ.
FilePath -> Maybe Alignment -> [GenStructElem typ] -> GenXDecl typ
XStruct FilePath
name Maybe Alignment
alignment [GenStructElem Type]
fields

xunion :: Element -> Parse XDecl
xunion :: Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xunion el :: Element
el = do
  FilePath
name <- Element
el Element -> FilePath -> Parse FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "name"
  (alignment :: Maybe Alignment
alignment, xs :: [Element]
xs) <- [Element]
-> ReaderT ([XHeader], FilePath) Maybe (Maybe Alignment, [Element])
forall (m :: * -> *).
(MonadPlus m, Functor m) =>
[Element] -> m (Maybe Alignment, [Element])
extractAlignment ([Element]
 -> ReaderT
      ([XHeader], FilePath) Maybe (Maybe Alignment, [Element]))
-> [Element]
-> ReaderT ([XHeader], FilePath) Maybe (Maybe Alignment, [Element])
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
el
  [GenStructElem Type]
fields <- (Element
 -> ReaderT ([XHeader], FilePath) Maybe (GenStructElem Type))
-> [Element]
-> ReaderT ([XHeader], FilePath) Maybe [GenStructElem Type]
forall (f :: * -> *) a b.
Alternative f =>
(a -> f b) -> [a] -> f [b]
mapAlt Element -> ReaderT ([XHeader], FilePath) Maybe (GenStructElem Type)
forall (m :: * -> *).
(MonadFail m, MonadPlus m, Functor m) =>
Element -> m (GenStructElem Type)
structField ([Element]
 -> ReaderT ([XHeader], FilePath) Maybe [GenStructElem Type])
-> [Element]
-> ReaderT ([XHeader], FilePath) Maybe [GenStructElem Type]
forall a b. (a -> b) -> a -> b
$ [Element]
xs
  Bool -> ReaderT ([XHeader], FilePath) Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ReaderT ([XHeader], FilePath) Maybe ())
-> Bool -> ReaderT ([XHeader], FilePath) Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [GenStructElem Type] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenStructElem Type]
fields
  XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl)
-> XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe Alignment -> [GenStructElem Type] -> XDecl
forall typ.
FilePath -> Maybe Alignment -> [GenStructElem typ] -> GenXDecl typ
XUnion FilePath
name Maybe Alignment
alignment [GenStructElem Type]
fields

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

xidunion :: Element -> Parse XDecl
xidunion :: Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xidunion el :: Element
el = do
  FilePath
name <- Element
el Element -> FilePath -> Parse FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "name"
  let types :: [XidUnionElem]
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
  Bool -> ReaderT ([XHeader], FilePath) Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ReaderT ([XHeader], FilePath) Maybe ())
-> Bool -> ReaderT ([XHeader], FilePath) Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [XidUnionElem] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [XidUnionElem]
types
  XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl)
-> XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl
forall a b. (a -> b) -> a -> b
$ FilePath -> [XidUnionElem] -> XDecl
forall typ. FilePath -> [GenXidUnionElem typ] -> GenXDecl typ
XidUnion FilePath
name [XidUnionElem]
types

xidUnionElem :: Element -> Maybe XidUnionElem
xidUnionElem :: Element -> Maybe XidUnionElem
xidUnionElem el :: 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 -> FilePath -> Bool
`named` "type"
  XidUnionElem -> Maybe XidUnionElem
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
$ FilePath -> Type
mkType (FilePath -> Type) -> FilePath -> Type
forall a b. (a -> b) -> a -> b
$ Element -> FilePath
strContent Element
el

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

xeventstruct :: Element -> Parse XDecl
xeventstruct :: Element -> ReaderT ([XHeader], FilePath) Maybe XDecl
xeventstruct el :: Element
el = do
  FilePath
name <- Element
el Element -> FilePath -> Parse FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "name"
  [AllowedEvent]
allowed <- (Element -> ReaderT ([XHeader], FilePath) Maybe AllowedEvent)
-> [Element] -> ReaderT ([XHeader], FilePath) Maybe [AllowedEvent]
forall (f :: * -> *) a b.
Alternative f =>
(a -> f b) -> [a] -> f [b]
mapAlt Element -> ReaderT ([XHeader], FilePath) Maybe AllowedEvent
forall (m :: * -> *).
(MonadPlus m, Functor m) =>
Element -> m AllowedEvent
allowedEvent ([Element] -> ReaderT ([XHeader], FilePath) Maybe [AllowedEvent])
-> [Element] -> ReaderT ([XHeader], FilePath) Maybe [AllowedEvent]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
el
  XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl)
-> XDecl -> ReaderT ([XHeader], FilePath) Maybe XDecl
forall a b. (a -> b) -> a -> b
$ FilePath -> [AllowedEvent] -> XDecl
forall typ. FilePath -> [AllowedEvent] -> GenXDecl typ
XEventStruct FilePath
name [AllowedEvent]
allowed

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

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

    | Element
el Element -> FilePath -> Bool
`named` "pad" = do
        Int
bytes <- Element
el Element -> FilePath -> m FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "bytes" m FilePath -> (FilePath -> m Int) -> m Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> m Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => FilePath -> m a
readM
        GenStructElem Type -> m (GenStructElem Type)
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
$ Int -> GenStructElem Type
forall typ. Int -> GenStructElem typ
Pad Int
bytes

    | Element
el Element -> FilePath -> Bool
`named` "list" = do
        Type
typ <- (FilePath -> Type) -> m FilePath -> m Type
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM FilePath -> Type
mkType (m FilePath -> m Type) -> m FilePath -> m Type
forall a b. (a -> b) -> a -> b
$ Element
el Element -> FilePath -> m FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "type"
        FilePath
name <- Element
el Element -> FilePath -> m FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "name"
        let enum :: Maybe Type
enum = (FilePath -> Type) -> Maybe FilePath -> Maybe Type
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM FilePath -> Type
mkType (Maybe FilePath -> Maybe Type) -> Maybe FilePath -> Maybe Type
forall a b. (a -> b) -> a -> b
$ Element
el Element -> FilePath -> Maybe FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "enum"
        let expr :: Maybe XExpression
expr = Element -> Maybe Element
forall (m :: * -> *). MonadPlus m => Element -> m Element
firstChild Element
el Maybe Element
-> (Element -> Maybe XExpression) -> Maybe XExpression
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
        GenStructElem Type -> m (GenStructElem Type)
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
$ FilePath
-> Type -> Maybe XExpression -> Maybe Type -> GenStructElem Type
forall typ.
FilePath
-> typ -> Maybe (Expression typ) -> Maybe typ -> GenStructElem typ
List FilePath
name Type
typ Maybe XExpression
expr Maybe Type
enum

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

    | Element
el Element -> FilePath -> Bool
`named` "switch" = do
        FilePath
nm <- Element
el Element -> FilePath -> m FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "name"
        (exprEl :: Element
exprEl,caseEls :: [Element]
caseEls) <- Element -> m (Element, [Element])
forall (m :: * -> *).
MonadPlus m =>
Element -> m (Element, [Element])
unconsChildren Element
el
        XExpression
expr <- Element -> m XExpression
forall (m :: * -> *).
(MonadFail m, MonadPlus m, Functor m) =>
Element -> m XExpression
expression Element
exprEl
        (alignment :: Maybe Alignment
alignment, xs :: [Element]
xs) <- [Element] -> m (Maybe Alignment, [Element])
forall (m :: * -> *).
(MonadPlus m, Functor m) =>
[Element] -> m (Maybe Alignment, [Element])
extractAlignment ([Element] -> m (Maybe Alignment, [Element]))
-> [Element] -> m (Maybe Alignment, [Element])
forall a b. (a -> b) -> a -> b
$ [Element]
caseEls
        [BitCase]
cases <- (Element -> m BitCase) -> [Element] -> m [BitCase]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> m BitCase
forall (m :: * -> *).
(MonadFail m, MonadPlus m, Functor m) =>
Element -> m BitCase
bitCase [Element]
xs
        GenStructElem Type -> m (GenStructElem Type)
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
$ FilePath
-> XExpression
-> Maybe Alignment
-> [BitCase]
-> GenStructElem Type
forall typ.
FilePath
-> Expression typ
-> Maybe Alignment
-> [GenBitCase typ]
-> GenStructElem typ
Switch FilePath
nm XExpression
expr Maybe Alignment
alignment [BitCase]
cases

    | Element
el Element -> FilePath -> Bool
`named` "exprfield" = do
        Type
typ <- (FilePath -> Type) -> m FilePath -> m Type
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM FilePath -> Type
mkType (m FilePath -> m Type) -> m FilePath -> m Type
forall a b. (a -> b) -> a -> b
$ Element
el Element -> FilePath -> m FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "type"
        FilePath
name <- Element
el Element -> FilePath -> m FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "name"
        XExpression
expr <- Element -> m Element
forall (m :: * -> *). MonadPlus m => Element -> m Element
firstChild Element
el m Element -> (Element -> m XExpression) -> m XExpression
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
        GenStructElem Type -> m (GenStructElem Type)
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
$ FilePath -> Type -> XExpression -> GenStructElem Type
forall typ. FilePath -> typ -> Expression typ -> GenStructElem typ
ExprField FilePath
name Type
typ XExpression
expr

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

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

    | Element
el Element -> FilePath -> Bool
`named` "fd" = do
        FilePath
name <- Element
el Element -> FilePath -> m FilePath
forall (m :: * -> *).
MonadPlus m =>
Element -> FilePath -> m FilePath
`attr` "name"
        GenStructElem Type -> m (GenStructElem Type)
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
$ FilePath -> GenStructElem Type
forall typ. FilePath -> GenStructElem typ
Fd FilePath
name

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

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

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


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

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


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

firstChild :: MonadPlus m => Element -> m Element
firstChild :: 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 :: Element -> m (Element, [Element])
unconsChildren el :: Element
el
    = case Element -> [Element]
elChildren Element
el of
        (x :: Element
x:xs :: [Element]
xs) -> (Element, [Element]) -> m (Element, [Element])
forall (m :: * -> *) a. Monad m => a -> m a
return (Element
x,[Element]
xs)
        _ -> m (Element, [Element])
forall (m :: * -> *) a. MonadPlus m => m a
mzero

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

named :: Element -> String -> Bool
named :: Element -> FilePath -> Bool
named (Element qname :: QName
qname _ _ _) name :: FilePath
name | QName
qname QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> QName
unqual FilePath
name = Bool
True
named _ _ = Bool
False

attr :: MonadPlus m => Element -> String -> m String
(Element _ xs :: [Attr]
xs _ _) attr :: Element -> FilePath -> m FilePath
`attr` name :: FilePath
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 _ res :: FilePath
res) -> FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
res
      _ -> m FilePath
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    where p :: Attr -> Bool
p (Attr qname :: QName
qname _) | QName
qname QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> QName
unqual FilePath
name = Bool
True
          p _ = Bool
False

children :: MonadPlus m => Element -> String -> m [Element]
(Element _ _ xs :: [Content]
xs _) children :: Element -> FilePath -> m [Element]
`children` name :: FilePath
name = case (Content -> Bool) -> [Content] -> [Content]
forall a. (a -> Bool) -> [a] -> [a]
List.filter Content -> Bool
p [Content]
xs of
      [] -> m [Element]
forall (m :: * -> *) a. MonadPlus m => m a
mzero
      some :: [Content]
some -> [Element] -> m [Element]
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 n :: QName
n _ _ _)) | QName
n QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> QName
unqual FilePath
name = Bool
True
          p _ = Bool
False

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