module Text.XML.HaXml.XmlContent.Haskell
(
module Text.XML.HaXml.XmlContent.Parser
, toXml, fromXml
, readXml, showXml, fpsShowXml
, fReadXml, fWriteXml, fpsWriteXml
, hGetXml, hPutXml, fpsHPutXml
) where
import System.IO
import Data.List (isPrefixOf, isSuffixOf)
import qualified Text.XML.HaXml.ByteStringPP as FPS (document)
import qualified Data.ByteString.Lazy.Char8 as FPS
import Text.PrettyPrint.HughesPJ (render)
import Text.ParserCombinators.Poly
import Text.XML.HaXml.Types
import Text.XML.HaXml.Namespaces
import Text.XML.HaXml.TypeMapping
import Text.XML.HaXml.Posn (Posn, posInNewCxt)
import Text.XML.HaXml.Pretty (document)
import Text.XML.HaXml.Parse (xmlParse)
import Text.XML.HaXml.Verbatim (Verbatim(verbatim))
import Text.XML.HaXml.XmlContent.Parser
fReadXml :: XmlContent a => FilePath -> IO a
fReadXml :: FilePath -> IO a
fReadXml FilePath
fp = do
Handle
f <- ( if FilePath
fpFilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==FilePath
"-" then Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
stdin
else FilePath -> IOMode -> IO Handle
openFile FilePath
fp IOMode
ReadMode )
FilePath
x <- Handle -> IO FilePath
hGetContents Handle
f
let (Document Prolog
_ SymTab EntityDef
_ Element Posn
y [Misc]
_) = FilePath -> FilePath -> Document Posn
xmlParse FilePath
fp FilePath
x
y' :: Content Posn
y' = Element Posn -> Posn -> Content Posn
forall i. Element i -> i -> Content i
CElem Element Posn
y (FilePath -> Maybe Posn -> Posn
posInNewCxt FilePath
fp Maybe Posn
forall a. Maybe a
Nothing)
(FilePath -> IO a) -> (a -> IO a) -> Either FilePath a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Either FilePath a, [Content Posn]) -> Either FilePath a
forall a b. (a, b) -> a
fst (Parser (Content Posn) a
-> [Content Posn] -> (Either FilePath a, [Content Posn])
forall t a. Parser t a -> [t] -> (Either FilePath a, [t])
runParser Parser (Content Posn) a
forall a. XmlContent a => XMLParser a
parseContents [Content Posn
y']))
fWriteXml :: XmlContent a => FilePath -> a -> IO ()
fWriteXml :: FilePath -> a -> IO ()
fWriteXml FilePath
fp a
x = do
Handle
f <- ( if FilePath
fpFilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==FilePath
"-" then Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
stdout
else FilePath -> IOMode -> IO Handle
openFile FilePath
fp IOMode
WriteMode )
Handle -> Bool -> a -> IO ()
forall a. XmlContent a => Handle -> Bool -> a -> IO ()
hPutXml Handle
f Bool
False a
x
Handle -> IO ()
hClose Handle
f
fpsWriteXml :: XmlContent a => FilePath -> a -> IO ()
fpsWriteXml :: FilePath -> a -> IO ()
fpsWriteXml FilePath
fp a
x = do
Handle
f <- ( if FilePath
fpFilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==FilePath
"-" then Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
stdout
else FilePath -> IOMode -> IO Handle
openFile FilePath
fp IOMode
WriteMode )
Handle -> Bool -> a -> IO ()
forall a. XmlContent a => Handle -> Bool -> a -> IO ()
fpsHPutXml Handle
f Bool
False a
x
Handle -> IO ()
hClose Handle
f
readXml :: XmlContent a => String -> Either String a
readXml :: FilePath -> Either FilePath a
readXml FilePath
s =
let (Document Prolog
_ SymTab EntityDef
_ Element Posn
y [Misc]
_) = FilePath -> FilePath -> Document Posn
xmlParse FilePath
"string input" FilePath
s in
(Either FilePath a, [Content Posn]) -> Either FilePath a
forall a b. (a, b) -> a
fst (Parser (Content Posn) a
-> [Content Posn] -> (Either FilePath a, [Content Posn])
forall t a. Parser t a -> [t] -> (Either FilePath a, [t])
runParser Parser (Content Posn) a
forall a. XmlContent a => XMLParser a
parseContents
[Element Posn -> Posn -> Content Posn
forall i. Element i -> i -> Content i
CElem Element Posn
y (FilePath -> Maybe Posn -> Posn
posInNewCxt FilePath
"string input" Maybe Posn
forall a. Maybe a
Nothing)])
showXml :: XmlContent a => Bool -> a -> String
showXml :: Bool -> a -> FilePath
showXml Bool
dtd a
x =
case a -> [Content ()]
forall a. XmlContent a => a -> [Content ()]
toContents a
x of
[CElem Element ()
_ ()
_] -> (Doc -> FilePath
render (Doc -> FilePath) -> (a -> Doc) -> a -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document () -> Doc
forall i. Document i -> Doc
document (Document () -> Doc) -> (a -> Document ()) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> Document ()
forall a. XmlContent a => Bool -> a -> Document ()
toXml Bool
dtd) a
x
[Content ()]
_ -> FilePath
""
fpsShowXml :: XmlContent a => Bool -> a -> FPS.ByteString
fpsShowXml :: Bool -> a -> ByteString
fpsShowXml Bool
dtd a
x =
case a -> [Content ()]
forall a. XmlContent a => a -> [Content ()]
toContents a
x of
[CElem Element ()
_ ()
_] -> (Document () -> ByteString
forall i. Document i -> ByteString
FPS.document (Document () -> ByteString)
-> (a -> Document ()) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> Document ()
forall a. XmlContent a => Bool -> a -> Document ()
toXml Bool
dtd) a
x
[Content ()]
_ -> ByteString
FPS.empty
toXml :: XmlContent a => Bool -> a -> Document ()
toXml :: Bool -> a -> Document ()
toXml Bool
dtd a
value =
let ht :: HType
ht = a -> HType
forall a. HTypeable a => a -> HType
toHType a
value in
Prolog -> SymTab EntityDef -> Element () -> [Misc] -> Document ()
forall i.
Prolog -> SymTab EntityDef -> Element i -> [Misc] -> Document i
Document (Maybe XMLDecl -> [Misc] -> Maybe DocTypeDecl -> [Misc] -> Prolog
Prolog (XMLDecl -> Maybe XMLDecl
forall a. a -> Maybe a
Just (FilePath -> Maybe EncodingDecl -> Maybe Bool -> XMLDecl
XMLDecl FilePath
"1.0" Maybe EncodingDecl
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing))
[] (if Bool
dtd then DocTypeDecl -> Maybe DocTypeDecl
forall a. a -> Maybe a
Just (HType -> DocTypeDecl
toDTD HType
ht) else Maybe DocTypeDecl
forall a. Maybe a
Nothing) [])
SymTab EntityDef
forall a. SymTab a
emptyST
( case (HType
ht, a -> [Content ()]
forall a. XmlContent a => a -> [Content ()]
toContents a
value) of
(Tuple [HType]
_, [Content ()]
cs) -> QName -> [Attribute] -> [Content ()] -> Element ()
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem (FilePath -> QName
N (FilePath -> QName) -> FilePath -> QName
forall a b. (a -> b) -> a -> b
$ HType -> ShowS
showHType HType
ht FilePath
"") [] [Content ()]
cs
(Defined FilePath
_ [HType]
_ [Constr]
_, [Content ()]
cs) -> QName -> [Attribute] -> [Content ()] -> Element ()
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem (FilePath -> QName
N (FilePath -> QName) -> FilePath -> QName
forall a b. (a -> b) -> a -> b
$ HType -> ShowS
showHType HType
ht FilePath
"-XML") [] [Content ()]
cs
(HType
_, [CElem Element ()
e ()]) -> Element ()
e )
[]
fromXml :: XmlContent a => Document Posn -> Either String a
fromXml :: Document Posn -> Either FilePath a
fromXml (Document Prolog
_ SymTab EntityDef
_ e :: Element Posn
e@(Elem QName
n [Attribute]
_ [Content Posn]
cs) [Misc]
_)
| FilePath
"tuple" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` QName -> FilePath
localName QName
n = (Either FilePath a, [Content Posn]) -> Either FilePath a
forall a b. (a, b) -> a
fst (Parser (Content Posn) a
-> [Content Posn] -> (Either FilePath a, [Content Posn])
forall t a. Parser t a -> [t] -> (Either FilePath a, [t])
runParser Parser (Content Posn) a
forall a. XmlContent a => XMLParser a
parseContents [Content Posn]
cs)
| FilePath
"-XML" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` QName -> FilePath
localName QName
n = (Either FilePath a, [Content Posn]) -> Either FilePath a
forall a b. (a, b) -> a
fst (Parser (Content Posn) a
-> [Content Posn] -> (Either FilePath a, [Content Posn])
forall t a. Parser t a -> [t] -> (Either FilePath a, [t])
runParser Parser (Content Posn) a
forall a. XmlContent a => XMLParser a
parseContents [Content Posn]
cs)
| Bool
otherwise = (Either FilePath a, [Content Posn]) -> Either FilePath a
forall a b. (a, b) -> a
fst (Parser (Content Posn) a
-> [Content Posn] -> (Either FilePath a, [Content Posn])
forall t a. Parser t a -> [t] -> (Either FilePath a, [t])
runParser Parser (Content Posn) a
forall a. XmlContent a => XMLParser a
parseContents
[Element Posn -> Posn -> Content Posn
forall i. Element i -> i -> Content i
CElem Element Posn
e (FilePath -> Maybe Posn -> Posn
posInNewCxt FilePath
"document" Maybe Posn
forall a. Maybe a
Nothing)])
hGetXml :: XmlContent a => Handle -> IO a
hGetXml :: Handle -> IO a
hGetXml Handle
h = do
FilePath
x <- Handle -> IO FilePath
hGetContents Handle
h
let (Document Prolog
_ SymTab EntityDef
_ Element Posn
y [Misc]
_) = FilePath -> FilePath -> Document Posn
xmlParse FilePath
"file handle" FilePath
x
(FilePath -> IO a) -> (a -> IO a) -> Either FilePath a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
((Either FilePath a, [Content Posn]) -> Either FilePath a
forall a b. (a, b) -> a
fst (Parser (Content Posn) a
-> [Content Posn] -> (Either FilePath a, [Content Posn])
forall t a. Parser t a -> [t] -> (Either FilePath a, [t])
runParser Parser (Content Posn) a
forall a. XmlContent a => XMLParser a
parseContents
[Element Posn -> Posn -> Content Posn
forall i. Element i -> i -> Content i
CElem Element Posn
y (FilePath -> Maybe Posn -> Posn
posInNewCxt FilePath
"file handle" Maybe Posn
forall a. Maybe a
Nothing)]))
hPutXml :: XmlContent a => Handle -> Bool -> a -> IO ()
hPutXml :: Handle -> Bool -> a -> IO ()
hPutXml Handle
h Bool
dtd a
x = do
(Handle -> FilePath -> IO ()
hPutStrLn Handle
h (FilePath -> IO ()) -> (a -> FilePath) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> FilePath
render (Doc -> FilePath) -> (a -> Doc) -> a -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document () -> Doc
forall i. Document i -> Doc
document (Document () -> Doc) -> (a -> Document ()) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> Document ()
forall a. XmlContent a => Bool -> a -> Document ()
toXml Bool
dtd) a
x
fpsHPutXml :: XmlContent a => Handle -> Bool -> a -> IO ()
fpsHPutXml :: Handle -> Bool -> a -> IO ()
fpsHPutXml Handle
h Bool
dtd a
x = do
(Handle -> ByteString -> IO ()
FPS.hPut Handle
h (ByteString -> IO ()) -> (a -> ByteString) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document () -> ByteString
forall i. Document i -> ByteString
FPS.document (Document () -> ByteString)
-> (a -> Document ()) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> Document ()
forall a. XmlContent a => Bool -> a -> Document ()
toXml Bool
dtd) a
x
instance XmlContent Bool where
toContents :: Bool -> [Content ()]
toContents Bool
b = [Element () -> () -> Content ()
forall i. Element i -> i -> Content i
CElem (QName -> [Attribute] -> [Content ()] -> Element ()
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem (FilePath -> QName
N FilePath
"bool") [FilePath -> FilePath -> Attribute
mkAttr FilePath
"value" (Bool -> FilePath
forall a. Show a => a -> FilePath
show Bool
b)] []) ()]
parseContents :: XMLParser Bool
parseContents = do { Element Posn
e <- [FilePath] -> XMLParser (Element Posn)
element [FilePath
"bool"] ; Bool -> XMLParser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Element Posn -> Bool
forall a i. Read a => Element i -> a
attval Element Posn
e) }
instance XmlContent Int where
toContents :: Int -> [Content ()]
toContents Int
i = [Element () -> () -> Content ()
forall i. Element i -> i -> Content i
CElem (QName -> [Attribute] -> [Content ()] -> Element ()
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem (FilePath -> QName
N FilePath
"int") [FilePath -> FilePath -> Attribute
mkAttr FilePath
"value" (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
i)] []) ()]
parseContents :: XMLParser Int
parseContents = do { Element Posn
e <- [FilePath] -> XMLParser (Element Posn)
element [FilePath
"int"] ; Int -> XMLParser Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Element Posn -> Int
forall a i. Read a => Element i -> a
attval Element Posn
e) }
instance XmlContent Integer where
toContents :: Integer -> [Content ()]
toContents Integer
i = [Element () -> () -> Content ()
forall i. Element i -> i -> Content i
CElem (QName -> [Attribute] -> [Content ()] -> Element ()
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem (FilePath -> QName
N FilePath
"integer") [FilePath -> FilePath -> Attribute
mkAttr FilePath
"value" (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
i)] []) ()]
parseContents :: XMLParser Integer
parseContents = do { Element Posn
e <- [FilePath] -> XMLParser (Element Posn)
element [FilePath
"integer"] ; Integer -> XMLParser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Element Posn -> Integer
forall a i. Read a => Element i -> a
attval Element Posn
e) }
instance XmlContent Float where
toContents :: Float -> [Content ()]
toContents Float
i = [Element () -> () -> Content ()
forall i. Element i -> i -> Content i
CElem (QName -> [Attribute] -> [Content ()] -> Element ()
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem (FilePath -> QName
N FilePath
"float") [FilePath -> FilePath -> Attribute
mkAttr FilePath
"value" (Float -> FilePath
forall a. Show a => a -> FilePath
show Float
i)] []) ()]
parseContents :: XMLParser Float
parseContents = do { Element Posn
e <- [FilePath] -> XMLParser (Element Posn)
element [FilePath
"float"] ; Float -> XMLParser Float
forall (m :: * -> *) a. Monad m => a -> m a
return (Element Posn -> Float
forall a i. Read a => Element i -> a
attval Element Posn
e) }
instance XmlContent Double where
toContents :: Double -> [Content ()]
toContents Double
i = [Element () -> () -> Content ()
forall i. Element i -> i -> Content i
CElem (QName -> [Attribute] -> [Content ()] -> Element ()
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem (FilePath -> QName
N FilePath
"double") [FilePath -> FilePath -> Attribute
mkAttr FilePath
"value" (Double -> FilePath
forall a. Show a => a -> FilePath
show Double
i)] []) ()]
parseContents :: XMLParser Double
parseContents = do { Element Posn
e <- [FilePath] -> XMLParser (Element Posn)
element [FilePath
"double"] ; Double -> XMLParser Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Element Posn -> Double
forall a i. Read a => Element i -> a
attval Element Posn
e) }
instance XmlContent Char where
toContents :: Char -> [Content ()]
toContents Char
c = [Element () -> () -> Content ()
forall i. Element i -> i -> Content i
CElem (QName -> [Attribute] -> [Content ()] -> Element ()
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem (FilePath -> QName
N FilePath
"char") [FilePath -> FilePath -> Attribute
mkAttr FilePath
"value" [Char
c]] []) ()]
parseContents :: XMLParser Char
parseContents = do { (Elem QName
_ [(N FilePath
"value",(AttValue [Left [Char
c]]))] [])
<- [FilePath] -> XMLParser (Element Posn)
element [FilePath
"char"]
; Char -> XMLParser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
}
xToChar :: Char -> Char
xToChar = Char -> Char
forall a. a -> a
id
xFromChar :: Char -> Char
xFromChar = Char -> Char
forall a. a -> a
id
instance XmlContent a => XmlContent [a] where
toContents :: [a] -> [Content ()]
toContents [a]
xs = case a -> HType
forall a. HTypeable a => a -> HType
toHType a
x of
(Prim FilePath
"Char" FilePath
_) ->
[FilePath -> [Content ()] -> Content ()
forall a. XmlContent a => a -> [Content ()] -> Content ()
mkElem FilePath
"string" [Bool -> FilePath -> () -> Content ()
forall i. Bool -> FilePath -> i -> Content i
CString Bool
True ((a -> Char) -> [a] -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map a -> Char
forall a. XmlContent a => a -> Char
xToChar [a]
xs) ()]]
HType
_ -> [[a] -> [Content ()] -> Content ()
forall a. XmlContent a => a -> [Content ()] -> Content ()
mkElem [a]
xs ((a -> [Content ()]) -> [a] -> [Content ()]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap a -> [Content ()]
forall a. XmlContent a => a -> [Content ()]
toContents [a]
xs)]
where (a
x:[a]
_) = [a]
xs
parseContents :: XMLParser [a]
parseContents = ([Content Posn] -> Result [Content Posn] [a]) -> XMLParser [a]
forall t a. ([t] -> Result [t] a) -> Parser t a
P (\[Content Posn]
x ->
case [Content Posn]
x of
(CString Bool
_ FilePath
s Posn
_:[Content Posn]
cs)
-> [Content Posn] -> [a] -> Result [Content Posn] [a]
forall z a. z -> a -> Result z a
Success [Content Posn]
cs ((Char -> a) -> FilePath -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Char -> a
forall a. XmlContent a => Char -> a
xFromChar FilePath
s)
(CElem (Elem (N FilePath
"string") [] [CString Bool
_ FilePath
s Posn
_]) Posn
_:[Content Posn]
cs)
-> [Content Posn] -> [a] -> Result [Content Posn] [a]
forall z a. z -> a -> Result z a
Success [Content Posn]
cs ((Char -> a) -> FilePath -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Char -> a
forall a. XmlContent a => Char -> a
xFromChar FilePath
s)
(CElem (Elem (N FilePath
"string") [] []) Posn
_:[Content Posn]
cs)
-> [Content Posn] -> [a] -> Result [Content Posn] [a]
forall z a. z -> a -> Result z a
Success [Content Posn]
cs []
(CElem (Elem (N FilePath
e) [] [Content Posn]
xs) Posn
_:[Content Posn]
cs) | FilePath
"list" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
e
-> [Content Posn] -> Result [Content Posn] [a]
forall a.
XmlContent a =>
[Content Posn] -> Result [Content Posn] [a]
scanElements [Content Posn]
xs
where
scanElements :: [Content Posn] -> Result [Content Posn] [a]
scanElements [] = [Content Posn] -> [a] -> Result [Content Posn] [a]
forall z a. z -> a -> Result z a
Success [Content Posn]
cs []
scanElements [Content Posn]
es =
case Parser (Content Posn) a
-> [Content Posn] -> (Either FilePath a, [Content Posn])
forall t a. Parser t a -> [t] -> (Either FilePath a, [t])
runParser Parser (Content Posn) a
forall a. XmlContent a => XMLParser a
parseContents [Content Posn]
es of
(Left FilePath
msg, [Content Posn]
es') -> [Content Posn] -> FilePath -> Result [Content Posn] [a]
forall z a. z -> FilePath -> Result z a
Failure [Content Posn]
es' FilePath
msg
(Right a
y, [Content Posn]
es') ->
case [Content Posn] -> Result [Content Posn] [a]
scanElements [Content Posn]
es' of
Failure [Content Posn]
ds FilePath
msg -> [Content Posn] -> FilePath -> Result [Content Posn] [a]
forall z a. z -> FilePath -> Result z a
Failure [Content Posn]
ds FilePath
msg
Success [Content Posn]
ds [a]
ys -> [Content Posn] -> [a] -> Result [Content Posn] [a]
forall z a. z -> a -> Result z a
Success [Content Posn]
ds (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
(CElem (Elem QName
e [Attribute]
_ [Content Posn]
_) Posn
pos: [Content Posn]
cs)
-> [Content Posn] -> FilePath -> Result [Content Posn] [a]
forall z a. z -> FilePath -> Result z a
Failure [Content Posn]
cs (FilePath
"Expected a <list-...>, but found a <"
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++QName -> FilePath
printableName QName
e
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
"> at\n"FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++Posn -> FilePath
forall a. Show a => a -> FilePath
show Posn
pos)
(CRef Reference
r Posn
pos: [Content Posn]
cs)
-> [Content Posn] -> FilePath -> Result [Content Posn] [a]
forall z a. z -> FilePath -> Result z a
Failure [Content Posn]
cs (FilePath
"Expected a <list-...>, but found a ref "
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++Reference -> FilePath
forall a. Verbatim a => a -> FilePath
verbatim Reference
rFilePath -> ShowS
forall a. [a] -> [a] -> [a]
++FilePath
" at\n"FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Posn -> FilePath
forall a. Show a => a -> FilePath
show Posn
pos)
(Content Posn
_:[Content Posn]
cs) -> ((\ (P [Content Posn] -> Result [Content Posn] [a]
p)-> [Content Posn] -> Result [Content Posn] [a]
p) XMLParser [a]
forall a. XmlContent a => XMLParser a
parseContents) [Content Posn]
cs
[] -> [Content Posn] -> FilePath -> Result [Content Posn] [a]
forall z a. z -> FilePath -> Result z a
Failure [] FilePath
"Ran out of input XML whilst secondary parsing"
)
instance XmlContent () where
toContents :: () -> [Content ()]
toContents () = [Element () -> () -> Content ()
forall i. Element i -> i -> Content i
CElem (QName -> [Attribute] -> [Content ()] -> Element ()
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem (FilePath -> QName
N FilePath
"unit") [] []) ()]
parseContents :: XMLParser ()
parseContents = do { [FilePath] -> XMLParser (Element Posn)
element [FilePath
"unit"]; () -> XMLParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return () }
instance (XmlContent a) => XmlContent (Maybe a) where
toContents :: Maybe a -> [Content ()]
toContents Maybe a
m = [Maybe a -> [Content ()] -> Content ()
forall a. XmlContent a => a -> [Content ()] -> Content ()
mkElem Maybe a
m ([Content ()] -> (a -> [Content ()]) -> Maybe a -> [Content ()]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] a -> [Content ()]
forall a. XmlContent a => a -> [Content ()]
toContents Maybe a
m)]
parseContents :: XMLParser (Maybe a)
parseContents = do
{ Element Posn
e <- (FilePath -> FilePath -> Bool)
-> [FilePath] -> XMLParser (Element Posn)
elementWith ((FilePath -> FilePath -> Bool) -> FilePath -> FilePath -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf) [FilePath
"maybe"]
; case Element Posn
e of (Elem QName
_ [] []) -> Maybe a -> XMLParser (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
(Elem QName
_ [] [Content Posn]
_) -> (a -> Maybe a) -> Parser (Content Posn) a -> XMLParser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Element Posn -> Parser (Content Posn) a -> Parser (Content Posn) a
forall a. Element Posn -> XMLParser a -> XMLParser a
interior Element Posn
e Parser (Content Posn) a
forall a. XmlContent a => XMLParser a
parseContents)
}
instance (XmlContent a, XmlContent b) => XmlContent (Either a b) where
toContents :: Either a b -> [Content ()]
toContents v :: Either a b
v@(Left a
aa) =
[FilePath -> [Content ()] -> Content ()
mkElemC (Int -> HType -> FilePath
showConstr Int
0 (Either a b -> HType
forall a. HTypeable a => a -> HType
toHType Either a b
v)) (a -> [Content ()]
forall a. XmlContent a => a -> [Content ()]
toContents a
aa)]
toContents v :: Either a b
v@(Right b
ab) =
[FilePath -> [Content ()] -> Content ()
mkElemC (Int -> HType -> FilePath
showConstr Int
1 (Either a b -> HType
forall a. HTypeable a => a -> HType
toHType Either a b
v)) (b -> [Content ()]
forall a. XmlContent a => a -> [Content ()]
toContents b
ab)]
parseContents :: XMLParser (Either a b)
parseContents =
((FilePath -> FilePath -> Bool)
-> FilePath -> XMLParser (Either a b) -> XMLParser (Either a b)
forall a.
(FilePath -> FilePath -> Bool)
-> FilePath -> XMLParser a -> XMLParser a
inElementWith ((FilePath -> FilePath -> Bool) -> FilePath -> FilePath -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf) FilePath
"Left" (XMLParser (Either a b) -> XMLParser (Either a b))
-> XMLParser (Either a b) -> XMLParser (Either a b)
forall a b. (a -> b) -> a -> b
$ (a -> Either a b)
-> Parser (Content Posn) a -> XMLParser (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a b
forall a b. a -> Either a b
Left Parser (Content Posn) a
forall a. XmlContent a => XMLParser a
parseContents)
XMLParser (Either a b)
-> XMLParser (Either a b) -> XMLParser (Either a b)
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
((FilePath -> FilePath -> Bool)
-> FilePath -> XMLParser (Either a b) -> XMLParser (Either a b)
forall a.
(FilePath -> FilePath -> Bool)
-> FilePath -> XMLParser a -> XMLParser a
inElementWith ((FilePath -> FilePath -> Bool) -> FilePath -> FilePath -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf) FilePath
"Right" (XMLParser (Either a b) -> XMLParser (Either a b))
-> XMLParser (Either a b) -> XMLParser (Either a b)
forall a b. (a -> b) -> a -> b
$ (b -> Either a b)
-> Parser (Content Posn) b -> XMLParser (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either a b
forall a b. b -> Either a b
Right Parser (Content Posn) b
forall a. XmlContent a => XMLParser a
parseContents)