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.Monad
import Control.Monad.Reader
import System.IO (openFile, IOMode (ReadMode), hSetEncoding, utf8, hGetContents)
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
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
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
type Parse = ReaderT ([XHeader],Name) Maybe
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
extractAlignment :: (MonadPlus m, Functor m) => [Element] -> m (Maybe Alignment, [Element])
(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)
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")
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
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
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
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]
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
}
extractDecls :: [Content] -> Parse [XDecl]
= (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
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
(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"
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
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)
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 ""
| 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
| Element
el Element -> FilePath -> Bool
`named` "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 (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 = FilePath -> Type
mkType "CARD32"
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 -> 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 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 "&" = 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
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
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