diff --git a/HaXml.cabal b/HaXml.cabal --- a/HaXml.cabal +++ b/HaXml.cabal @@ -1,5 +1,5 @@ name: HaXml -version: 1.19.6 +version: 1.19.7 license: LGPL license-file: COPYRIGHT author: Malcolm Wallace @@ -52,7 +52,7 @@ Text.XML.HaXml.Xtract.Lex, Text.XML.HaXml.Xtract.Parse hs-source-dirs: src - build-depends: base, haskell98, polyparse, filepath + build-depends: base, haskell98, polyparse==1.2, filepath if flag(splitBase) build-depends: base >= 3, pretty, random, containers else @@ -62,7 +62,7 @@ else build-depends: base < 2 || >= 3, bytestring extensions: CPP, ExistentialQuantification - cpp-options: -DVERSION=1.19.6 + cpp-options: -DVERSION=1.19.7 nhc98-options: -K10M Executable Canonicalise diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ SOFTWARE = HaXml -VERSION = 1.19.6 +VERSION = 1.19.7 #CPP = cpp -traditional CPP = cpphs --text --noline # useful e.g. on MacOS X diff --git a/docs/HaXml/Text-XML-HaXml-XmlContent.html b/docs/HaXml/Text-XML-HaXml-XmlContent.html --- a/docs/HaXml/Text-XML-HaXml-XmlContent.html +++ b/docs/HaXml/Text-XML-HaXml-XmlContent.html @@ -145,6 +145,16 @@ >module Text.XML.HaXml.TypeMappingtoXml :: module Text.XML.HaXml.XmlContent.Parsermodule Text.XML.HaXml.TypeMappingimport Text.XML.HaXml.Types import Text.XML.HaXml.Lex import Text.XML.HaXml.Posn -import Text.ParserCombinators.Poly.NoLeak.Plain +import Text.ParserCombinators.Poly.Plain -- #define DEBUG diff --git a/docs/HaXml/src/Text/XML/HaXml/Html/ParseLazy.html b/docs/HaXml/src/Text/XML/HaXml/Html/ParseLazy.html --- a/docs/HaXml/src/Text/XML/HaXml/Html/ParseLazy.html +++ b/docs/HaXml/src/Text/XML/HaXml/Html/ParseLazy.html @@ -28,7 +28,7 @@ import Text.XML.HaXml.Types import Text.XML.HaXml.Lex import Text.XML.HaXml.Posn -import Text.ParserCombinators.Poly.NoLeak.Lazy +import Text.ParserCombinators.Poly.Lazy -- #define DEBUG diff --git a/docs/HaXml/src/Text/XML/HaXml/Parse.html b/docs/HaXml/src/Text/XML/HaXml/Parse.html --- a/docs/HaXml/src/Text/XML/HaXml/Parse.html +++ b/docs/HaXml/src/Text/XML/HaXml/Parse.html @@ -47,7 +47,7 @@ import Text.XML.HaXml.Types import Text.XML.HaXml.Posn import Text.XML.HaXml.Lex -import Text.ParserCombinators.Poly.NoLeak.State +import Text.ParserCombinators.Poly.State import System.FilePath (combine, dropFileName) diff --git a/docs/HaXml/src/Text/XML/HaXml/ParseLazy.html b/docs/HaXml/src/Text/XML/HaXml/ParseLazy.html --- a/docs/HaXml/src/Text/XML/HaXml/ParseLazy.html +++ b/docs/HaXml/src/Text/XML/HaXml/ParseLazy.html @@ -47,7 +47,7 @@ import Text.XML.HaXml.Types import Text.XML.HaXml.Posn import Text.XML.HaXml.Lex -import Text.ParserCombinators.Poly.NoLeak.StateLazy +import Text.ParserCombinators.Poly.StateLazy import System.FilePath (combine, dropFileName) diff --git a/docs/HaXml/src/Text/XML/HaXml/SAX.html b/docs/HaXml/src/Text/XML/HaXml/SAX.html --- a/docs/HaXml/src/Text/XML/HaXml/SAX.html +++ b/docs/HaXml/src/Text/XML/HaXml/SAX.html @@ -19,7 +19,7 @@ import Text.XML.HaXml.Types import Text.XML.HaXml.Parse import Text.XML.HaXml.Lex -import Text.ParserCombinators.Poly.NoLeak.State +import Text.ParserCombinators.Poly.State data SaxElement = SaxDocTypeDecl DocTypeDecl diff --git a/docs/HaXml/src/Text/XML/HaXml/XmlContent.html b/docs/HaXml/src/Text/XML/HaXml/XmlContent.html --- a/docs/HaXml/src/Text/XML/HaXml/XmlContent.html +++ b/docs/HaXml/src/Text/XML/HaXml/XmlContent.html @@ -23,164 +23,166 @@ ( -- * Re-export everything from Text.XML.HaXml.XmlContent.Parser. module Text.XML.HaXml.XmlContent.Parser - -- * Contains instances of the XmlContent classes, - -- for the basic Haskell datatypes list and Maybe, - -- intended for use with DtdToHaskell-generated datatypes. - -- See the alternative instances in Text.XML.HaXml.XmlContent.Haskell - -- if your datatypes originate in Haskell instead. --- , module Text.XML.HaXml.XmlContent - - -- * Whole-document conversion functions - , toXml, fromXml - , readXml, showXml, fpsShowXml - , fReadXml, fWriteXml, fpsWriteXml - , hGetXml, hPutXml, fpsHPutXml - ) where - -import IO -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.TypeMapping -import Text.XML.HaXml.Posn (Posn, posInNewCxt) -import Text.XML.HaXml.Pretty (document) -import Text.XML.HaXml.Parse (xmlParse) -import Text.XML.HaXml.XmlContent.Parser - + , module Text.XML.HaXml.TypeMapping + -- * Contains instances of the XmlContent classes, + -- for the basic Haskell datatypes list and Maybe, + -- intended for use with DtdToHaskell-generated datatypes. + -- See the alternative instances in Text.XML.HaXml.XmlContent.Haskell + -- if your datatypes originate in Haskell instead. +-- , module Text.XML.HaXml.XmlContent + + -- * Whole-document conversion functions + , toXml, fromXml + , readXml, showXml, fpsShowXml + , fReadXml, fWriteXml, fpsWriteXml + , hGetXml, hPutXml, fpsHPutXml + ) where + +import IO +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.TypeMapping +import Text.XML.HaXml.Posn (Posn, posInNewCxt) +import Text.XML.HaXml.Pretty (document) +import Text.XML.HaXml.Parse (xmlParse) +import Text.XML.HaXml.XmlContent.Parser ------------------------------------------------------------------------- - - -- probably want to write DTD separately from value, and have - -- easy ways to combine DTD + value into a document, or write - -- them to separate files. - --- | Read an XML document from a file and convert it to a fully-typed --- Haskell value. -fReadXml :: XmlContent a => FilePath -> IO a -fReadXml fp = do - f <- ( if fp=="-" then return stdin - else openFile fp ReadMode ) - x <- hGetContents f - let (Document _ _ y _) = xmlParse fp x - y' = CElem y (posInNewCxt fp Nothing) - either fail return (fst (runParser parseContents [y'])) - --- | Write a fully-typed Haskell value to the given file as an XML --- document. -fWriteXml :: XmlContent a => FilePath -> a -> IO () -fWriteXml fp x = do - f <- ( if fp=="-" then return stdout - else openFile fp WriteMode ) - hPutXml f False x - hClose f - --- | Write any Haskell value to the given file as an XML document, --- using the FastPackedString interface (output will not be prettified). -fpsWriteXml :: XmlContent a => FilePath -> a -> IO () -fpsWriteXml fp x = do - f <- ( if fp=="-" then return stdout - else openFile fp WriteMode ) - fpsHPutXml f False x - hClose f - --- | Read a fully-typed XML document from a string. -readXml :: XmlContent a => String -> Either String a -readXml s = - let (Document _ _ y _) = xmlParse "string input" s in - fst (runParser parseContents - [CElem y (posInNewCxt "string input" Nothing)]) - --- | Convert a fully-typed XML document to a string (without DTD). -showXml :: XmlContent a => Bool -> a -> String -showXml dtd x = - case toContents x of - [CElem _ _] -> (render . document . toXml dtd) x - _ -> "" - --- | Convert a fully-typed XML document to a ByteString (without DTD). -fpsShowXml :: XmlContent a => Bool -> a -> FPS.ByteString -fpsShowXml dtd x = - case toContents x of - [CElem _ _] -> (FPS.document . toXml dtd) x - _ -> FPS.empty - + +------------------------------------------------------------------------ + + -- probably want to write DTD separately from value, and have + -- easy ways to combine DTD + value into a document, or write + -- them to separate files. + +-- | Read an XML document from a file and convert it to a fully-typed +-- Haskell value. +fReadXml :: XmlContent a => FilePath -> IO a +fReadXml fp = do + f <- ( if fp=="-" then return stdin + else openFile fp ReadMode ) + x <- hGetContents f + let (Document _ _ y _) = xmlParse fp x + y' = CElem y (posInNewCxt fp Nothing) + either fail return (fst (runParser parseContents [y'])) + +-- | Write a fully-typed Haskell value to the given file as an XML +-- document. +fWriteXml :: XmlContent a => FilePath -> a -> IO () +fWriteXml fp x = do + f <- ( if fp=="-" then return stdout + else openFile fp WriteMode ) + hPutXml f False x + hClose f + +-- | Write any Haskell value to the given file as an XML document, +-- using the FastPackedString interface (output will not be prettified). +fpsWriteXml :: XmlContent a => FilePath -> a -> IO () +fpsWriteXml fp x = do + f <- ( if fp=="-" then return stdout + else openFile fp WriteMode ) + fpsHPutXml f False x + hClose f + +-- | Read a fully-typed XML document from a string. +readXml :: XmlContent a => String -> Either String a +readXml s = + let (Document _ _ y _) = xmlParse "string input" s in + fst (runParser parseContents + [CElem y (posInNewCxt "string input" Nothing)]) + +-- | Convert a fully-typed XML document to a string (without DTD). +showXml :: XmlContent a => Bool -> a -> String +showXml dtd x = + case toContents x of + [CElem _ _] -> (render . document . toXml dtd) x + _ -> "" + +-- | Convert a fully-typed XML document to a ByteString (without DTD). +fpsShowXml :: XmlContent a => Bool -> a -> FPS.ByteString +fpsShowXml dtd x = + case toContents x of + [CElem _ _] -> (FPS.document . toXml dtd) x + _ -> FPS.empty --- | Convert a fully-typed XML document to a string (with or without DTD). -toXml :: XmlContent a => Bool -> a -> Document () -toXml dtd value = - let ht = toHType value in - Document (Prolog (Just (XMLDecl "1.0" Nothing Nothing)) - [] (if dtd then Just (toDTD ht) else Nothing) []) - emptyST - ( case toContents value of - [] -> Elem "empty" [] [] - [CElem e ()] -> e - (CElem e ():_) -> error "too many XML elements in document" ) - [] - --- | Read a Haskell value from an XML document, ignoring the DTD and --- using the Haskell result type to determine how to parse it. -fromXml :: XmlContent a => Document Posn -> Either String a -fromXml (Document _ _ e@(Elem n _ cs) _) = - fst (runParser parseContents [CElem e (posInNewCxt "document" Nothing)]) - + +-- | Convert a fully-typed XML document to a string (with or without DTD). +toXml :: XmlContent a => Bool -> a -> Document () +toXml dtd value = + let ht = toHType value in + Document (Prolog (Just (XMLDecl "1.0" Nothing Nothing)) + [] (if dtd then Just (toDTD ht) else Nothing) []) + emptyST + ( case toContents value of + [] -> Elem "empty" [] [] + [CElem e ()] -> e + (CElem e ():_) -> error "too many XML elements in document" ) + [] + +-- | Read a Haskell value from an XML document, ignoring the DTD and +-- using the Haskell result type to determine how to parse it. +fromXml :: XmlContent a => Document Posn -> Either String a +fromXml (Document _ _ e@(Elem n _ cs) _) = + fst (runParser parseContents [CElem e (posInNewCxt "document" Nothing)]) --- | Read a fully-typed XML document from a file handle. -hGetXml :: XmlContent a => Handle -> IO a -hGetXml h = do - x <- hGetContents h - let (Document _ _ y _) = xmlParse "file handle" x - either fail return - (fst (runParser parseContents - [CElem y (posInNewCxt "file handle" Nothing)])) - --- | Write a fully-typed XML document to a file handle. -hPutXml :: XmlContent a => Handle -> Bool -> a -> IO () -hPutXml h dtd x = do - (hPutStrLn h . render . document . toXml dtd) x - --- | Write a fully-typed XML document to a file handle, using the --- FastPackedString interface (output will not be prettified). -fpsHPutXml :: XmlContent a => Handle -> Bool -> a -> IO () -fpsHPutXml h dtd x = do - (FPS.hPut h . FPS.document . toXml dtd) x - + +-- | Read a fully-typed XML document from a file handle. +hGetXml :: XmlContent a => Handle -> IO a +hGetXml h = do + x <- hGetContents h + let (Document _ _ y _) = xmlParse "file handle" x + either fail return + (fst (runParser parseContents + [CElem y (posInNewCxt "file handle" Nothing)])) + +-- | Write a fully-typed XML document to a file handle. +hPutXml :: XmlContent a => Handle -> Bool -> a -> IO () +hPutXml h dtd x = do + (hPutStrLn h . render . document . toXml dtd) x + +-- | Write a fully-typed XML document to a file handle, using the +-- FastPackedString interface (output will not be prettified). +fpsHPutXml :: XmlContent a => Handle -> Bool -> a -> IO () +fpsHPutXml h dtd x = do + (FPS.hPut h . FPS.document . toXml dtd) x ------------------------------------------------------------------------- --- Instances for all the standard basic datatypes. --- DtdToHaskell uses only a small number of standard datatypes. ------------------------------------------------------------------------- - -instance XmlContent Char where - -- NOT in a string - toContents c = error "Text.XML.HaXml.XmlContent.toContents used on a Haskell Char" - parseContents = fail "Text.XML.HaXml.XmlContent.parseContents used on a Haskell Char " - -- Only defined for Char and no other types: - xToChar = id - xFromChar = id - -instance XmlContent a => XmlContent [a] where - toContents xs = case toHType x of - (Prim "Char" _) -> - [CString True (map xToChar xs) ()] - _ -> concatMap toContents xs - where (x:_) = xs - parseContents = let (Right (x:_),_) = runParser p [] -- for type of x only - p = case toHType x of - (Prim "Char" _) -> fmap (map xFromChar) $ text - _ -> many parseContents - in p - -- comments, PIs, etc, are skipped in the individual element parser. - -instance (XmlContent a) => XmlContent (Maybe a) where - toContents m = maybe [] toContents m - parseContents = optional parseContents - ------------------------------------------------------------------------- + +------------------------------------------------------------------------ +-- Instances for all the standard basic datatypes. +-- DtdToHaskell uses only a small number of standard datatypes. +------------------------------------------------------------------------ + +instance XmlContent Char where + -- NOT in a string + toContents c = error "Text.XML.HaXml.XmlContent.toContents used on a Haskell Char" + parseContents = fail "Text.XML.HaXml.XmlContent.parseContents used on a Haskell Char " + -- Only defined for Char and no other types: + xToChar = id + xFromChar = id + +instance XmlContent a => XmlContent [a] where + toContents xs = case toHType x of + (Prim "Char" _) -> + [CString True (map xToChar xs) ()] + _ -> concatMap toContents xs + where (x:_) = xs + parseContents = let result = runParser p [] -- for type of result only + p = case (toHType . head . (\ (Right x)->x) . fst) + result of + (Prim "Char" _) -> fmap (map xFromChar) $ text + _ -> many parseContents + in p + -- comments, PIs, etc, are skipped in the individual element parser. + +instance (XmlContent a) => XmlContent (Maybe a) where + toContents m = maybe [] toContents m + parseContents = optional parseContents + +------------------------------------------------------------------------ diff --git a/docs/HaXml/src/Text/XML/HaXml/XmlContent/Haskell.html b/docs/HaXml/src/Text/XML/HaXml/XmlContent/Haskell.html --- a/docs/HaXml/src/Text/XML/HaXml/XmlContent/Haskell.html +++ b/docs/HaXml/src/Text/XML/HaXml/XmlContent/Haskell.html @@ -198,65 +198,61 @@ parseContents = P (\x -> case x of (CString _ s _:cs) - -> (Right (map xFromChar s), cs) + -> Success cs (map xFromChar s) (CElem (Elem "string" [] [CString _ s _]) _:cs) - -> (Right (map xFromChar s), cs) + -> Success cs (map xFromChar s) (CElem (Elem e [] xs) _:cs) | "list" `isPrefixOf` e -> scanElements xs where -- scanElements :: [Content] -> (Either String [a],[Content]) - scanElements [] = (Right [], cs) + scanElements [] = Success cs [] scanElements es = case runParser parseContents es of - (Left msg, es') -> (Left (False,msg), es') + (Left msg, es') -> Failure es' msg (Right y, es') -> case scanElements es' of - (Left msg, ds) -> (Left msg, ds) - (Right ys, ds) -> (Right (y:ys), ds) + Failure ds msg -> Failure ds msg + Success ds ys -> Success ds (y:ys) (CElem (Elem e _ _) pos: cs) - -> (Left (False - ,"Expected a <list-...>, but found a <"++e++"> at\n" - ++ show pos), cs) - (CRef r pos: cs) - -> (Left (False - ,"Expected a <list-...>, but found a ref " - ++verbatim r++" at\n"++ show pos), cs) - (_:cs) -> ((\ (P p)-> p) parseContents) cs -- skip comments etc. - [] -> (Left (False - ,"Ran out of input XML whilst secondary parsing") - , []) - ) + -> Failure cs ("Expected a <list-...>, but found a <"++e + ++"> at\n"++show pos) + (CRef r pos: cs) + -> Failure cs ("Expected a <list-...>, but found a ref " + ++verbatim r++" at\n"++ show pos) + (_:cs) -> ((\ (P p)-> p) parseContents) cs -- skip comments etc. + [] -> Failure [] "Ran out of input XML whilst secondary parsing" + ) + +instance XmlContent () where + toContents () = [CElem (Elem "unit" [] []) ()] + parseContents = do { element ["unit"]; return () } -instance XmlContent () where - toContents () = [CElem (Elem "unit" [] []) ()] - parseContents = do { element ["unit"]; return () } - - -instance (XmlContent a) => XmlContent (Maybe a) where - toContents m = [mkElem m (maybe [] toContents m)] - parseContents = do - { e <- elementWith (flip isPrefixOf) ["maybe"] - ; case e of (Elem _ [] []) -> return Nothing - (Elem _ [] _) -> fmap Just (interior e parseContents) - } - -instance (XmlContent a, XmlContent b) => XmlContent (Either a b) where - toContents v@(Left aa) = - [mkElemC (showConstr 0 (toHType v)) (toContents aa)] - toContents v@(Right ab) = - [mkElemC (showConstr 1 (toHType v)) (toContents ab)] - parseContents = - (inElementWith (flip isPrefixOf) "Left" $ fmap Left parseContents) - `onFail` - (inElementWith (flip isPrefixOf) "Right" $ fmap Right parseContents) - --- do{ e@(Elem t [] _) <- element ["Left","Right"] --- ; case t of --- _ | "Left" `isPrefixOf` t -> fmap Left (interior e parseContents) --- | "Right" `isPrefixOf` t -> fmap Right (interior e parseContents) --- } - ------------------------------------------------------------------------- + +instance (XmlContent a) => XmlContent (Maybe a) where + toContents m = [mkElem m (maybe [] toContents m)] + parseContents = do + { e <- elementWith (flip isPrefixOf) ["maybe"] + ; case e of (Elem _ [] []) -> return Nothing + (Elem _ [] _) -> fmap Just (interior e parseContents) + } + +instance (XmlContent a, XmlContent b) => XmlContent (Either a b) where + toContents v@(Left aa) = + [mkElemC (showConstr 0 (toHType v)) (toContents aa)] + toContents v@(Right ab) = + [mkElemC (showConstr 1 (toHType v)) (toContents ab)] + parseContents = + (inElementWith (flip isPrefixOf) "Left" $ fmap Left parseContents) + `onFail` + (inElementWith (flip isPrefixOf) "Right" $ fmap Right parseContents) + +-- do{ e@(Elem t [] _) <- element ["Left","Right"] +-- ; case t of +-- _ | "Left" `isPrefixOf` t -> fmap Left (interior e parseContents) +-- | "Right" `isPrefixOf` t -> fmap Right (interior e parseContents) +-- } + +------------------------------------------------------------------------ diff --git a/docs/HaXml/src/Text/XML/HaXml/XmlContent/Parser.html b/docs/HaXml/src/Text/XML/HaXml/XmlContent/Parser.html --- a/docs/HaXml/src/Text/XML/HaXml/XmlContent/Parser.html +++ b/docs/HaXml/src/Text/XML/HaXml/XmlContent/Parser.html @@ -248,7 +248,7 @@ choice cons (P other) = P (\cs-> case runParser parseContents cs of (Left _, _) -> other cs - (Right x, cs') -> (Right (cons x), cs')) + (Right x, cs') -> Success cs' (cons x) ) --choice cons other = fmap cons parseContents `onFail` other @@ -257,8 +257,8 @@ -- care of that for us. definite :: XmlContent a => XMLParser a -> String -> String -> XMLParser a definite p inner tag = P (\cs-> case runParser p cs of - (Left _, cs') -> (Left (False,msg'), cs') - (Right x, cs') -> (Right x, cs')) + (Left _, cs') -> Failure cs' msg' + (Right x, cs') -> Success cs' x ) where msg' = "content error: expected "++inner++" inside <"++tag ++"> element\n" @@ -690,7 +690,7 @@ instance XmlContent ANYContent where toContents (ANYContent a) = toContents a toContents (UnConverted s) = map (fmap (const ())) s - parseContents = P (\cs -> (Right (UnConverted cs), [])) + parseContents = P (\cs -> Success [] (UnConverted cs)) ------------------------------------------------------------------------ -- diff --git a/docs/HaXml/src/Text/XML/HaXml/Xtract/Parse.html b/docs/HaXml/src/Text/XML/HaXml/Xtract/Parse.html --- a/docs/HaXml/src/Text/XML/HaXml/Xtract/Parse.html +++ b/docs/HaXml/src/Text/XML/HaXml/Xtract/Parse.html @@ -63,19 +63,19 @@ string :: XParser String string = P (\inp -> case inp of - (Left err: _) -> (Left (False,err), inp) - (Right (p,TokString n):ts) -> (Right n, ts) - ts -> (Left (False,"expected a string"), ts) ) + (Left err: _) -> Failure inp err + (Right (p,TokString n):ts) -> Success ts n + ts -> Failure ts "expected a string" ) number :: XParser Integer number = P (\inp -> case inp of - (Left err: _) -> (Left (False,err), inp) - (Right (p,TokNum n):ts) -> (Right n, ts) - ts -> (Left (False,"expected a number"), ts) ) + (Left err: _) -> Failure inp err + (Right (p,TokNum n):ts) -> Success ts n + ts -> Failure ts "expected a number" ) symbol :: String -> XParser () symbol s = P (\inp -> case inp of - (Left err: _) -> (Left (False,err), inp) - (Right (p, Symbol n):ts) | n==s -> (Right (), ts) - ts -> (Left (False,"expected symbol "++s), ts) ) + (Left err: _) -> Failure inp err + (Right (p, Symbol n):ts) | n==s -> Success ts () + ts -> Failure ts ("expected symbol "++s) ) quote = oneOf [ symbol "'", symbol "\"" ] diff --git a/docs/changelog.html b/docs/changelog.html --- a/docs/changelog.html +++ b/docs/changelog.html @@ -29,7 +29,9 @@ specifications.
  • Version 1.19.6 fixes some tag-name bugs when converting datatypes generated by DtdToHaskell back into an XML file value. - +
  • Version 1.19.7 requires package polyparse-1.2 (earlier versions + require polyparse-1.1). +

    Changes in 1.18

    diff --git a/docs/index.html b/docs/index.html --- a/docs/index.html +++ b/docs/index.html @@ -132,11 +132,11 @@

    Downloads

    Development versions:
    -HaXml-1.19.6, release date 2009.02.04
    +HaXml-1.19.7, release date 2009.03.05
    From Hackage
    By HTTP: -.tar.gz, -.zip. +.tar.gz, +.zip.
    By FTP: @@ -203,6 +203,8 @@

    Recent news

    +Version 1.19.7 requires package polyparse-1.2 (previous versions require +polyparse-1.1).
    Version 1.19.6 has some bugfixes to XmlContent, to ensure that types created via DtdToHaskell get converted back to XML correctly.
    Version 1.19.5 has some bugfixes to DtdToHaskell, to cope with especially diff --git a/src/Makefile b/src/Makefile --- a/src/Makefile +++ b/src/Makefile @@ -1,5 +1,5 @@ SOFTWARE = HaXml -VERSION = 1.19.6 +VERSION = 1.19.7 LIBSRCS = \ Text/XML/HaXml.hs Text/XML/HaXml/Combinators.hs Text/XML/HaXml/Lex.hs \ diff --git a/src/Text/XML/HaXml/Html/Parse.hs b/src/Text/XML/HaXml/Html/Parse.hs --- a/src/Text/XML/HaXml/Html/Parse.hs +++ b/src/Text/XML/HaXml/Html/Parse.hs @@ -21,7 +21,7 @@ import Text.XML.HaXml.Types import Text.XML.HaXml.Lex import Text.XML.HaXml.Posn -import Text.ParserCombinators.Poly.NoLeak.Plain +import Text.ParserCombinators.Poly.Plain -- #define DEBUG diff --git a/src/Text/XML/HaXml/Html/ParseLazy.hs b/src/Text/XML/HaXml/Html/ParseLazy.hs --- a/src/Text/XML/HaXml/Html/ParseLazy.hs +++ b/src/Text/XML/HaXml/Html/ParseLazy.hs @@ -21,7 +21,7 @@ import Text.XML.HaXml.Types import Text.XML.HaXml.Lex import Text.XML.HaXml.Posn -import Text.ParserCombinators.Poly.NoLeak.Lazy +import Text.ParserCombinators.Poly.Lazy -- #define DEBUG diff --git a/src/Text/XML/HaXml/Parse.hs b/src/Text/XML/HaXml/Parse.hs --- a/src/Text/XML/HaXml/Parse.hs +++ b/src/Text/XML/HaXml/Parse.hs @@ -40,7 +40,7 @@ import Text.XML.HaXml.Types import Text.XML.HaXml.Posn import Text.XML.HaXml.Lex -import Text.ParserCombinators.Poly.NoLeak.State +import Text.ParserCombinators.Poly.State import System.FilePath (combine, dropFileName) diff --git a/src/Text/XML/HaXml/ParseLazy.hs b/src/Text/XML/HaXml/ParseLazy.hs --- a/src/Text/XML/HaXml/ParseLazy.hs +++ b/src/Text/XML/HaXml/ParseLazy.hs @@ -40,7 +40,7 @@ import Text.XML.HaXml.Types import Text.XML.HaXml.Posn import Text.XML.HaXml.Lex -import Text.ParserCombinators.Poly.NoLeak.StateLazy +import Text.ParserCombinators.Poly.StateLazy import System.FilePath (combine, dropFileName) diff --git a/src/Text/XML/HaXml/SAX.hs b/src/Text/XML/HaXml/SAX.hs --- a/src/Text/XML/HaXml/SAX.hs +++ b/src/Text/XML/HaXml/SAX.hs @@ -12,7 +12,7 @@ import Text.XML.HaXml.Types import Text.XML.HaXml.Parse import Text.XML.HaXml.Lex -import Text.ParserCombinators.Poly.NoLeak.State +import Text.ParserCombinators.Poly.State data SaxElement = SaxDocTypeDecl DocTypeDecl diff --git a/src/Text/XML/HaXml/XmlContent.hs b/src/Text/XML/HaXml/XmlContent.hs --- a/src/Text/XML/HaXml/XmlContent.hs +++ b/src/Text/XML/HaXml/XmlContent.hs @@ -16,6 +16,7 @@ ( -- * Re-export everything from Text.XML.HaXml.XmlContent.Parser. module Text.XML.HaXml.XmlContent.Parser + , module Text.XML.HaXml.TypeMapping -- * Contains instances of the XmlContent classes, -- for the basic Haskell datatypes list and Maybe, -- intended for use with DtdToHaskell-generated datatypes. @@ -162,8 +163,9 @@ [CString True (map xToChar xs) ()] _ -> concatMap toContents xs where (x:_) = xs - parseContents = let (Right (x:_),_) = runParser p [] -- for type of x only - p = case toHType x of + parseContents = let result = runParser p [] -- for type of result only + p = case (toHType . head . (\ (Right x)->x) . fst) + result of (Prim "Char" _) -> fmap (map xFromChar) $ text _ -> many parseContents in p diff --git a/src/Text/XML/HaXml/XmlContent/Haskell.hs b/src/Text/XML/HaXml/XmlContent/Haskell.hs --- a/src/Text/XML/HaXml/XmlContent/Haskell.hs +++ b/src/Text/XML/HaXml/XmlContent/Haskell.hs @@ -191,33 +191,29 @@ parseContents = P (\x -> case x of (CString _ s _:cs) - -> (Right (map xFromChar s), cs) + -> Success cs (map xFromChar s) (CElem (Elem "string" [] [CString _ s _]) _:cs) - -> (Right (map xFromChar s), cs) + -> Success cs (map xFromChar s) (CElem (Elem e [] xs) _:cs) | "list" `isPrefixOf` e -> scanElements xs where -- scanElements :: [Content] -> (Either String [a],[Content]) - scanElements [] = (Right [], cs) + scanElements [] = Success cs [] scanElements es = case runParser parseContents es of - (Left msg, es') -> (Left (False,msg), es') + (Left msg, es') -> Failure es' msg (Right y, es') -> case scanElements es' of - (Left msg, ds) -> (Left msg, ds) - (Right ys, ds) -> (Right (y:ys), ds) + Failure ds msg -> Failure ds msg + Success ds ys -> Success ds (y:ys) (CElem (Elem e _ _) pos: cs) - -> (Left (False - ,"Expected a , but found a <"++e++"> at\n" - ++ show pos), cs) + -> Failure cs ("Expected a , but found a <"++e + ++"> at\n"++show pos) (CRef r pos: cs) - -> (Left (False - ,"Expected a , but found a ref " - ++verbatim r++" at\n"++ show pos), cs) + -> Failure cs ("Expected a , but found a ref " + ++verbatim r++" at\n"++ show pos) (_:cs) -> ((\ (P p)-> p) parseContents) cs -- skip comments etc. - [] -> (Left (False - ,"Ran out of input XML whilst secondary parsing") - , []) + [] -> Failure [] "Ran out of input XML whilst secondary parsing" ) instance XmlContent () where diff --git a/src/Text/XML/HaXml/XmlContent/Parser.hs b/src/Text/XML/HaXml/XmlContent/Parser.hs --- a/src/Text/XML/HaXml/XmlContent/Parser.hs +++ b/src/Text/XML/HaXml/XmlContent/Parser.hs @@ -241,7 +241,7 @@ choice cons (P other) = P (\cs-> case runParser parseContents cs of (Left _, _) -> other cs - (Right x, cs') -> (Right (cons x), cs')) + (Right x, cs') -> Success cs' (cons x) ) --choice cons other = fmap cons parseContents `onFail` other @@ -250,8 +250,8 @@ -- care of that for us. definite :: XmlContent a => XMLParser a -> String -> String -> XMLParser a definite p inner tag = P (\cs-> case runParser p cs of - (Left _, cs') -> (Left (False,msg'), cs') - (Right x, cs') -> (Right x, cs')) + (Left _, cs') -> Failure cs' msg' + (Right x, cs') -> Success cs' x ) where msg' = "content error: expected "++inner++" inside <"++tag ++"> element\n" @@ -683,7 +683,7 @@ instance XmlContent ANYContent where toContents (ANYContent a) = toContents a toContents (UnConverted s) = map (fmap (const ())) s - parseContents = P (\cs -> (Right (UnConverted cs), [])) + parseContents = P (\cs -> Success [] (UnConverted cs)) ------------------------------------------------------------------------ -- diff --git a/src/Text/XML/HaXml/Xtract/Parse.hs b/src/Text/XML/HaXml/Xtract/Parse.hs --- a/src/Text/XML/HaXml/Xtract/Parse.hs +++ b/src/Text/XML/HaXml/Xtract/Parse.hs @@ -56,19 +56,19 @@ string :: XParser String string = P (\inp -> case inp of - (Left err: _) -> (Left (False,err), inp) - (Right (p,TokString n):ts) -> (Right n, ts) - ts -> (Left (False,"expected a string"), ts) ) + (Left err: _) -> Failure inp err + (Right (p,TokString n):ts) -> Success ts n + ts -> Failure ts "expected a string" ) number :: XParser Integer number = P (\inp -> case inp of - (Left err: _) -> (Left (False,err), inp) - (Right (p,TokNum n):ts) -> (Right n, ts) - ts -> (Left (False,"expected a number"), ts) ) + (Left err: _) -> Failure inp err + (Right (p,TokNum n):ts) -> Success ts n + ts -> Failure ts "expected a number" ) symbol :: String -> XParser () symbol s = P (\inp -> case inp of - (Left err: _) -> (Left (False,err), inp) - (Right (p, Symbol n):ts) | n==s -> (Right (), ts) - ts -> (Left (False,"expected symbol "++s), ts) ) + (Left err: _) -> Failure inp err + (Right (p, Symbol n):ts) | n==s -> Success ts () + ts -> Failure ts ("expected symbol "++s) ) quote = oneOf [ symbol "'", symbol "\"" ]