diff --git a/examples/hxpath/HXPath.hs b/examples/hxpath/HXPath.hs --- a/examples/hxpath/HXPath.hs +++ b/examples/hxpath/HXPath.hs @@ -18,16 +18,16 @@ module Main where -import Text.XML.HXT.Arrow +import Text.XML.HXT.Core +import Text.XML.HXT.Curl import Text.XML.HXT.XPath +import Text.XML.HXT.Arrow.XmlState.TypeDefs import System.IO -- import the IO and commandline option stuff import System.Environment import System.Console.GetOpt import System.Exit -import Data.Maybe - -- ------------------------------------------------------------ -- | @@ -55,9 +55,11 @@ -- runs in the trivial XmlState monad (with user state set to ()) -- so IO and access to global options is possible -xpath :: Attributes -> String -> String -> IOSArrow b Int -xpath al expr src - = readDocument al src +xpath :: SysConfigList -> String -> String -> IOSArrow b Int +xpath cf expr src + = configSysVars cf -- set all global config options, the output file and the + >>> -- other user options are stored as key-value pairs in the stystem state + readDocument [withCurl []] src >>> evalXPathExpr >>> @@ -67,9 +69,9 @@ >>> traceTree >>> - formatXPathResult + ( formatXPathResult $< getSysVar theIndent ) >>> - writeDocument al "-" + writeDocument [] "-" >>> getErrStatus where @@ -82,16 +84,16 @@ filterErrorMsg ) - formatXPathResult :: IOSArrow XmlTree XmlTree - formatXPathResult + formatXPathResult :: Bool -> IOSArrow XmlTree XmlTree + formatXPathResult indent = replaceChildren ( mkelem "xpath-result" [ sattr "expr" expr, sattr "source" src ] [ newline, getChildren >>> (this <+> newline) ] ) where newline - | isJust . lookup a_indent $ al = txt "\n" - | otherwise = none + | indent = txt "\n" + | otherwise = none -- ------------------------------------------------------------ -- @@ -101,7 +103,7 @@ progName :: String progName = "HXPath" -options :: [OptDescr (String, String)] +options :: [OptDescr SysConfig] options = generalOptions ++ @@ -124,14 +126,14 @@ "Usage: " ++ progName ++ " [OPTION...] " use = usageInfo header options -cmdlineOpts :: [String] -> IO (Attributes, String, String) +cmdlineOpts :: [String] -> IO (SysConfigList, String, String) cmdlineOpts argv = case (getOpt Permute options argv) of - (ol,n,[] ) + (scfg,n,[] ) -> do (ex, sa) <- src n - help (lookup a_help ol) - return (ol, ex, sa) + help (getConfigAttr a_help scfg) + return (scfg, ex, sa) (_,_,errs) -> usage errs where @@ -144,7 +146,7 @@ src _ = usage ["too many arguments"] - help Nothing = return () - help (Just _) = usage [] + help "1" = usage [] + help _ = return () -- ------------------------------------------------------------ diff --git a/examples/hxpath/XPathShell.hs b/examples/hxpath/XPathShell.hs --- a/examples/hxpath/XPathShell.hs +++ b/examples/hxpath/XPathShell.hs @@ -23,8 +23,9 @@ import qualified Control.Monad as M -import Text.XML.HXT.Arrow +import Text.XML.HXT.Core import Text.XML.HXT.XPath +import Text.XML.HXT.Curl import System.Console.Editline.Readline import System.Environment @@ -58,12 +59,12 @@ loadDoc :: String -> IO ([XmlTree], NsEnv') loadDoc doc = do - d <- runX ( readDocument [ (a_tagsoup, v_0) - , (a_parse_by_mimetype, v_1) - , (a_check_namespaces, v_1) - , (a_remove_whitespace, v_1) - , (a_validate, v_0) - , (a_canonicalize, v_1) + d <- runX ( readDocument [ withParseByMimeType yes + , withCheckNamespaces yes + , withRemoveWS yes + , withValidate no + , withCanonicalize yes + , withCurl [] ] doc >>> (documentStatusOk `guards` this) @@ -75,8 +76,8 @@ showDoc doc = runX ( constA doc >>> - writeDocument [ (a_indent, v_1) - , (a_no_xml_pi, v_1) + writeDocument [ withIndent yes + , withXmlPi no ] "" ) >> return () @@ -85,8 +86,8 @@ showTree doc = runX ( constA doc >>> - writeDocument [ (a_show_tree, v_1) - , (a_no_xml_pi, v_1) + writeDocument [ withShowTree yes + , withXmlPi no ] "" ) >> return () diff --git a/hxt-xpath.cabal b/hxt-xpath.cabal --- a/hxt-xpath.cabal +++ b/hxt-xpath.cabal @@ -1,6 +1,6 @@ -- arch-tag: Haskell XML Toolbox XPath Package Name: hxt-xpath -Version: 9.0.0 +Version: 9.1.0 Synopsis: The XPath modules for HXT. Description: The Haskell XML Toolbox XPath library. Since version 8.5 this library is packed in a separate package. @@ -51,7 +51,9 @@ Text.XML.HXT.XPath.XPathToString hs-source-dirs: src + ghc-options: -Wall + ghc-prof-options: -auto-all -caf-all build-depends: base >= 4 && < 5, haskell98 >= 1 && < 2, @@ -59,5 +61,5 @@ directory >= 1 && < 2, filepath >= 1 && < 2, parsec >= 2.1 && < 4, - hxt >= 9 && < 10 + hxt >= 9.1 && < 10 diff --git a/src/Text/XML/HXT/XPath/XPathEval.hs b/src/Text/XML/HXT/XPath/XPathEval.hs --- a/src/Text/XML/HXT/XPath/XPathEval.hs +++ b/src/Text/XML/HXT/XPath/XPathEval.hs @@ -55,6 +55,8 @@ , emptyXmlNodeSet ) +import Text.XML.HXT.Parser.XmlCharParser( withNormNewline ) + import Text.ParserCombinators.Parsec ( runParser ) -- ---------------------------------------- @@ -210,7 +212,7 @@ -- and return an expr tree or an error message parseXPathExprWithNsEnv :: Attributes -> String -> Either String Expr -parseXPathExprWithNsEnv nsEnv xpStr = left fmtErr . runParser parseXPath (toNsEnv nsEnv) "" $ xpStr +parseXPathExprWithNsEnv nsEnv xpStr = left fmtErr . runParser parseXPath (withNormNewline (toNsEnv nsEnv)) "" $ xpStr where fmtErr parseError = "Syntax error in XPath expression " ++ show xpStr ++ ": " ++ diff --git a/src/Text/XML/HXT/XPath/XPathFct.hs b/src/Text/XML/HXT/XPath/XPathFct.hs --- a/src/Text/XML/HXT/XPath/XPathFct.hs +++ b/src/Text/XML/HXT/XPath/XPathFct.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} + -- ------------------------------------------------------------ {- | @@ -214,7 +216,7 @@ data IdPathStep = IdRoot String | IdPos Int | IdAttr QName - deriving (Show, Eq, Ord) + deriving (Show, Eq) nodeID :: Maybe NavXmlTree -> [IdPathStep] nodeID = maybe [] nodeID' diff --git a/src/Text/XML/HXT/XPath/XPathParser.hs b/src/Text/XML/HXT/XPath/XPathParser.hs --- a/src/Text/XML/HXT/XPath/XPathParser.hs +++ b/src/Text/XML/HXT/XPath/XPathParser.hs @@ -28,6 +28,10 @@ import Text.XML.HXT.XPath.XPathKeywords import Text.XML.HXT.XPath.XPathDataTypes +import Text.XML.HXT.Parser.XmlCharParser ( XParser + , XPState(..) + , withNormNewline + ) import Text.XML.HXT.Parser.XmlTokenParser ( separator , systemLiteral , skipS0 @@ -58,7 +62,7 @@ enhanceQN Attribute = enhanceAttrQName enhanceQN _ = enhanceQName -type XParser a = GenParser Char NsEnv a +type XPathParser a = XParser NsEnv a -- ------------------------------------------------------------ -- parse functions which are used in the XPathFct module @@ -71,13 +75,13 @@ -- or 'XPVNumber' 'NaN' in case of error parseNumber :: String -> XPathValue parseNumber s - = case (runParser parseNumber' [] {- Map.empty -} "" s) of + = case (runParser parseNumber' (withNormNewline []) {- Map.empty -} "" s) of Left _ -> XPVNumber NaN Right x -> if (read x :: Float) == 0 then (XPVNumber Pos0) else XPVNumber (Float (read x)) -parseNumber' :: XParser String +parseNumber' :: XPathParser String parseNumber' = do skipS0 @@ -94,7 +98,7 @@ -- the main entry point: -- parsing a XPath expression -parseXPath :: XParser Expr +parseXPath :: XPathParser Expr parseXPath = do skipS0 @@ -105,7 +109,7 @@ -- some useful token and symbol parser -lpar, rpar, lbra, rbra, slash, dslash :: XParser () +lpar, rpar, lbra, rbra, slash, dslash :: XPathParser () lpar = tokenParser (symbol "(") rpar = tokenParser (symbol ")") @@ -115,7 +119,7 @@ dslash = tokenParser (symbol "//") -tokenParser :: XParser String -> XParser () +tokenParser :: XPathParser String -> XPathParser () tokenParser p = try ( do skipS0 @@ -124,20 +128,20 @@ ) -symbolParser :: (String, a) -> XParser a +symbolParser :: (String, a) -> XPathParser a symbolParser (s,a) = do tokenParser (symbol s) return a -symbol :: String -> XParser String +symbol :: String -> XPathParser String symbol s = try (string s) -- operation parser -orOp, andOp, eqOp, relOp, addOp, multiOp, unionOp :: XParser Op +orOp, andOp, eqOp, relOp, addOp, multiOp, unionOp :: XPathParser Op orOp = symbolParser ("or", Or) andOp = symbolParser ("and", And) @@ -189,7 +193,7 @@ --GenExpr op (e1:(map snd l)) -exprRest :: XParser Op -> XParser Expr -> XParser (Op, Expr) +exprRest :: XPathParser Op -> XPathParser Expr -> XPathParser (Op, Expr) exprRest parserOp parserExpr = do op <- parserOp @@ -208,7 +212,7 @@ -- [1] LocationPath -locPath :: XParser LocationPath +locPath :: XPathParser LocationPath locPath = absLocPath <|> @@ -216,7 +220,7 @@ -- [2] AbsoluteLocationPath -absLocPath :: XParser LocationPath +absLocPath :: XPathParser LocationPath absLocPath = do -- [10] dslash @@ -231,13 +235,13 @@ -- [3] RelativeLocationPath -relLocPath' :: XParser LocationPath +relLocPath' :: XPathParser LocationPath relLocPath' = do rel <- relLocPath return (LocPath Rel rel) -relLocPath :: XParser [XStep] +relLocPath :: XPathParser [XStep] relLocPath = do s1 <- step @@ -249,7 +253,7 @@ -- Location Steps (2.1) -- -- [4] Step -step' :: XParser [XStep] +step' :: XPathParser [XStep] step' = do -- [11] dslash @@ -262,7 +266,7 @@ return [s] "step'" -step :: XParser XStep +step :: XPathParser XStep step = abbrStep <|> @@ -275,7 +279,7 @@ -- [5] AxisSpecifier -axisSpecifier' :: XParser AxisSpec +axisSpecifier' :: XPathParser AxisSpec axisSpecifier' = do -- [13] tokenParser (symbol "@") @@ -295,7 +299,7 @@ -- Axes (2.2) -- -- [6] AxisName -axisSpecifier :: XParser AxisSpec +axisSpecifier :: XPathParser AxisSpec axisSpecifier = choice [ symbolParser (a_ancestor_or_self, AncestorOrSelf) , symbolParser (a_ancestor, Ancestor) @@ -317,7 +321,7 @@ -- Node Tests (2.3) -- -- [7] NodeTest -nodeTest :: AxisSpec -> XParser NodeTest +nodeTest :: AxisSpec -> XPathParser NodeTest nodeTest as = do nt <- try nodeType' @@ -332,7 +336,7 @@ return (NameTest nt) "nodeTest" -pI :: XParser String +pI :: XPathParser String pI = do tokenParser (symbol n_processing_instruction) @@ -345,7 +349,7 @@ -- -- [8] Predicate -- [9] PredicateExpr -predicate :: XParser Expr +predicate :: XPathParser Expr predicate = do ex <- between lbra rbra expr @@ -358,7 +362,7 @@ -- [11] AbbreviatedRelativeLocationPath: q.v. [4] -- [12] AbbreviatedStep -abbrStep :: XParser XStep +abbrStep :: XPathParser XStep abbrStep = do tokenParser (symbol "..") @@ -379,12 +383,12 @@ -- Basics (3.1) -- -- [14] Expr -expr :: XParser Expr +expr :: XPathParser Expr expr = orExpr -- [15] PrimaryExpr -primaryExpr :: XParser Expr +primaryExpr :: XPathParser Expr primaryExpr = do vr <- variableReference @@ -412,7 +416,7 @@ -- -- [16] FunctionCall -- [17] Argument -functionCall :: XParser Expr +functionCall :: XPathParser Expr functionCall = do fn <- functionName @@ -424,7 +428,7 @@ -- Node-sets (3.3) -- -- [18] UnionExpr -unionExpr :: XParser Expr +unionExpr :: XPathParser Expr unionExpr = do e1 <- pathExpr @@ -433,7 +437,7 @@ -- [19] PathExpr -pathExpr :: XParser Expr +pathExpr :: XPathParser Expr pathExpr = do fe <- try filterExpr @@ -457,7 +461,7 @@ -- [20] FilterExpr -filterExpr :: XParser Expr +filterExpr :: XPathParser Expr filterExpr = do prim <- primaryExpr @@ -471,7 +475,7 @@ -- Booleans (3.4) -- -- [21] OrExpr -orExpr :: XParser Expr +orExpr :: XPathParser Expr orExpr = do e1 <- andExpr @@ -481,7 +485,7 @@ -- [22] AndExpr -andExpr :: XParser Expr +andExpr :: XPathParser Expr andExpr = do e1 <- equalityExpr @@ -491,7 +495,7 @@ -- [23] EqualityExpr -equalityExpr :: XParser Expr +equalityExpr :: XPathParser Expr equalityExpr = do e1 <- relationalExpr @@ -501,7 +505,7 @@ -- [24] RelationalExpr -relationalExpr :: XParser Expr +relationalExpr :: XPathParser Expr relationalExpr = do e1 <- additiveExpr @@ -513,7 +517,7 @@ -- Numbers (3.5) -- -- [25] AdditiveExpr -additiveExpr :: XParser Expr +additiveExpr :: XPathParser Expr additiveExpr = do e1 <- multiplicativeExpr @@ -523,7 +527,7 @@ -- [26] MultiplicativeExpr -multiplicativeExpr :: XParser Expr +multiplicativeExpr :: XPathParser Expr multiplicativeExpr = do e1 <- unaryExpr @@ -533,7 +537,7 @@ -- [27] UnaryExpr -unaryExpr :: XParser Expr +unaryExpr :: XPathParser Expr unaryExpr = do tokenParser (symbol "-") @@ -550,12 +554,12 @@ -- -- [29] Literal -- systemLiteral from XmlParser is used -literal :: XParser String +literal :: XPathParser String literal = systemLiteral -- [30] Number -number :: XParser String +number :: XPathParser String number = do tokenParser (symbol ".") @@ -583,7 +587,7 @@ -- name name -- pref:name {http://uri-for-pref}name -functionName :: XParser String +functionName :: XPathParser String functionName = do (p, n) <- try qName fn <- enhanceName Attribute $ mkPrefixLocalPart p n @@ -596,7 +600,7 @@ -- [36] VariableReference -variableReference :: XParser (String, String) +variableReference :: XPathParser (String, String) variableReference = do tokenParser (symbol "$") (p, n) <- qName @@ -606,7 +610,7 @@ -- [37] NameTest -nameTest :: AxisSpec -> XParser QName +nameTest :: AxisSpec -> XPathParser QName nameTest axs = do tokenParser (symbol "*") enhanceName axs $ mkPrefixLocalPart "" "*" @@ -621,16 +625,16 @@ enhanceName axs $ mkPrefixLocalPart pre local "nameTest" -enhanceName :: AxisSpec -> QName -> XParser QName +enhanceName :: AxisSpec -> QName -> XPathParser QName enhanceName axs qn - = do uris <- getState + = do uris <- getState >>= return . xps_userState case enhanceQN axs uris qn of Nothing -> fail $ "no namespace uri given for prefix " ++ show (namePrefix qn) Just qn' -> return qn' "qualified name with defined namespace uri" -- [38] NodeType -nodeType' :: XParser XPathNode +nodeType' :: XPathParser XPathNode nodeType' = do nt <- nodeType @@ -639,7 +643,7 @@ return nt "nodeType'" -nodeType :: XParser XPathNode +nodeType :: XPathParser XPathNode nodeType = choice [ symbolParser (n_comment, XPCommentNode) , symbolParser (n_text, XPTextNode) diff --git a/src/Text/XML/HXT/XPath/XPathToString.hs b/src/Text/XML/HXT/XPath/XPathToString.hs --- a/src/Text/XML/HXT/XPath/XPathToString.hs +++ b/src/Text/XML/HXT/XPath/XPathToString.hs @@ -36,6 +36,7 @@ import Text.XML.HXT.XPath.XPathDataTypes import Data.Char ( toLower ) +import Data.Tree.Class ( formatTree ) -- ------------------------------------------------------------