{-# 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)
fromFiles :: [FilePath] -> IO [XHeader]
fromFiles :: [Name] -> IO [XHeader]
fromFiles [Name]
xs = do
[Name]
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
[XHeader] -> IO [XHeader]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([XHeader] -> IO [XHeader]) -> [XHeader] -> IO [XHeader]
forall a b. (a -> b) -> a -> b
$ [Name] -> [XHeader]
fromStrings [Name]
strings
readFileUTF8 :: FilePath -> IO String
readFileUTF8 :: Name -> IO Name
readFileUTF8 Name
fp = do
Handle
h <- Name -> IOMode -> IO Handle
openFile Name
fp IOMode
ReadMode
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8
Handle -> IO Name
hGetContents Handle
h
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
type Parse = ReaderT ([XHeader],Name) Maybe
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
extractAlignment :: (MonadPlus m, Functor m) => [Element] -> m (Maybe Alignment, [Element])
(Element
el : [Element]
xs) | Element
el Element -> Name -> Bool
`named` Name
"required_start_align" = do
Int
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
Int
offset <- Element
el Element -> Name -> m Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"offset" 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
(Maybe Alignment, [Element]) -> m (Maybe Alignment, [Element])
forall a. a -> m a
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 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)
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
Name
lname <- Parse Name
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 a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (([XDecl] -> Maybe a) -> Maybe Name -> Parse (Maybe a)
forall a. ([XDecl] -> Maybe a) -> Maybe Name -> Parse (Maybe a)
lookupThingy [XDecl] -> Maybe a
f (Maybe Name -> Parse (Maybe a)) -> Maybe Name -> Parse (Maybe a)
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Name
forall a. a -> Maybe a
Just Name
lname)
(([XDecl] -> Maybe a) -> Maybe Name -> Parse (Maybe a)
forall a. ([XDecl] -> Maybe a) -> Maybe Name -> Parse (Maybe a)
lookupThingy [XDecl] -> Maybe a
f (Maybe Name -> Parse (Maybe a)) -> Maybe Name -> Parse (Maybe a)
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Name
forall a. a -> Maybe a
Just Name
"xproto")
lookupThingy [XDecl] -> Maybe a
f (Just Name
mname) = do
[XHeader]
xs <- Parse [XHeader]
allModules
Maybe a -> Parse (Maybe a)
forall a. a -> ReaderT ([XHeader], Name) 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 <- Name -> [XHeader] -> Maybe XHeader
findXHeader Name
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
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
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
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]
fromString :: String -> ReaderT [XHeader] Maybe XHeader
fromString :: Name -> ReaderT [XHeader] Maybe XHeader
fromString Name
str = do
el :: Element
el@(Element QName
_qname [Attr]
_ats [Content]
cnt Maybe Line
_) <- 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
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 -> Name -> Bool
`named` Name
"xcb"
Name
header <- Element
el Element -> Name -> ReaderT [XHeader] Maybe Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"header"
let name :: Maybe Name
name = Element
el Element -> Name -> Maybe Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"extension-name"
xname :: Maybe Name
xname = Element
el Element -> Name -> Maybe Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"extension-xname"
maj_ver :: Maybe Int
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 :: Maybe Int
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 :: Maybe Bool
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
[XDecl]
decls <- ([XHeader] -> ([XHeader], Name))
-> ReaderT ([XHeader], Name) Maybe [XDecl]
-> ReaderT [XHeader] Maybe [XDecl]
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (\[XHeader]
r -> ([XHeader]
r,Name
header)) (ReaderT ([XHeader], Name) Maybe [XDecl]
-> ReaderT [XHeader] Maybe [XDecl])
-> ReaderT ([XHeader], Name) Maybe [XDecl]
-> ReaderT [XHeader] Maybe [XDecl]
forall a b. (a -> b) -> a -> b
$ [Content] -> ReaderT ([XHeader], Name) Maybe [XDecl]
extractDecls [Content]
cnt
XHeader -> ReaderT [XHeader] Maybe XHeader
forall a. a -> ReaderT [XHeader] Maybe a
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 {xheader_header :: Name
xheader_header = Name
header
,xheader_xname :: Maybe Name
xheader_xname = Maybe Name
xname
,xheader_name :: Maybe Name
xheader_name = Maybe Name
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
}
extractDecls :: [Content] -> Parse [XDecl]
= (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
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
Name
nm <- Element
el Element -> Name -> Parse Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"name"
[EnumElem Type]
fields <- (Element -> ReaderT ([XHeader], Name) Maybe (EnumElem Type))
-> [Element] -> ReaderT ([XHeader], Name) Maybe [EnumElem Type]
forall (f :: * -> *) a b.
Alternative f =>
(a -> f b) -> [a] -> f [b]
mapAlt Element -> ReaderT ([XHeader], Name) Maybe (EnumElem Type)
enumField ([Element] -> ReaderT ([XHeader], Name) Maybe [EnumElem Type])
-> [Element] -> ReaderT ([XHeader], Name) Maybe [EnumElem Type]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
el
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
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [EnumElem Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [EnumElem Type]
fields
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)
-> XDecl -> ReaderT ([XHeader], Name) Maybe XDecl
forall a b. (a -> b) -> a -> b
$ Name -> [EnumElem Type] -> XDecl
forall typ. Name -> [EnumElem typ] -> GenXDecl typ
XEnum Name
nm [EnumElem Type]
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
name <- Element
el Element -> Name -> Parse Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"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 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
EnumElem Type -> ReaderT ([XHeader], Name) Maybe (EnumElem Type)
forall a. a -> ReaderT ([XHeader], Name) Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumElem Type -> ReaderT ([XHeader], Name) Maybe (EnumElem Type))
-> EnumElem Type -> ReaderT ([XHeader], Name) Maybe (EnumElem Type)
forall a b. (a -> b) -> a -> b
$ Name -> Maybe XExpression -> EnumElem Type
forall typ. Name -> Maybe (Expression typ) -> EnumElem typ
EnumElem Name
name Maybe XExpression
expr
xrequest :: Element -> Parse XDecl
xrequest :: Element -> ReaderT ([XHeader], Name) Maybe XDecl
xrequest Element
el = do
Name
nm <- Element
el Element -> Name -> Parse Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"name"
Int
code <- Element
el Element -> Name -> Parse Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"opcode" Parse Name
-> (Name -> ReaderT ([XHeader], Name) Maybe Int)
-> ReaderT ([XHeader], Name) Maybe Int
forall a b.
ReaderT ([XHeader], Name) Maybe a
-> (a -> ReaderT ([XHeader], Name) Maybe b)
-> ReaderT ([XHeader], Name) Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name -> ReaderT ([XHeader], Name) Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Name -> m a
readM
(Maybe Alignment
alignment, [Element]
xs) <- [Element]
-> ReaderT ([XHeader], Name) Maybe (Maybe Alignment, [Element])
forall (m :: * -> *).
(MonadPlus m, Functor m) =>
[Element] -> m (Maybe Alignment, [Element])
extractAlignment ([Element]
-> ReaderT ([XHeader], Name) Maybe (Maybe Alignment, [Element]))
-> [Element]
-> ReaderT ([XHeader], Name) Maybe (Maybe Alignment, [Element])
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
el
[GenStructElem Type]
fields <- (Element -> ReaderT ([XHeader], Name) Maybe (GenStructElem Type))
-> [Element]
-> ReaderT ([XHeader], Name) Maybe [GenStructElem Type]
forall (f :: * -> *) a b.
Alternative f =>
(a -> f b) -> [a] -> f [b]
mapAlt Element -> ReaderT ([XHeader], Name) Maybe (GenStructElem Type)
forall (m :: * -> *).
(MonadFail m, MonadPlus m, Functor m) =>
Element -> m (GenStructElem Type)
structField ([Element] -> ReaderT ([XHeader], Name) Maybe [GenStructElem Type])
-> [Element]
-> ReaderT ([XHeader], Name) 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], 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)
-> XDecl -> ReaderT ([XHeader], Name) Maybe XDecl
forall a b. (a -> b) -> a -> b
$ Name
-> Int
-> Maybe Alignment
-> [GenStructElem Type]
-> Maybe XReply
-> XDecl
forall typ.
Name
-> Int
-> Maybe Alignment
-> [GenStructElem typ]
-> Maybe (GenXReply typ)
-> GenXDecl typ
XRequest Name
nm Int
code Maybe Alignment
alignment [GenStructElem Type]
fields Maybe XReply
reply
getReply :: Element -> Maybe XReply
getReply :: Element -> Maybe XReply
getReply Element
el = do
Element
childElem <- Name -> QName
unqual Name
"reply" QName -> Element -> Maybe Element
`findChild` Element
el
(Maybe Alignment
alignment, [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenStructElem Type]
fields
XReply -> Maybe XReply
forall a. a -> Maybe a
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], Name) Maybe XDecl
xevent Element
el = do
Name
name <- Element
el Element -> Name -> Parse Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"name"
Int
number <- Element
el Element -> Name -> Parse Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"number" Parse Name
-> (Name -> ReaderT ([XHeader], Name) Maybe Int)
-> ReaderT ([XHeader], Name) Maybe Int
forall a b.
ReaderT ([XHeader], Name) Maybe a
-> (a -> ReaderT ([XHeader], Name) Maybe b)
-> ReaderT ([XHeader], Name) Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name -> ReaderT ([XHeader], Name) Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Name -> m a
readM
let xge :: Maybe Bool
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 :: Maybe Bool
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
(Maybe Alignment
alignment, [Element]
xs) <- [Element]
-> ReaderT ([XHeader], Name) 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], Name) Maybe (GenStructElem Type))
-> [Element]
-> ReaderT ([XHeader], Name) Maybe [GenStructElem Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> ReaderT ([XHeader], Name) Maybe (GenStructElem Type)
forall (m :: * -> *).
(MonadFail m, MonadPlus m, Functor m) =>
Element -> m (GenStructElem Type)
structField ([Element] -> ReaderT ([XHeader], Name) Maybe [GenStructElem Type])
-> [Element]
-> ReaderT ([XHeader], Name) Maybe [GenStructElem Type]
forall a b. (a -> b) -> a -> b
$ [Element]
xs
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
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [GenStructElem Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenStructElem Type]
fields
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)
-> XDecl -> ReaderT ([XHeader], Name) Maybe XDecl
forall a b. (a -> b) -> a -> b
$ Name
-> Int
-> Maybe Alignment
-> Maybe Bool
-> [GenStructElem Type]
-> Maybe Bool
-> XDecl
forall typ.
Name
-> Int
-> Maybe Alignment
-> Maybe Bool
-> [GenStructElem typ]
-> Maybe Bool
-> GenXDecl typ
XEvent Name
name Int
number Maybe Alignment
alignment Maybe Bool
xge [GenStructElem Type]
fields Maybe Bool
noseq
xevcopy :: Element -> Parse XDecl
xevcopy :: Element -> ReaderT ([XHeader], Name) Maybe XDecl
xevcopy Element
el = do
Name
name <- Element
el Element -> Name -> Parse Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"name"
Int
number <- Element
el Element -> Name -> Parse Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"number" Parse Name
-> (Name -> ReaderT ([XHeader], Name) Maybe Int)
-> ReaderT ([XHeader], Name) Maybe Int
forall a b.
ReaderT ([XHeader], Name) Maybe a
-> (a -> ReaderT ([XHeader], Name) Maybe b)
-> ReaderT ([XHeader], Name) Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name -> ReaderT ([XHeader], Name) Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Name -> m a
readM
Name
ref <- Element
el Element -> Name -> Parse Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"ref"
let (Maybe Name
mname,Name
evname) = Name -> (Maybe Name, Name)
splitRef Name
ref
Maybe EventDetails
details <- Maybe Name -> Name -> Parse (Maybe EventDetails)
lookupEvent Maybe Name
mname Name
evname
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)
-> XDecl -> ReaderT ([XHeader], Name) Maybe XDecl
forall a b. (a -> b) -> a -> b
$ let EventDetails Name
_ Int
_ Maybe Alignment
alignment Maybe Bool
xge [GenStructElem Type]
fields Maybe Bool
noseq =
case Maybe EventDetails
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 Name
-> Int
-> Maybe Alignment
-> Maybe Bool
-> [GenStructElem Type]
-> Maybe Bool
-> XDecl
forall typ.
Name
-> Int
-> Maybe Alignment
-> Maybe Bool
-> [GenStructElem typ]
-> Maybe Bool
-> GenXDecl typ
XEvent Name
name Int
number Maybe Alignment
alignment Maybe Bool
xge [GenStructElem Type]
fields Maybe Bool
noseq
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)
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
name <- Element
el Element -> Name -> Parse Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"name"
Int
number <- Element
el Element -> Name -> Parse Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"number" Parse Name
-> (Name -> ReaderT ([XHeader], Name) Maybe Int)
-> ReaderT ([XHeader], Name) Maybe Int
forall a b.
ReaderT ([XHeader], Name) Maybe a
-> (a -> ReaderT ([XHeader], Name) Maybe b)
-> ReaderT ([XHeader], Name) Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name -> ReaderT ([XHeader], Name) Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Name -> m a
readM
(Maybe Alignment
alignment, [Element]
xs) <- [Element]
-> ReaderT ([XHeader], Name) Maybe (Maybe Alignment, [Element])
forall (m :: * -> *).
(MonadPlus m, Functor m) =>
[Element] -> m (Maybe Alignment, [Element])
extractAlignment ([Element]
-> ReaderT ([XHeader], Name) Maybe (Maybe Alignment, [Element]))
-> [Element]
-> ReaderT ([XHeader], Name) Maybe (Maybe Alignment, [Element])
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
el
[GenStructElem Type]
fields <- (Element -> ReaderT ([XHeader], Name) Maybe (GenStructElem Type))
-> [Element]
-> ReaderT ([XHeader], Name) Maybe [GenStructElem Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> ReaderT ([XHeader], Name) Maybe (GenStructElem Type)
forall (m :: * -> *).
(MonadFail m, MonadPlus m, Functor m) =>
Element -> m (GenStructElem Type)
structField ([Element] -> ReaderT ([XHeader], Name) Maybe [GenStructElem Type])
-> [Element]
-> ReaderT ([XHeader], Name) Maybe [GenStructElem Type]
forall a b. (a -> b) -> a -> b
$ [Element]
xs
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)
-> XDecl -> ReaderT ([XHeader], Name) Maybe XDecl
forall a b. (a -> b) -> a -> b
$ Name -> Int -> Maybe Alignment -> [GenStructElem Type] -> XDecl
forall typ.
Name
-> Int -> Maybe Alignment -> [GenStructElem typ] -> GenXDecl typ
XError Name
name Int
number Maybe Alignment
alignment [GenStructElem Type]
fields
xercopy :: Element -> Parse XDecl
xercopy :: Element -> ReaderT ([XHeader], Name) Maybe XDecl
xercopy Element
el = do
Name
name <- Element
el Element -> Name -> Parse Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"name"
Int
number <- Element
el Element -> Name -> Parse Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"number" Parse Name
-> (Name -> ReaderT ([XHeader], Name) Maybe Int)
-> ReaderT ([XHeader], Name) Maybe Int
forall a b.
ReaderT ([XHeader], Name) Maybe a
-> (a -> ReaderT ([XHeader], Name) Maybe b)
-> ReaderT ([XHeader], Name) Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name -> ReaderT ([XHeader], Name) Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Name -> m a
readM
Name
ref <- Element
el Element -> Name -> Parse Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"ref"
let (Maybe Name
mname, Name
ername) = Name -> (Maybe Name, Name)
splitRef Name
ref
Maybe ErrorDetails
details <- Maybe Name -> Name -> Parse (Maybe ErrorDetails)
lookupError Maybe Name
mname Name
ername
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)
-> XDecl -> ReaderT ([XHeader], Name) 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 (Name -> Int -> Maybe Alignment -> [GenStructElem Type] -> XDecl
forall typ.
Name
-> Int -> Maybe Alignment -> [GenStructElem typ] -> GenXDecl typ
XError Name
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
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
name <- Element
el Element -> Name -> Parse Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"name"
(Maybe Alignment
alignment, [Element]
xs) <- [Element]
-> ReaderT ([XHeader], Name) Maybe (Maybe Alignment, [Element])
forall (m :: * -> *).
(MonadPlus m, Functor m) =>
[Element] -> m (Maybe Alignment, [Element])
extractAlignment ([Element]
-> ReaderT ([XHeader], Name) Maybe (Maybe Alignment, [Element]))
-> [Element]
-> ReaderT ([XHeader], Name) Maybe (Maybe Alignment, [Element])
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
el
[GenStructElem Type]
fields <- (Element -> ReaderT ([XHeader], Name) Maybe (GenStructElem Type))
-> [Element]
-> ReaderT ([XHeader], Name) Maybe [GenStructElem Type]
forall (f :: * -> *) a b.
Alternative f =>
(a -> f b) -> [a] -> f [b]
mapAlt Element -> ReaderT ([XHeader], Name) Maybe (GenStructElem Type)
forall (m :: * -> *).
(MonadFail m, MonadPlus m, Functor m) =>
Element -> m (GenStructElem Type)
structField ([Element] -> ReaderT ([XHeader], Name) Maybe [GenStructElem Type])
-> [Element]
-> ReaderT ([XHeader], Name) Maybe [GenStructElem Type]
forall a b. (a -> b) -> a -> b
$ [Element]
xs
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
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [GenStructElem Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenStructElem Type]
fields
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)
-> XDecl -> ReaderT ([XHeader], Name) Maybe XDecl
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Alignment -> [GenStructElem Type] -> XDecl
forall typ.
Name -> Maybe Alignment -> [GenStructElem typ] -> GenXDecl typ
XStruct Name
name Maybe Alignment
alignment [GenStructElem Type]
fields
xunion :: Element -> Parse XDecl
xunion :: Element -> ReaderT ([XHeader], Name) Maybe XDecl
xunion Element
el = do
Name
name <- Element
el Element -> Name -> Parse Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"name"
(Maybe Alignment
alignment, [Element]
xs) <- [Element]
-> ReaderT ([XHeader], Name) Maybe (Maybe Alignment, [Element])
forall (m :: * -> *).
(MonadPlus m, Functor m) =>
[Element] -> m (Maybe Alignment, [Element])
extractAlignment ([Element]
-> ReaderT ([XHeader], Name) Maybe (Maybe Alignment, [Element]))
-> [Element]
-> ReaderT ([XHeader], Name) Maybe (Maybe Alignment, [Element])
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
el
[GenStructElem Type]
fields <- (Element -> ReaderT ([XHeader], Name) Maybe (GenStructElem Type))
-> [Element]
-> ReaderT ([XHeader], Name) Maybe [GenStructElem Type]
forall (f :: * -> *) a b.
Alternative f =>
(a -> f b) -> [a] -> f [b]
mapAlt Element -> ReaderT ([XHeader], Name) Maybe (GenStructElem Type)
forall (m :: * -> *).
(MonadFail m, MonadPlus m, Functor m) =>
Element -> m (GenStructElem Type)
structField ([Element] -> ReaderT ([XHeader], Name) Maybe [GenStructElem Type])
-> [Element]
-> ReaderT ([XHeader], Name) Maybe [GenStructElem Type]
forall a b. (a -> b) -> a -> b
$ [Element]
xs
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
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [GenStructElem Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenStructElem Type]
fields
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)
-> XDecl -> ReaderT ([XHeader], Name) Maybe XDecl
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Alignment -> [GenStructElem Type] -> XDecl
forall typ.
Name -> Maybe Alignment -> [GenStructElem typ] -> GenXDecl typ
XUnion Name
name Maybe Alignment
alignment [GenStructElem Type]
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
name <- Element
el Element -> Name -> Parse Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"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], 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
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [XidUnionElem] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [XidUnionElem]
types
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)
-> XDecl -> ReaderT ([XHeader], Name) Maybe XDecl
forall a b. (a -> b) -> a -> b
$ Name -> [XidUnionElem] -> XDecl
forall typ. Name -> [GenXidUnionElem typ] -> GenXDecl typ
XidUnion Name
name [XidUnionElem]
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
Type
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"
Name
newname <- Element
el Element -> Name -> Parse Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"newname"
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)
-> XDecl -> ReaderT ([XHeader], Name) Maybe XDecl
forall a b. (a -> b) -> a -> b
$ Name -> Type -> XDecl
forall typ. Name -> typ -> GenXDecl typ
XTypeDef Name
newname Type
oldtyp
xeventstruct :: Element -> Parse XDecl
xeventstruct :: Element -> ReaderT ([XHeader], Name) Maybe XDecl
xeventstruct Element
el = do
Name
name <- Element
el Element -> Name -> Parse Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"name"
[AllowedEvent]
allowed <- (Element -> ReaderT ([XHeader], Name) Maybe AllowedEvent)
-> [Element] -> ReaderT ([XHeader], Name) Maybe [AllowedEvent]
forall (f :: * -> *) a b.
Alternative f =>
(a -> f b) -> [a] -> f [b]
mapAlt Element -> ReaderT ([XHeader], Name) Maybe AllowedEvent
forall (m :: * -> *).
(MonadPlus m, Functor m) =>
Element -> m AllowedEvent
allowedEvent ([Element] -> ReaderT ([XHeader], Name) Maybe [AllowedEvent])
-> [Element] -> ReaderT ([XHeader], Name) Maybe [AllowedEvent]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
el
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)
-> XDecl -> ReaderT ([XHeader], Name) Maybe XDecl
forall a b. (a -> b) -> a -> b
$ Name -> [AllowedEvent] -> XDecl
forall typ. Name -> [AllowedEvent] -> GenXDecl typ
XEventStruct Name
name [AllowedEvent]
allowed
allowedEvent :: (MonadPlus m, Functor m) => Element -> m AllowedEvent
allowedEvent :: forall (m :: * -> *).
(MonadPlus m, Functor m) =>
Element -> m AllowedEvent
allowedEvent Element
el = do
Name
extension <- Element
el Element -> Name -> m Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"name"
Bool
xge <- Element
el Element -> Name -> m Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"xge" m Name -> (Name -> m Bool) -> m Bool
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 Bool
forall (m :: * -> *) a. (MonadPlus m, Read a) => Name -> m a
readM
Int
opMin <- Element
el Element -> Name -> m Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"opcode-min" 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
Int
opMax <- Element
el Element -> Name -> m Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"opcode-max" 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
AllowedEvent -> m AllowedEvent
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AllowedEvent -> m AllowedEvent) -> AllowedEvent -> m AllowedEvent
forall a b. (a -> b) -> a -> b
$ Name -> Bool -> Int -> Int -> AllowedEvent
AllowedEvent Name
extension Bool
xge Int
opMin Int
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
Type
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 :: Maybe Type
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 :: Maybe Type
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
name <- Element
el Element -> Name -> m Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"name"
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
$ Name -> Type -> Maybe Type -> Maybe Type -> GenStructElem Type
forall typ.
Name -> typ -> Maybe typ -> Maybe typ -> GenStructElem typ
SField Name
name Type
typ Maybe Type
enum Maybe Type
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
Type
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
name <- Element
el Element -> Name -> m Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"name"
let enum :: Maybe Type
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 :: Maybe XExpression
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
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
$ Name
-> Type -> Maybe XExpression -> Maybe Type -> GenStructElem Type
forall typ.
Name
-> typ -> Maybe (Expression typ) -> Maybe typ -> GenStructElem typ
List Name
name Type
typ Maybe XExpression
expr Maybe Type
enum
| Element
el Element -> Name -> Bool
`named` Name
"valueparam" = do
Type
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"
Name
mask_name <- Element
el Element -> Name -> m Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"value-mask-name"
let mask_pad :: Maybe Int
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
Name
list_name <- Element
el Element -> Name -> m Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"value-list-name"
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
$ Type -> Name -> Maybe Int -> Name -> GenStructElem Type
forall typ. typ -> Name -> Maybe Int -> Name -> GenStructElem typ
ValueParam Type
mask_typ Name
mask_name Maybe Int
mask_pad Name
list_name
| Element
el Element -> Name -> Bool
`named` Name
"switch" = do
Name
nm <- Element
el Element -> Name -> m Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"name"
(Element
exprEl,[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
(Maybe Alignment
alignment, [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 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
$ Name
-> XExpression
-> Maybe Alignment
-> [BitCase]
-> GenStructElem Type
forall typ.
Name
-> Expression typ
-> Maybe Alignment
-> [GenBitCase typ]
-> GenStructElem typ
Switch Name
nm XExpression
expr Maybe Alignment
alignment [BitCase]
cases
| Element
el Element -> Name -> Bool
`named` Name
"exprfield" = do
Type
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
name <- Element
el Element -> Name -> m Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"name"
XExpression
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
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
$ Name -> Type -> XExpression -> GenStructElem Type
forall typ. Name -> typ -> Expression typ -> GenStructElem typ
ExprField Name
name Type
typ XExpression
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
""
| Element
el Element -> Name -> Bool
`named` Name
"doc" = do
[Element]
fields <- Element
el Element -> Name -> m [Element]
forall (m :: * -> *). MonadPlus m => Element -> Name -> m [Element]
`children` Name
"field"
let mkField :: Element -> Maybe (Name, Name)
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' :: Map 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 :: [Element]
sees = QName -> Element -> [Element]
findChildren (Name -> QName
unqual Name
"see") Element
el
sees' :: [(Name, Name)]
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 Name
typ <- Element
s Element -> Name -> Maybe Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"type"
Name
name <- Element
s Element -> Name -> Maybe Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"name"
(Name, Name) -> Maybe (Name, Name)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
typ, Name
name)
brief :: Maybe 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
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
$ Maybe Name -> Map Name Name -> [(Name, Name)] -> GenStructElem Type
forall typ.
Maybe Name -> Map Name Name -> [(Name, Name)] -> GenStructElem typ
Doc Maybe Name
brief Map Name Name
fields' [(Name, Name)]
sees'
| Element
el Element -> Name -> Bool
`named` Name
"fd" = do
Name
name <- Element
el Element -> Name -> m Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"name"
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
$ Name -> GenStructElem Type
forall typ. Name -> GenStructElem typ
Fd Name
name
| Element
el Element -> Name -> Bool
`named` Name
"length" = do
XExpression
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 :: Type
typ = Name -> Type
mkType Name
"CARD32"
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
$ Type -> XExpression -> GenStructElem Type
forall typ. typ -> Expression typ -> GenStructElem typ
Length Type
typ XExpression
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"
let ([Element]
exprEls, [Element]
fieldEls) = [Element] -> ([Element], [Element])
takeEnumrefs ([Element] -> ([Element], [Element]))
-> [Element] -> ([Element], [Element])
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
el
[XExpression]
exprs <- (Element -> m XExpression) -> [Element] -> m [XExpression]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> m XExpression
forall (m :: * -> *).
(MonadFail m, MonadPlus m, Functor m) =>
Element -> m XExpression
expression [Element]
exprEls
(Maybe Alignment
alignment, [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (BitCase -> m BitCase) -> BitCase -> m BitCase
forall a b. (a -> b) -> a -> b
$ Maybe Name
-> [XExpression]
-> Maybe Alignment
-> [GenStructElem Type]
-> BitCase
forall typ.
Maybe Name
-> [Expression typ]
-> Maybe Alignment
-> [GenStructElem typ]
-> GenBitCase typ
BitCase Maybe Name
mName [XExpression]
exprs Maybe Alignment
alignment [GenStructElem Type]
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
Type
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 :: Name
enumVal = Element -> Name
strContent Element
el
Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Name
enumVal Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
""
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
$ Type -> Name -> XExpression
forall typ. typ -> Name -> Expression typ
EnumRef Type
enumTy Name
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
Int
n <- Name -> m Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Name -> m a
readM (Element -> Name
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
>= Int
0
Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
| Element
el Element -> Name -> Bool
`named` Name
"op" = do
Binop
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
[XExpression
exprLhs,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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 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
$ Binop -> XExpression -> XExpression -> XExpression
forall typ.
Binop -> Expression typ -> Expression typ -> Expression typ
Op Binop
binop XExpression
exprLhs XExpression
exprRhs
| Element
el Element -> Name -> Bool
`named` Name
"unop" = do
Unop
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
XExpression
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
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
$ Unop -> XExpression -> XExpression
forall typ. Unop -> Expression typ -> Expression typ
Unop Unop
op XExpression
expr
| Element
el Element -> Name -> Bool
`named` Name
"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 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
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
$ XExpression -> XExpression
forall typ. Expression typ -> Expression typ
PopCount XExpression
expr
| Element
el Element -> Name -> Bool
`named` Name
"sumof" = do
Name
ref <- Element
el Element -> Name -> m Name
forall (m :: * -> *). MonadPlus m => Element -> Name -> m Name
`attr` Name
"ref"
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
SumOf Name
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
"&" = 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
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
takeEnumrefs :: [Element] -> ([Element], [Element])
takeEnumrefs :: [Element] -> ([Element], [Element])
takeEnumrefs [] = ([], [])
takeEnumrefs (Element
x:[Element]
xs) =
let ([Element]
ys, [Element]
zs) = [Element] -> ([Element], [Element])
takeEnumrefs [Element]
xs
in if Element
x Element -> Name -> Bool
`named` Name
"enumref" then (Element
xElement -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:[Element]
ys, [Element]
zs) else ([Element]
ys, Element
xElement -> [Element] -> [Element]
forall a. a -> [a] -> [a]
:[Element]
zs)
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
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