HaXml 1.25.5 → 1.25.6
raw patch · 26 files changed
+321/−317 lines, 26 filesdep ~basenew-uploaderPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: base
API changes (from Hackage documentation)
- Text.XML.HaXml.XmlContent.Parser: catMaybes :: () => [Maybe a] -> [a]
+ Text.XML.HaXml.XmlContent.Parser: catMaybes :: [Maybe a] -> [a]
Files
- Changelog.md +5/−1
- HaXml.cabal +32/−22
- src/Text/XML/HaXml/Combinators.hs +7/−7
- src/Text/XML/HaXml/DtdToHaskell/TypeDef.hs +2/−2
- src/Text/XML/HaXml/Escape.hs +2/−2
- src/Text/XML/HaXml/Html/Parse.hs +11/−12
- src/Text/XML/HaXml/Html/ParseLazy.hs +7/−8
- src/Text/XML/HaXml/Html/Pretty.hs +34/−34
- src/Text/XML/HaXml/Lex.hs +65/−65
- src/Text/XML/HaXml/Parse.hs +1/−2
- src/Text/XML/HaXml/ParseLazy.hs +1/−2
- src/Text/XML/HaXml/SAX.hs +32/−32
- src/Text/XML/HaXml/Schema/Environment.hs +1/−2
- src/Text/XML/HaXml/Schema/PrettyHaskell.hs +11/−12
- src/Text/XML/HaXml/Schema/PrimitiveTypes.hs +4/−5
- src/Text/XML/HaXml/TypeMapping.hs +10/−10
- src/Text/XML/HaXml/Validate.hs +7/−7
- src/Text/XML/HaXml/Version.hs +1/−1
- src/Text/XML/HaXml/Xtract/Combinators.hs +2/−2
- src/Text/XML/HaXml/Xtract/Lex.hs +3/−3
- src/Text/XML/HaXml/Xtract/Parse.hs +50/−51
- src/tools/DtdToHaskell.hs +2/−3
- src/tools/FpMLToHaskell.hs +17/−19
- src/tools/MkOneOf.hs +6/−6
- src/tools/XsdToHaskell.hs +2/−2
- src/tools/Xtract.hs +6/−5
Changelog.md view
@@ -1,4 +1,8 @@-## 1.25.5+## 1.25.6 (2021-09-26)++- GHC 8.8, 8.10, and 9.0 compatibility++## 1.25.5 (2018-10-30) - GHC-8.4 and GHC-8.6 compatibility - Monoids have Semigroup instances
HaXml.cabal view
@@ -1,25 +1,26 @@-cabal-version: >= 1.8+cabal-version: >= 1.10 name: HaXml-version: 1.25.5+version: 1.25.6 license: LGPL license-files: COPYRIGHT, LICENCE-GPL, LICENCE-LGPL author: Malcolm Wallace <Malcolm.Wallace@me.com>-maintainer: author-homepage: http://projects.haskell.org/HaXml/-bug-reports: https://github.com/haskell-infra/hackage-trustees/issues+maintainer: Jens Petersen <juhpetersen@gmail.com>+homepage: https://github.com/HaXml/HaXml+bug-reports: https://github.com/HaXml/HaXml/issues category: Text, XML synopsis: Utilities for manipulating XML documents description:- This version, 1.25.5 is a Non-Maintainer Upload (NMU). Report issues to the Hackage Trustees issue tracker.- . Haskell utilities for parsing, filtering, transforming and generating XML documents. build-type: Simple extra-source-files: Changelog.md tested-with:- GHC ==8.6.1+ GHC ==9.0.1+ || ==8.10.7+ || ==8.8.4+ || ==8.6.5 || ==8.4.4 || ==8.2.2 || ==8.0.2@@ -32,8 +33,8 @@ source-repository this type: git- location: https://github.com/hackage-trustees/malcolm-wallace-universe.git- tag: 1.25.5+ location: https://github.com/HaXml/HaXml.git+ tag: v1.25.6 library exposed-modules:@@ -84,71 +85,80 @@ Text.XML.HaXml.Schema.Schema hs-source-dirs: src build-depends:- base >= 4.3.1.0 && < 4.13,+ base >= 4.3.1.0 && < 4.16, bytestring >= 0.9.1.10 && < 0.11, containers >= 0.4.0.0 && <0.7, filepath >= 1.2.0.0 && <1.5, pretty >= 1.0.1.2 && <1.2,- random >= 1.0 && <1.2,- polyparse >= 1.12.1 && <1.13+ random >= 1.0 && <1.3,+ polyparse >= 1.12.1 && <1.14 if !impl(ghc >= 8.0) build-depends: semigroups >= 0.18.5 && < 0.19- extensions: CPP, ExistentialQuantification+ default-language: Haskell98+ default-extensions: CPP, ExistentialQuantification nhc98-options: -K10M Executable Canonicalise GHC-Options: -Wall- Extensions: CPP+ Default-Language: Haskell98+ Default-Extensions: CPP Hs-Source-Dirs: src/tools Main-Is: Canonicalise.hs build-depends: base, HaXml, pretty Executable CanonicaliseLazy GHC-Options: -Wall- Extensions: CPP+ Default-Language: Haskell98+ Default-Extensions: CPP Hs-Source-Dirs: src/tools Main-Is: CanonicaliseLazy.hs build-depends: base, HaXml, pretty Executable Xtract GHC-Options: -Wall- Extensions: CPP+ Default-Language: Haskell98+ Default-Extensions: CPP Hs-Source-Dirs: src/tools Main-Is: Xtract.hs build-depends: base, HaXml, pretty Executable Validate GHC-Options: -Wall- Extensions: CPP+ Default-Language: Haskell98+ Default-Extensions: CPP Hs-Source-Dirs: src/tools Main-Is: Validate.hs build-depends: base, HaXml Executable MkOneOf GHC-Options: -Wall- Extensions: CPP+ Default-Language: Haskell98+ Default-Extensions: CPP Hs-Source-Dirs: src/tools Main-Is: MkOneOf.hs build-depends: base, HaXml Executable DtdToHaskell GHC-Options: -Wall- Extensions: CPP+ Default-Language: Haskell98+ Default-Extensions: CPP Hs-Source-Dirs: src/tools Main-Is: DtdToHaskell.hs build-depends: base, HaXml, pretty Executable XsdToHaskell GHC-Options: -Wall- Extensions: CPP+ Default-Language: Haskell98+ Default-Extensions: CPP Hs-Source-Dirs: src/tools Main-Is: XsdToHaskell.hs build-depends: base, HaXml, pretty, polyparse, directory Executable FpMLToHaskell GHC-Options: -Wall- Extensions: CPP+ Default-Language: Haskell98+ Default-Extensions: CPP Hs-Source-Dirs: src/tools Main-Is: FpMLToHaskell.hs build-depends: base, HaXml, pretty, polyparse, directory
src/Text/XML/HaXml/Combinators.hs view
@@ -56,7 +56,7 @@ import Data.Maybe (fromMaybe) infixl 6 `with`, `without`-infixr 5 `o`, `oo`, `union`, `andThen` -- , `orelse`+infixr 5 `o`, `oo`, `union`, `andThen` -- , `orelse` infixl 5 />, </, |>| infixr 4 `when`, `guards` infixr 3 ?>, :>@@ -184,7 +184,7 @@ -- rather than one filter using the result of the other. -- (Has a more general type than just CFilter.) union :: (a->[b]) -> (a->[b]) -> (a->[b])-union = lift (++) -- in Haskell 98: union = lift List.union+union = lift (++) -- in Haskell 98: union = lift List.union where lift :: (a->b->d) -> (c->a) -> (c->b) -> c -> d lift f g h = \x-> f (g x) (h x)@@ -201,10 +201,10 @@ -- works over the same data as the first, but also uses the -- first's result. andThen :: (a->c) -> (c->a->b) -> (a->b)-andThen f g = \x-> g (f x) x -- lift g f id+andThen f g = \x-> g (f x) x -- lift g f id -- | Process children using specified filters.-childrenBy :: CFilter i -> CFilter i +childrenBy :: CFilter i -> CFilter i childrenBy f = f `o` children -- | Directional choice:@@ -264,7 +264,7 @@ -- otherwise the content is discarded. guards :: CFilter i -> CFilter i -> CFilter i f `when` g = g ?> f :> keep-g `guards` f = g ?> f :> none -- = f `o` (keep `with` g)+g `guards` f = g ?> f :> none -- = f `o` (keep `with` g) -- | Process CHildren In Place. The filter is applied to any children -- of an element content, and the element rebuilt around the results.@@ -389,7 +389,7 @@ -- > labelAllPaths = allPaths `o` initialise -- > where -- > initialise = annotateOne "/"--- > +-- > -- > allPaths :: CFilter a -- > allPaths = inplace ( allPaths -- > `o`@@ -478,7 +478,7 @@ -- | Label each content with some information extracted from itself. extracted :: (Content i->a) -> CFilter i -> LabelFilter i a extracted proj f = concatMap (\c->[(proj c, c)]) . f- + {-
src/Text/XML/HaXml/DtdToHaskell/TypeDef.hs view
@@ -50,8 +50,8 @@ | Tuple [StructType] | OneOf [StructType] | Any -- ^ XML's contentspec allows ANY- | StringMixed -- ^ mixed (#PCDATA | ... )*- | String -- ^ string only (#PCDATA)+ | StringMixed -- ^ mixed (#PCDATA | ... )*+ | String -- ^ string only (#PCDATA) | Defined Name deriving Eq
src/Text/XML/HaXml/Escape.hs view
@@ -241,14 +241,14 @@ compress :: [Either String Reference] -> [Either String Reference] compress [] = [] compress (Right ref : es) = Right ref : (compress es)- compress ( (ls @ (Left s1)) : es) =+ compress ( (ls@(Left s1)) : es) = case compress es of (Left s2 : es2) -> Left (s1 ++ s2) : es2 es2 -> ls : es2 compressContent :: [Content i] -> [Content i] compressContent [] = []-compressContent ((csb @ (CString b1 s1 i1)) : cs) =+compressContent ((csb@(CString b1 s1 i1)) : cs) = case compressContent cs of (CString b2 s2 _) : cs2 | b1 == b2
src/Text/XML/HaXml/Html/Parse.hs view
@@ -26,7 +26,7 @@ import Text.ParserCombinators.Poly.Plain -- #define DEBUG- + #if defined(DEBUG) # if ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 502 ) || \ ( defined(__NHC__) && __NHC__ > 114 ) || defined(__HUGS__)@@ -141,8 +141,8 @@ name :: HParser Name --name = do {(p,TokName s) <- next; return s} name = do (p,tok) <- next- case tok of - TokName s -> return s + case tok of+ TokName s -> return s TokError _ -> report failBad "a name" p tok _ -> report fail "a name" p tok @@ -255,7 +255,7 @@ bracket (tok TokQuote) (commit $ tok TokQuote) freetext misc :: HParser Misc-misc = +misc = oneOf' [ ("<!--comment-->", comment >>= return . Comment) , ("<?PI?>", processinginstruction >>= return . PI) ]@@ -329,17 +329,17 @@ return ([], Elem (N "null") [] [])) else if e `elem` selfclosingtags then -- complete the parse straightaway.- ( do tok TokEndClose -- self-closing <tag /> + ( do tok TokEndClose -- self-closing <tag /> debug (e++"[+]") return ([], Elem (N e) avs [])) `onFail`- -- ( do tok TokAnyClose -- sequence <tag></tag> (**not HTML?**)+ -- ( do tok TokAnyClose -- sequence <tag></tag> (**not HTML?**) -- debug (e++"[+") -- n <- bracket (tok TokEndOpen) (commit $ tok TokAnyClose) qname -- debug "]"- -- if e == (map toLower n :: Name) - -- then return ([], Elem e avs []) + -- if e == (map toLower n :: Name)+ -- then return ([], Elem e avs []) -- else return (error "no nesting in empty tag")) `onFail`- ( do tok TokAnyClose -- <tag> with no close (e.g. <IMG>)+ ( do tok TokAnyClose -- <tag> with no close (e.g. <IMG>) debug (e++"[+]") return ([], Elem (N e) avs [])) else@@ -715,13 +715,12 @@ systemliteral :: HParser SystemLiteral systemliteral = do s <- bracket (tok TokQuote) (commit $ tok TokQuote) freetext- return (SystemLiteral s) -- note: need to fold &...; escapes+ return (SystemLiteral s) -- note: need to fold &...; escapes pubidliteral :: HParser PubidLiteral pubidliteral = do s <- bracket (tok TokQuote) (commit $ tok TokQuote) freetext- return (PubidLiteral s) -- note: need to fold &...; escapes+ return (PubidLiteral s) -- note: need to fold &...; escapes chardata :: HParser CharData chardata = freetext -- >>= return . CharData-
src/Text/XML/HaXml/Html/ParseLazy.hs view
@@ -139,8 +139,8 @@ name :: HParser Name --name = do {(p,TokName s) <- next; return s} name = do (p,tok) <- next- case tok of - TokName s -> return s + case tok of+ TokName s -> return s TokError _ -> report failBad "a name" p tok _ -> report fail "a name" p tok @@ -328,17 +328,17 @@ return ([], Elem (N "null") [] [])) else if e `elem` selfclosingtags then -- complete the parse straightaway.- ( do tok TokEndClose -- self-closing <tag />+ ( do tok TokEndClose -- self-closing <tag /> debug (e++"[+]") return ([], Elem (N e) avs [])) `onFail`- -- ( do tok TokAnyClose -- sequence <tag></tag> (**not HTML?**)+ -- ( do tok TokAnyClose -- sequence <tag></tag> (**not HTML?**) -- debug (e++"[+") -- n <- bracket (tok TokEndOpen) (commit $ tok TokAnyClose) qname -- debug "]" -- if e == (map toLower n :: Name) -- then return ([], Elem e avs []) -- else return (error "no nesting in empty tag")) `onFail`- ( do tok TokAnyClose -- <tag> with no close (e.g. <IMG>)+ ( do tok TokAnyClose -- <tag> with no close (e.g. <IMG>) debug (e++"[+]") return ([], Elem (N e) avs [])) else@@ -716,13 +716,12 @@ systemliteral :: HParser SystemLiteral systemliteral = do s <- bracket (tok TokQuote) (commit $ tok TokQuote) freetext- return (SystemLiteral s) -- note: need to fold &...; escapes+ return (SystemLiteral s) -- note: need to fold &...; escapes pubidliteral :: HParser PubidLiteral pubidliteral = do s <- bracket (tok TokQuote) (commit $ tok TokQuote) freetext- return (PubidLiteral s) -- note: need to fold &...; escapes+ return (PubidLiteral s) -- note: need to fold &...; escapes chardata :: HParser CharData chardata = freetext -- >>= return . CharData-
src/Text/XML/HaXml/Html/Pretty.hs view
@@ -64,7 +64,7 @@ misc (PI (n,s)) = text "<?" <> text n <+> text s <+> text "?>" sddecl sd | sd = text "standalone='yes'" | otherwise = text "standalone='no'"-doctypedecl (DTD n eid ds) = if null ds then +doctypedecl (DTD n eid ds) = if null ds then hd <> text ">" else hd <+> text " [" $$ vcat (map markupdecl ds) $$ text "]>"@@ -150,39 +150,39 @@ content (CRef r _) = reference r content (CMisc m _) = misc m -elementdecl :: ElementDecl -> Doc-contentspec :: ContentSpec -> Doc-cp :: CP -> Doc-modifier :: Modifier -> Doc-mixed :: Mixed -> Doc-attlistdecl :: AttListDecl -> Doc-attdef :: AttDef -> Doc-atttype :: AttType -> Doc-tokenizedtype :: TokenizedType -> Doc-enumeratedtype :: EnumeratedType -> Doc-notationtype :: [String] -> Doc-enumeration :: [String] -> Doc-defaultdecl :: DefaultDecl -> Doc-reference :: Reference -> Doc-entityref :: String -> Doc-charref :: (Show a) => a -> Doc-entitydecl :: EntityDecl -> Doc-gedecl :: GEDecl -> Doc-pedecl :: PEDecl -> Doc-entitydef :: EntityDef -> Doc-pedef :: PEDef -> Doc-externalid :: ExternalID -> Doc-ndatadecl :: NDataDecl -> Doc-notationdecl :: NotationDecl -> Doc-publicid :: PublicID -> Doc-encodingdecl :: EncodingDecl -> Doc-nmtoken :: String -> Doc-attvalue :: AttValue -> Doc-entityvalue :: EntityValue -> Doc-ev :: EV -> Doc-pubidliteral :: PubidLiteral -> Doc-systemliteral :: SystemLiteral -> Doc-chardata :: [Char] -> Doc+elementdecl :: ElementDecl -> Doc+contentspec :: ContentSpec -> Doc+cp :: CP -> Doc+modifier :: Modifier -> Doc+mixed :: Mixed -> Doc+attlistdecl :: AttListDecl -> Doc+attdef :: AttDef -> Doc+atttype :: AttType -> Doc+tokenizedtype :: TokenizedType -> Doc+enumeratedtype :: EnumeratedType -> Doc+notationtype :: [String] -> Doc+enumeration :: [String] -> Doc+defaultdecl :: DefaultDecl -> Doc+reference :: Reference -> Doc+entityref :: String -> Doc+charref :: (Show a) => a -> Doc+entitydecl :: EntityDecl -> Doc+gedecl :: GEDecl -> Doc+pedecl :: PEDecl -> Doc+entitydef :: EntityDef -> Doc+pedef :: PEDef -> Doc+externalid :: ExternalID -> Doc+ndatadecl :: NDataDecl -> Doc+notationdecl :: NotationDecl -> Doc+publicid :: PublicID -> Doc+encodingdecl :: EncodingDecl -> Doc+nmtoken :: String -> Doc+attvalue :: AttValue -> Doc+entityvalue :: EntityValue -> Doc+ev :: EV -> Doc+pubidliteral :: PubidLiteral -> Doc+systemliteral :: SystemLiteral -> Doc+chardata :: [Char] -> Doc elementdecl (ElementDecl n cs) = text "<!ELEMENT" <+> qname n <+>
src/Text/XML/HaXml/Lex.hs view
@@ -38,38 +38,38 @@ -- | The basic token type. data TokenT =- TokCommentOpen -- ^ \<!--- | TokCommentClose -- ^ -->- | TokPIOpen -- ^ \<?- | TokPIClose -- ^ ?>- | TokSectionOpen -- ^ \<![- | TokSectionClose -- ^ ]]>- | TokSection Section -- ^ CDATA INCLUDE IGNORE etc- | TokSpecialOpen -- ^ \<!- | TokSpecial Special -- ^ DOCTYPE ELEMENT ATTLIST etc- | TokEndOpen -- ^ \<\/- | TokEndClose -- ^ \/>- | TokAnyOpen -- ^ \<- | TokAnyClose -- ^ >- | TokSqOpen -- ^ \[- | TokSqClose -- ^ \]- | TokEqual -- ^ =- | TokQuery -- ^ ?- | TokStar -- ^ \*- | TokPlus -- ^ +- | TokAmp -- ^ &- | TokSemi -- ^ ;- | TokHash -- ^ #- | TokBraOpen -- ^ (- | TokBraClose -- ^ )- | TokPipe -- ^ |- | TokPercent -- ^ %- | TokComma -- ^ ,- | TokQuote -- ^ \'\' or \"\"- | TokName String -- ^ begins with letter, no spaces- | TokFreeText String -- ^ any character data- | TokNull -- ^ fake token- | TokError String -- ^ lexical error+ TokCommentOpen -- ^ \<!--+ | TokCommentClose -- ^ -->+ | TokPIOpen -- ^ \<?+ | TokPIClose -- ^ ?>+ | TokSectionOpen -- ^ \<![+ | TokSectionClose -- ^ ]]>+ | TokSection Section -- ^ CDATA INCLUDE IGNORE etc+ | TokSpecialOpen -- ^ \<!+ | TokSpecial Special -- ^ DOCTYPE ELEMENT ATTLIST etc+ | TokEndOpen -- ^ \<\/+ | TokEndClose -- ^ \/>+ | TokAnyOpen -- ^ \<+ | TokAnyClose -- ^ >+ | TokSqOpen -- ^ \[+ | TokSqClose -- ^ \]+ | TokEqual -- ^ =+ | TokQuery -- ^ ?+ | TokStar -- ^ \*+ | TokPlus -- ^ ++ | TokAmp -- ^ &+ | TokSemi -- ^ ;+ | TokHash -- ^ #+ | TokBraOpen -- ^ (+ | TokBraClose -- ^ )+ | TokPipe -- ^ |+ | TokPercent -- ^ %+ | TokComma -- ^ ,+ | TokQuote -- ^ \'\' or \"\"+ | TokName String -- ^ begins with letter, no spaces+ | TokFreeText String -- ^ any character data+ | TokNull -- ^ fake token+ | TokError String -- ^ lexical error deriving (Eq) data Special =@@ -86,38 +86,38 @@ deriving (Eq,Show) instance Show TokenT where- showsPrec _p TokCommentOpen = showString "<!--"- showsPrec _p TokCommentClose = showString "-->"- showsPrec _p TokPIOpen = showString "<?"- showsPrec _p TokPIClose = showString "?>"- showsPrec _p TokSectionOpen = showString "<!["- showsPrec _p TokSectionClose = showString "]]>"- showsPrec p (TokSection s) = showsPrec p s- showsPrec _p TokSpecialOpen = showString "<!"- showsPrec p (TokSpecial s) = showsPrec p s- showsPrec _p TokEndOpen = showString "</"- showsPrec _p TokEndClose = showString "/>"- showsPrec _p TokAnyOpen = showString "<"- showsPrec _p TokAnyClose = showString ">"- showsPrec _p TokSqOpen = showString "["- showsPrec _p TokSqClose = showString "]"- showsPrec _p TokEqual = showString "="- showsPrec _p TokQuery = showString "?"- showsPrec _p TokStar = showString "*"- showsPrec _p TokPlus = showString "+"- showsPrec _p TokAmp = showString "&"- showsPrec _p TokSemi = showString ";"- showsPrec _p TokHash = showString "#"- showsPrec _p TokBraOpen = showString "("- showsPrec _p TokBraClose = showString ")"- showsPrec _p TokPipe = showString "|"- showsPrec _p TokPercent = showString "%"- showsPrec _p TokComma = showString ","- showsPrec _p TokQuote = showString "' or \""- showsPrec _p (TokName s) = showString s- showsPrec _p (TokFreeText s) = showString s- showsPrec _p TokNull = showString "(null)"- showsPrec _p (TokError s) = showString s+ showsPrec _p TokCommentOpen = showString "<!--"+ showsPrec _p TokCommentClose = showString "-->"+ showsPrec _p TokPIOpen = showString "<?"+ showsPrec _p TokPIClose = showString "?>"+ showsPrec _p TokSectionOpen = showString "<!["+ showsPrec _p TokSectionClose = showString "]]>"+ showsPrec p (TokSection s) = showsPrec p s+ showsPrec _p TokSpecialOpen = showString "<!"+ showsPrec p (TokSpecial s) = showsPrec p s+ showsPrec _p TokEndOpen = showString "</"+ showsPrec _p TokEndClose = showString "/>"+ showsPrec _p TokAnyOpen = showString "<"+ showsPrec _p TokAnyClose = showString ">"+ showsPrec _p TokSqOpen = showString "["+ showsPrec _p TokSqClose = showString "]"+ showsPrec _p TokEqual = showString "="+ showsPrec _p TokQuery = showString "?"+ showsPrec _p TokStar = showString "*"+ showsPrec _p TokPlus = showString "+"+ showsPrec _p TokAmp = showString "&"+ showsPrec _p TokSemi = showString ";"+ showsPrec _p TokHash = showString "#"+ showsPrec _p TokBraOpen = showString "("+ showsPrec _p TokBraClose = showString ")"+ showsPrec _p TokPipe = showString "|"+ showsPrec _p TokPercent = showString "%"+ showsPrec _p TokComma = showString ","+ showsPrec _p TokQuote = showString "' or \""+ showsPrec _p (TokName s) = showString s+ showsPrec _p (TokFreeText s) = showString s+ showsPrec _p TokNull = showString "(null)"+ showsPrec _p (TokError s) = showString s --trim, revtrim :: String -> String --trim = f . f where f = reverse . dropWhile isSpace@@ -243,7 +243,7 @@ | "![" `prefixes` ss = emit TokSectionOpen p: skip 3 p s (xmlSection w) | "!" `prefixes` ss = emit TokSpecialOpen p: skip 2 p s (xmlSpecial (InTag "<!...>":w))- | "/" `prefixes` ss = emit TokEndOpen p: + | "/" `prefixes` ss = emit TokEndOpen p: skip 2 p s (xmlTag (InTag "</...>":tale w)) | otherwise = emit TokAnyOpen p: skip 1 p s (xmlTag (InTag "<...>":NotInTag:w))
src/Text/XML/HaXml/Parse.hs view
@@ -105,7 +105,7 @@ dtdParse' name = fst3 . runParser justDTD emptySTs . xmlLex name toEOF :: XParser a -> XParser a-toEOF = id -- there are other possible implementations...+toEOF = id -- there are other possible implementations... -- | To parse a partial document, e.g. from an XML-based stream protocol, -- where you may later want to get more document elements from the same@@ -884,4 +884,3 @@ -- | Return parsed freetext (i.e. until the next markup) chardata :: XParser CharData chardata = freetext-
src/Text/XML/HaXml/ParseLazy.hs view
@@ -109,7 +109,7 @@ dtdParse name = fst3 . runParser justDTD emptySTs . xmlLex name toEOF :: XParser a -> XParser a-toEOF = id -- there are other possible implementations...+toEOF = id -- there are other possible implementations... -- | To parse a partial document, e.g. from an XML-based stream protocol, -- where you may later want to get more document elements from the same@@ -894,4 +894,3 @@ -- | Return parsed freetext (i.e. until the next markup) chardata :: XParser CharData chardata = freetext-
src/Text/XML/HaXml/SAX.hs view
@@ -5,9 +5,9 @@ -- streams for communication. module Text.XML.HaXml.SAX- ( SaxElement(..)- , saxParse- ) where+ ( SaxElement(..)+ , saxParse+ ) where import Text.XML.HaXml.Types import Text.XML.HaXml.Parse@@ -15,34 +15,34 @@ import Text.ParserCombinators.Poly.State data SaxElement- = SaxDocTypeDecl DocTypeDecl- -- ^ A doctype declaration occured(\<!DOCTYPE\>)- | SaxProcessingInstruction ProcessingInstruction- -- ^ A processing instruction occured (\<??\>)- | SaxComment String -- ^ A comment occured (\<!-- --\>)- | SaxElementOpen Name [Attribute] -- ^ An element was opened (\<\>)- | SaxElementClose Name -- ^ An element was closed (\<\/\>)- | SaxElementTag Name [Attribute]- -- ^ An element without content occured (\<\/\>)- | SaxCharData CharData -- ^ Some string data occured- | SaxReference Reference -- ^ A reference occured+ = SaxDocTypeDecl DocTypeDecl+ -- ^ A doctype declaration occured(\<!DOCTYPE\>)+ | SaxProcessingInstruction ProcessingInstruction+ -- ^ A processing instruction occured (\<??\>)+ | SaxComment String -- ^ A comment occured (\<!-- --\>)+ | SaxElementOpen Name [Attribute] -- ^ An element was opened (\<\>)+ | SaxElementClose Name -- ^ An element was closed (\<\/\>)+ | SaxElementTag Name [Attribute]+ -- ^ An element without content occured (\<\/\>)+ | SaxCharData CharData -- ^ Some string data occured+ | SaxReference Reference -- ^ A reference occured -- | @saxParse file content@ takes a filename and the string content of that -- file and generates a stream of @SaxElement@s. If an error occurs, the -- parsing stops and a string is returned using the @Maybe@ type. saxParse :: String -- ^ The filename- -> String -- ^ The content of the file- -> ([SaxElement],Maybe String)- -- ^ A tuple of the parsed elements and @Nothing@, if no- -- error occured, or @Just@ @String@ if an error occured.+ -> String -- ^ The content of the file+ -> ([SaxElement],Maybe String)+ -- ^ A tuple of the parsed elements and @Nothing@, if no+ -- error occured, or @Just@ @String@ if an error occured. saxParse file cntnt = parseStream sax emptySTs (xmlLex file cntnt) parseStream :: Parser s t a -> s -> [t] -> ([a], Maybe String) parseStream _ _ [] = ([],Nothing) parseStream p state toks = case runParser p state toks of- (Left err, _, _) -> ([],Just err)- (Right res, nstate, rest) -> (res:moreres, err)+ (Left err, _, _) -> ([],Just err)+ (Right res, nstate, rest) -> (res:moreres, err) where (moreres,err) = parseStream p nstate rest sax :: XParser SaxElement@@ -54,25 +54,25 @@ , saxreference , saxchardata ]- `adjustErr` (++("\nLooking for a SAX event:\n"+ `adjustErr` (++("\nLooking for a SAX event:\n" ++" elem-open, elem-close, PI, comment, DTD, ref, or chardata")) saxelementopen :: XParser SaxElement saxelementopen = do- tok TokAnyOpen- (ElemTag (N n) as) <- elemtag -- no QN ever generated during parsing- (( do tok TokEndClose- return (SaxElementTag n as)) `onFail`- ( do tok TokAnyClose- return (SaxElementOpen n as))- `onFail` fail "missing > or /> in element tag")+ tok TokAnyOpen+ (ElemTag (N n) as) <- elemtag -- no QN ever generated during parsing+ (( do tok TokEndClose+ return (SaxElementTag n as)) `onFail`+ ( do tok TokAnyClose+ return (SaxElementOpen n as))+ `onFail` fail "missing > or /> in element tag") saxelementclose :: XParser SaxElement saxelementclose = do- tok TokEndOpen- n <- name- tok TokAnyClose- return (SaxElementClose n)+ tok TokEndOpen+ n <- name+ tok TokAnyClose+ return (SaxElementClose n) saxcomment :: XParser SaxElement saxcomment = comment >>= return . SaxComment
src/Text/XML/HaXml/Schema/Environment.hs view
@@ -85,7 +85,7 @@ -- think about qualification, w.r.t targetNamespace, elementFormDefault, etc item env (Include _ _) = env item env (Import _ _ _) = env- item env (Redefine _ _) = env -- revisit this+ item env (Redefine _ _) = env -- revisit this item env (Annotation _) = env item env (Simple st) = simple env st item env (Complex ct) = complex env ct@@ -194,4 +194,3 @@ [ (f,Nothing) | (Include f _) <- schema_items s ] ++ [ (f,ns) | (Import uri f _) <- schema_items s , let ns = targetPrefix (Just uri) (schema_namespaces s) ]-
src/Text/XML/HaXml/Schema/PrettyHaskell.hs view
@@ -246,11 +246,11 @@ <+> text "where" $$ nest 4 (text "restricts (" <> ppUnqConId nx t <+> text "x) = x") $$ text "instance SchemaType" <+> ppUnqConId nx t <+> text "where"- $$ nest 4 (text "parseSchemaType s = do" + $$ nest 4 (text "parseSchemaType s = do" $$ nest 4 (text "e <- element [s]" $$ text "commit $ interior e $ parseSimpleType") )- $$ nest 4 (text "schemaTypeToXML s ("<> ppUnqConId nx t <+> text "x) = " + $$ nest 4 (text "schemaTypeToXML s ("<> ppUnqConId nx t <+> text "x) = " $$ nest 4 (text "toXMLElement s [] [toXMLText (simpleTypeText x)]") ) $$ text "instance SimpleType" <+> ppUnqConId nx t <+> text "where"@@ -283,7 +283,7 @@ $$ nest 4 (ppFields nx t_attrs [] as $$ text "deriving (Eq,Show)") $$ text "instance SchemaType" <+> ppUnqConId nx t <+> text "where"- $$ nest 4 (text "parseSchemaType s = do" + $$ nest 4 (text "parseSchemaType s = do" $$ nest 4 (text "(pos,e) <- posnElement [s]" $$ text "commit $ do" $$ nest 2@@ -334,11 +334,11 @@ $$ text "data" <+> ppUnqConId nx t $$ nest 4 ( ppvList "=" "|" "deriving (Eq,Show,Enum)" item is ) $$ text "instance SchemaType" <+> ppUnqConId nx t <+> text "where"- $$ nest 4 (text "parseSchemaType s = do" + $$ nest 4 (text "parseSchemaType s = do" $$ nest 4 (text "e <- element [s]" $$ text "commit $ interior e $ parseSimpleType") )- $$ nest 4 (text "schemaTypeToXML s x = " + $$ nest 4 (text "schemaTypeToXML s x = " $$ nest 4 (text "toXMLElement s [] [toXMLText (simpleTypeText x)]") ) $$ text "instance SimpleType" <+> ppUnqConId nx t <+> text "where"@@ -360,7 +360,7 @@ $$ nest 8 (ppFields nx t (uniqueify es) as $$ text "deriving (Eq,Show)") $$ text "instance SchemaType" <+> ppUnqConId nx t <+> text "where"- $$ nest 4 (text "parseSchemaType s = do" + $$ nest 4 (text "parseSchemaType s = do" $$ nest 4 (text "(pos,e) <- posnElement [s]" -- $$ text "commit $ do" -- $$ nest 2@@ -412,7 +412,7 @@ -- <+> text "(declared in Instance module)" -- *** Declare instance here $$ text "instance SchemaType" <+> ppUnqConId nx t <+> text "where"- $$ nest 4 (text "parseSchemaType s = do" + $$ nest 4 (text "parseSchemaType s = do" $$ nest 4 (vcat (intersperse (text "`onFail`") (map ppParse insts) ++ [text "`onFail` fail" <+> errmsg])))@@ -532,7 +532,7 @@ -- $$ text "data" <+> ppConId nx t <+> text "=" -- <+> ppConId nx t <+> hsep (map (ppConId nx . elem_type) es) --- Possibly we want to declare a really more restrictive type, e.g. +-- Possibly we want to declare a really more restrictive type, e.g. -- to remove optionality, (Maybe Foo) -> (Foo), [Foo] -> Foo -- consequently the "restricts" method should do a proper translation, -- not merely an unwrapping.@@ -549,7 +549,7 @@ $$ text "instance SchemaType" <+> ppUnqConId nx t <+> text "where" $$ nest 4 (text "parseSchemaType = fmap " <+> ppUnqConId nx t <+> text ". parseSchemaType")- -- XXX should enforce the restriction.+ -- XXX should enforce the restriction. $$ nest 4 (text "schemaTypeToXML s (" <> ppUnqConId nx t <+> text "x)") <+> text "= schemaTypeToXML s x" @@ -603,7 +603,7 @@ ppHighLevelInstances :: NameConverter -> Decl -> Doc ppHighLevelInstances nx (ElementsAttrsAbstract t insts comm) = text "instance SchemaType" <+> ppUnqConId nx t <+> text "where"- $$ nest 4 (text "parseSchemaType s = do" + $$ nest 4 (text "parseSchemaType s = do" $$ nest 4 (vcat (intersperse (text "`onFail`") (map ppParse insts) ++ [text "`onFail` fail" <+> errmsg])))@@ -767,7 +767,7 @@ ppElemTypeName :: NameConverter -> (Doc->Doc) -> Element -> Doc ppElemTypeName nx brack e@Element{} = ppTypeModifier (elem_modifier e) brack $ ppConId nx (elem_type e)-ppElemTypeName nx brack e@OneOf{} = +ppElemTypeName nx brack e@OneOf{} = brack $ ppTypeModifier (liftedElemModifier e) parens $ text "OneOf" <> text (show (length (elem_oneOf e))) <+> hsep (map (ppSeq . cleanChoices) (elem_oneOf e))@@ -881,4 +881,3 @@ dropWhile pred [(n++show i) | i <- [2..]] new pred (XName (QN ns n)) = XName $ QN ns $ head $ dropWhile pred [(n++show i) | i <- [2..]]-
src/Text/XML/HaXml/Schema/PrimitiveTypes.hs view
@@ -129,13 +129,13 @@ instance SimpleType Decimal where acceptingParser = fmap Decimal parse- simpleTypeText (Decimal s) = show s -- XXX FIXME: showGFloat?+ simpleTypeText (Decimal s) = show s -- XXX FIXME: showGFloat? instance SimpleType Float where acceptingParser = parse- simpleTypeText x = show x -- XXX FIXME: showGFloat?+ simpleTypeText x = show x -- XXX FIXME: showGFloat? instance SimpleType Double where acceptingParser = parse- simpleTypeText x = show x -- XXX FIXME: showGFloat?+ simpleTypeText x = show x -- XXX FIXME: showGFloat? instance SimpleType Duration where acceptingParser = return Duration `apply` (do isNext '-'; return False@@ -194,7 +194,7 @@ -- * Derived builtin types -newtype NormalizedString = Normalized String deriving (Eq,Show)+newtype NormalizedString = Normalized String deriving (Eq,Show) newtype Token = Token String deriving (Eq,Show) newtype Language = Language String deriving (Eq,Show) newtype Name = Name String deriving (Eq,Show)@@ -297,4 +297,3 @@ instance SimpleType PositiveInteger where acceptingParser = fmap Positive parse simpleTypeText (Positive x) = show x-
src/Text/XML/HaXml/TypeMapping.hs view
@@ -1,13 +1,13 @@ module Text.XML.HaXml.TypeMapping ( -- * A class to get an explicit type representation for any value- HTypeable(..) -- sole method, toHType+ HTypeable(..) -- sole method, toHType -- * Explicit representation of Haskell datatype information- , HType(..) -- instance of Eq, Show- , Constr(..) -- instance of Eq, Show+ , HType(..) -- instance of Eq, Show+ , Constr(..) -- instance of Eq, Show -- * Helper functions to extract type info as strings- , showHType -- :: HType -> ShowS- , showConstr -- :: Int -> HType -> String+ , showHType -- :: HType -> ShowS+ , showConstr -- :: Int -> HType -> String -- * Conversion from Haskell datatype to DTD , toDTD ) where@@ -38,9 +38,9 @@ | Prim String String -- ^ separate Haskell name and XML name | String | Defined String [HType] [Constr]- -- ^ A user-defined type has a name, a sequence of type variables,- -- and a set of constructors. (The variables might already be- -- instantiated to actual types.)+ -- ^ A user-defined type has a name, a sequence of type variables,+ -- and a set of constructors. (The variables might already be+ -- instantiated to actual types.) deriving (Show) instance Eq HType where@@ -49,7 +49,7 @@ (Tuple xs) == (Tuple ys) = xs==ys (Prim x _) == (Prim y _) = x==y String == String = True- (Defined n _xs _) == (Defined m _ys _) = n==m -- && xs==ys+ (Defined n _xs _) == (Defined m _ys _) = n==m -- && xs==ys _ == _ = False -- | A concrete representation of any user-defined Haskell constructor.@@ -238,7 +238,7 @@ declConstr chist c@(Constr s fv hts) | c `notElem` chist = [Element (ElementDecl (N $ flatConstr c "") (ContentSpec (constrHtExpr c)))]- | otherwise = [] + | otherwise = [] declprim (Prim _ t) = [ Element (ElementDecl (N t) EMPTY) , AttList (AttListDecl (N t) [AttDef (N "value") StringType REQUIRED])]
src/Text/XML/HaXml/Validate.hs view
@@ -36,11 +36,11 @@ -- gather appropriate information out of the DTD data SimpleDTD = SimpleDTD- { elements :: FiniteMap QName ContentSpec -- content model of elem+ { elements :: FiniteMap QName ContentSpec -- content model of elem , attributes :: FiniteMap (QName,QName) AttType -- type of (elem,attr)- , required :: FiniteMap QName [QName] -- required attributes of elem- , ids :: [(QName,QName)] -- all (element,attr) with ID type- , idrefs :: [(QName,QName)] -- all (element,attr) with IDREF type+ , required :: FiniteMap QName [QName] -- required attributes of elem+ , ids :: [(QName,QName)] -- all (element,attr) with ID type+ , idrefs :: [(QName,QName)] -- all (element,attr) with IDREF type } simplifyDTD :: DocTypeDecl -> SimpleDTD@@ -67,7 +67,7 @@ , AttList (AttListDecl name attdefs) <- decls , elem == name , AttDef attr (TokenizedType ID) _ <- attdefs ]- , idrefs = [] -- not implemented+ , idrefs = [] -- not implemented } -- simple auxiliary to avoid lots of if-then-else with empty else clauses.@@ -97,7 +97,7 @@ valid (Elem name attrs contents) = -- is the element defined in the DTD?- let spec = lookupFM (elements dtd) name in + let spec = lookupFM (elements dtd) name in (isNothing spec) `gives` ("Element <"++qname name++"> not known.") -- is each attribute mentioned only once? ++ (let dups = duplicates (map (qname . fst) attrs) in@@ -191,7 +191,7 @@ checkCP elm cp@(Choice cps None) ns = let next = choice elm ns cps in if null next then (cpError elm cp, ns)- else ([], head next) -- choose the first alternative with no errors+ else ([], head next) -- choose the first alternative with no errors checkCP _ (Choice _ Query) [] = ([],[]) checkCP elm (Choice cps Query) ns = let next = choice elm ns cps in
src/Text/XML/HaXml/Version.hs view
@@ -3,4 +3,4 @@ ) where version :: String-version = "1.25.4"+version = "1.25.6"
src/Text/XML/HaXml/Xtract/Combinators.hs view
@@ -67,8 +67,8 @@ -- | lifted unit and zero. keep, none :: DFilter i-keep = \_xml sub-> [sub] -- local C.keep-none = \_xml _sub-> [] -- local C.none+keep = \_xml sub-> [sub] -- local C.keep+none = \_xml _sub-> [] -- local C.none children, elm, txt :: DFilter i children = local C.children
src/Text/XML/HaXml/Xtract/Lex.hs view
@@ -18,7 +18,7 @@ type Token = Either String (Posn, TokenT) -data Posn = Pn Int -- char index only+data Posn = Pn Int -- char index only deriving Eq instance Show Posn where@@ -26,8 +26,8 @@ data TokenT = Symbol String- | TokString String -- begins with letter- | TokNum Integer -- begins with digit+ | TokString String -- begins with letter+ | TokNum Integer -- begins with digit deriving Eq instance Show TokenT where
src/Text/XML/HaXml/Xtract/Parse.hs view
@@ -79,76 +79,76 @@ {--- original Xtract grammar ----- query = string tagname- | string * tagname prefix- | * string tagname suffix- | * any element- | - chardata+ query = string tagname+ | string * tagname prefix+ | * string tagname suffix+ | * any element+ | - chardata | ( query )- | query / query parent/child relationship- | query // query deep inside- | query + query union of queries+ | query / query parent/child relationship+ | query // query deep inside+ | query + query union of queries | query [predicate] | query [positions] - predicate = quattr has attribute- | quattr op ' string ' attribute has value- | quattr op " string " attribute has value- | quattr op quattr attribute value comparison (lexical)- | quattr nop integer attribute has value (numerical)- | quattr nop quattr attribute value comparison (numerical)- | ( predicate ) bracketting- | predicate & predicate logical and- | predicate | predicate logical or- | ~ predicate logical not+ predicate = quattr has attribute+ | quattr op ' string ' attribute has value+ | quattr op " string " attribute has value+ | quattr op quattr attribute value comparison (lexical)+ | quattr nop integer attribute has value (numerical)+ | quattr nop quattr attribute value comparison (numerical)+ | ( predicate ) bracketting+ | predicate & predicate logical and+ | predicate | predicate logical or+ | ~ predicate logical not - attribute = @ string has attribute- | query / @ string child has attribute- | - has textual content- | query / - child has textual content+ attribute = @ string has attribute+ | query / @ string child has attribute+ | - has textual content+ | query / - child has textual content quattr = query | attribute - op = = equal to- | != not equal to- | < less than- | <= less than or equal to- | > greater than- | >= greater than or equal to+ op = = equal to+ | != not equal to+ | < less than+ | <= less than or equal to+ | > greater than+ | >= greater than or equal to - nop = .=. equal to- | .!=. not equal to- | .<. less than- | .<=. less than or equal to- | .>. greater than- | .>=. greater than or equal to+ nop = .=. equal to+ | .!=. not equal to+ | .<. less than+ | .<=. less than or equal to+ | .>. greater than+ | .>=. greater than or equal to - positions = position {, positions} multiple positions- | position - position ranges+ positions = position {, positions} multiple positions+ | position - position ranges - position = integer numbering is from 0 upwards- | $ last+ position = integer numbering is from 0 upwards+ | $ last ---- transformed grammar (removing left recursion)- aquery = ./ tquery -- current context- | tquery -- also current context- | / tquery -- root context- | // tquery -- deep context from root+ aquery = ./ tquery -- current context+ | tquery -- also current context+ | / tquery -- root context+ | // tquery -- deep context from root tquery = ( tquery ) xquery | tag xquery- | - -- fixes original grammar ("-/*" is incorrect)- + | - -- fixes original grammar ("-/*" is incorrect)+ tag = string * | string | * string | *- + xquery = / tquery | // tquery- | / @ string -- new: print attribute value+ | / @ string -- new: print attribute value | + tquery | [ tpredicate ] xquery | [ positions ] xquery@@ -228,7 +228,7 @@ [ do q <- bracket (tquery (qf:qf:cxt)) xquery cxt q , do q <- xtag- xquery cxt (qf ((unescape .).q)) -- glue inners texts together+ xquery cxt (qf ((unescape .).q)) -- glue inners texts together , do symbol "-" return (qf (local C.txt)) ]@@ -263,7 +263,7 @@ q2 <- tquery cxt return (D.cat [q1,q2]) , do symbol "["- is <- iindex -- now extended to multiple indexes+ is <- iindex -- now extended to multiple indexes symbol "]" xquery cxt (\xml-> concat . pam is . q1 xml) , do symbol "["@@ -327,7 +327,7 @@ return ((iffn (\s1->if cmp s1 s2 then D.keep else D.none) D.none) `D.o` q) , do cmp <- op- (q2,iffn2) <- wattribute -- q2 unused? is this a mistake?+ (q2,iffn2) <- wattribute -- q2 unused? is this a mistake? return ((iffn (\s1-> iffn2 (\s2-> if cmp s1 s2 then D.keep else D.none) D.none) D.none) `D.o` q)@@ -336,7 +336,7 @@ return ((iffn (\s->if cmp (read s) n then D.keep else D.none) D.none) `D.o` q) , do cmp <- nop- (q2,iffn2) <- wattribute -- q2 unused? is this a mistake?+ (q2,iffn2) <- wattribute -- q2 unused? is this a mistake? return ((iffn (\s1-> iffn2 (\s2-> if cmp (read s1) (read s2) then D.keep else D.none) D.none)@@ -417,4 +417,3 @@ , do symbol ".>."; return (>) , do symbol ".>=."; return (>=) ]-
src/tools/DtdToHaskell.hs view
@@ -9,7 +9,7 @@ import System.Environment import System.Exit import System.IO-import Data.List (nub,takeWhile,dropWhile)+import Data.List (nub) import Control.Monad --import Text.XML.HaXml.Wrappers (fix2Args)@@ -17,7 +17,7 @@ import Text.XML.HaXml.Types (DocTypeDecl(..)) import Text.XML.HaXml.Namespaces (localName) import Text.XML.HaXml.Parse (dtdParse)-import Text.XML.HaXml.DtdToHaskell.TypeDef (TypeDef,ppTypeDef,mangle)+import Text.XML.HaXml.DtdToHaskell.TypeDef (ppTypeDef,mangle) import Text.XML.HaXml.DtdToHaskell.Convert (dtd2TypeDef) import Text.XML.HaXml.DtdToHaskell.Instance (mkInstance) import Text.PrettyPrint.HughesPJ (render,vcat)@@ -75,4 +75,3 @@ trim name | '/' `elem` name = (trim . tail . dropWhile (/='/')) name | '.' `elem` name = takeWhile (/='.') name | otherwise = name-
src/tools/FpMLToHaskell.hs view
@@ -17,8 +17,6 @@ import Data.List import Data.Maybe (fromMaybe,catMaybes) import Data.Function (on)-import Data.Monoid (mconcat)---import Either import Text.XML.HaXml (version) import Text.XML.HaXml.Types@@ -37,7 +35,7 @@ import qualified Text.XML.HaXml.Schema.PrettyHsBoot as HsBoot import qualified Text.XML.HaXml.Schema.HaskellTypeModel as Haskell import Text.ParserCombinators.Poly-import Text.PrettyPrint.HughesPJ (render,vcat)+import Text.PrettyPrint.HughesPJ (render) fst3 :: (a,b,c) -> a fst3 (a,_,_) = a@@ -67,14 +65,14 @@ exitFailure where reslash = map (\c-> case c of '.'->'/'; _->c)- dirOf = concat . intersperse "/" . init . wordsBy '.'- wordsBy c s = let (a,b) = span (/=c) s in- if null b then [a] else a: wordsBy c (tail b)+ dirOf = concat . intersperse "/" . init . wordsBy' '.'+ wordsBy' c s = let (a,b) = span (/=c) s in+ if null b then [a] else a: wordsBy' c (tail b) main ::IO () main = do (dir,files) <- argDirsToFiles- deps <- flip mapM files (\ (inf,outf)-> do+ deps <- flip mapM files (\ (inf,_outf)-> do hPutStrLn stdout $ "Reading "++inf thiscontent <- readFileUTF8 (dir++"/"++inf) let d@Document{} = resolveAllNames qualify@@ -171,36 +169,36 @@ -- | Calculate dependency ordering of modules, least dependent first. -- Cyclic groups may occur, suitably placed in the ordering. ordered :: (Eq a, Eq b) => (b->a) -> (b->[a]) -> (a->Maybe b) -> [b] -> [[b]]-ordered name deps env list =- let cycles = cyclicDeps name deps env list+ordered name' deps env list =+ let cycles = cyclicDeps name' deps env list noncyclic = map (:[]) $ list \\ concat cycles workqueue = noncyclic++cycles- in traverse [] workqueue+ in traverse' [] workqueue where- traverse acc [] = acc- traverse acc (w:wq) = if all (`elem` concatMap (map name) acc)- (concatMap deps w \\ map name w)- then traverse (acc++[w]) wq- else traverse acc (wq++[w])+ traverse' acc [] = acc+ traverse' acc (w:wq) = if all (`elem` concatMap (map name') acc)+ (concatMap deps w \\ map name' w)+ then traverse' (acc++[w]) wq+ else traverse' acc (wq++[w]) -- | Find cyclic dependencies between modules. cyclicDeps :: Eq a => (b->a) -> (b->[a]) -> (a->Maybe b) -> [b] -> [[b]]-cyclicDeps name deps env = nubBy (setEq`on`map name)+cyclicDeps name' deps env = nubBy (setEq`on`map name') . (\cs-> foldl minimal cs cs) . concatMap (walk []) where -- walk :: [b] -> b -> [[b]]- walk acc t = if name t `elem` map name acc then [acc]+ walk acc t = if name' t `elem` map name' acc then [acc] else concatMap (walk (t:acc)) (catMaybes . map env $ deps t) minimal acc c = concatMap (prune c) acc- prune c c' = if map name c `isProperSubsetOf` map name c' then [] else [c']+ prune c c' = if map name' c `isProperSubsetOf` map name' c' then [] else [c'] isSubsetOf a b = all (`elem`b) a setEq a b = a`isSubsetOf`b && b`isSubsetOf`a isProperSubsetOf a b = a`isSubsetOf`b && not (b`isSubsetOf`a) -- | A variation on the standard lookup function. lookupWith :: Eq a => (b->a) -> a -> [b] -> Maybe b-lookupWith proj x [] = Nothing+lookupWith _ _ [] = Nothing lookupWith proj x (y:ys) | proj y == x = Just y | otherwise = lookupWith proj x ys
src/tools/MkOneOf.hs view
@@ -89,12 +89,12 @@ ---- simple pretty-printing ---- -format :: Int -- current position on page- -> Int -- maximum width of page- -> Int -- amount to indent when a newline is emitted- -> String -- text to precede first value- -> String -- text to precede subsequent values- -> [String] -- list of values to format+format :: Int -- current position on page+ -> Int -- maximum width of page+ -> Int -- amount to indent when a newline is emitted+ -> String -- text to precede first value+ -> String -- text to precede subsequent values+ -> [String] -- list of values to format -> String format _cur _max _ind _s0 _s1 [] = "" format cur max ind s0 s1 (x:xs)
src/tools/XsdToHaskell.hs view
@@ -29,7 +29,7 @@ import Text.XML.HaXml.Schema.PrettyHaskell import qualified Text.XML.HaXml.Schema.HaskellTypeModel as Haskell import Text.ParserCombinators.Poly-import Text.PrettyPrint.HughesPJ (render,vcat)+import Text.PrettyPrint.HughesPJ (render) -- sucked in from Text.XML.HaXml.Wrappers to avoid dependency on T.X.H.Html fix2Args :: IO (String,String)@@ -78,7 +78,7 @@ hPutStrLn stdout $ "\n-----------------\n" hFlush o - + --do hPutStrLn o $ "Document contains XSD for target namespace "++ -- targetNamespace e {-
src/tools/Xtract.hs view
@@ -1,6 +1,6 @@ ------------------------------------------------------------ -- The Xtract tool - an XML-grep.------------------------------------------------------------- +------------------------------------------------------------ module Main where import System.Environment (getArgs) import System.Exit (exitWith, ExitCode(..))@@ -29,6 +29,7 @@ data Opts = Opts {doEscaping :: Bool, forceHtml :: Bool, printHelp :: Bool, printVersion :: Bool, beLazy :: Bool} +defaultOptions :: Opts defaultOptions = Opts {doEscaping = True, forceHtml = False, printHelp = False, printVersion = False, beLazy = False} options :: [OptDescr (Opts -> Opts)]@@ -48,7 +49,7 @@ main :: IO () main = do preArgs <- getArgs- let (preOpts, args, errs) = getOpt Permute options preArgs+ let (preOpts, args, _errs) = getOpt Permute options preArgs let opts = foldl (flip ($)) defaultOptions preOpts when (printVersion opts) $ do putStrLn $ "part of HaXml-"++version@@ -59,9 +60,9 @@ when (length args < 1) $ do putStrLn $ usageInfo "Usage: Xtract [options] <pattern> [xmlfile ...]" options exitWith (ExitFailure 1)- let (xmlParse, htmlParse) = if beLazy opts then - (Text.XML.HaXml.ParseLazy.xmlParse, Text.XML.HaXml.Html.ParseLazy.htmlParse) - else + let (xmlParse, htmlParse) = if beLazy opts then+ (Text.XML.HaXml.ParseLazy.xmlParse, Text.XML.HaXml.Html.ParseLazy.htmlParse)+ else (Text.XML.HaXml.Parse.xmlParse, Text.XML.HaXml.Html.Parse.htmlParse) let (pattern,files,esc) = (head args,tail args,if doEscaping opts then escape .(:[]) else (:[]))