diff --git a/examples/hxpath/XPathShell.hs b/examples/hxpath/XPathShell.hs --- a/examples/hxpath/XPathShell.hs +++ b/examples/hxpath/XPathShell.hs @@ -23,13 +23,16 @@ import qualified Control.Monad as M +import Data.Maybe + import Text.XML.HXT.Core import Text.XML.HXT.XPath import Text.XML.HXT.Curl import Text.XML.HXT.Parser.XmlCharParser( withNormNewline ) -import System.Console.Editline.Readline +import System.Console.Haskeline +import System.Console.Haskeline.IO import System.Environment import Text.ParserCombinators.Parsec ( runParser ) @@ -43,7 +46,7 @@ (path, env, doc) <- evalArgs args if not (null path) && not (null doc) then evalXPath path env (head doc) - else evalLoop env doc + else startEvalLoop env doc evalArgs :: [String] -> IO (String, NsEnv', XmlTrees) evalArgs [] = evalArgs ("" : "[]" : "" : []) @@ -112,21 +115,38 @@ pathTree = either show formatXPathTree $ pathEx xr = runLA ( xshow $ getXPathTreesWithNsEnv env path) doc -evalLoop :: NsEnv' -> XmlTrees -> IO () -evalLoop env doc +startEvalLoop :: NsEnv' -> XmlTrees -> IO () +startEvalLoop env doc + = do is0 <- initializeInput defaultSettings + evalLoop0 (readCmdLine is0 "xpath> ") env doc + closeInput is0 + return () + +readCmdLine :: InputState -> String -> IO String +readCmdLine is0 prompt + = do + line <- queryInput is0 (getInputLine prompt) + let line' = stringTrim . fromMaybe "" $ line + if null line' + then readCmdLine is0 prompt + else return line' + +evalLoop0 :: IO String -> NsEnv' -> XmlTrees -> IO () +evalLoop0 readCmdLine' env doc = do - maybeLine <- readline "xpath> " - case maybeLine of - Nothing -> return () -- EOF / control-d - Just ":q" -> return () - Just line -> do + line <- readCmdLine' + case line of + "" -> return () -- EOF / control-d + ":q" -> return () + _ -> do let ws = words line if null ws then evalLoop env doc else do - addHistory line evalCmd (words line) where + evalLoop = evalLoop0 readCmdLine' + evalCmd [] = evalLoop env doc evalCmd [":ns",uri] = evalCmd [":ns", "", uri] evalCmd [":ns", ns, uri] diff --git a/hxt-xpath.cabal b/hxt-xpath.cabal --- a/hxt-xpath.cabal +++ b/hxt-xpath.cabal @@ -1,9 +1,10 @@ -- arch-tag: Haskell XML Toolbox XPath Package Name: hxt-xpath -Version: 9.1.2 +Version: 9.1.2.1 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. + . + Changes from 9.1.2: Bug in indexing result sets removed License: OtherLicense License-file: LICENSE Author: Torben Kuseler @@ -60,3 +61,6 @@ parsec >= 2.1 && < 4, hxt >= 9.1 && < 10 +Source-Repository head + Type: git + Location: git://github.com/UweSchmidt/hxt.git 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 @@ -275,7 +275,7 @@ filterEval :: Env -> Context -> [Expr] -> XPathFilter filterEval env cont (prim:predicates) ns = case evalExpr env cont prim ns of - (XPVNode nns) -> evalStep'' env predicates . Right . fromNodeSet $ nns -- old: evalPredL env predicates new_ns + (XPVNode nns) -> nodeListResToXPathValue . evalPredL env predicates . Right . fromNodeSet $ nns _ -> XPVError "Return of a filterexpression is not a nodeset" filterEval _ _ _ _ = XPVError "Call to filterEval without an expression" @@ -446,8 +446,8 @@ -- * 1.parameter as : axis specifier -- -getAxisNodes :: AxisSpec -> NodeSet -> NodeListRes -getAxisNodes as = Right . (concatMap (fromJust $ lookup as axisFctL)) . fromNodeSet +getAxisNodes :: AxisSpec -> NodeSet -> [NodeListRes] +getAxisNodes as = map (Right . (fromJust $ lookup as axisFctL)) . fromNodeSet -- | -- Axis-Function-Table. @@ -492,19 +492,24 @@ evalStep _ (Step Namespace _ _ ) _ = XPVError "namespace-axis not supported" evalStep _ (Step Attribute nt _ ) ns = withXPVNode "Call to getAxis without a nodeset" - ( evalAttr nt . getAxisNodes Attribute ) + evalAttr' ns + where + evalAttr' = nodeListResToXPathValue . sumNL . map (evalAttr nt) . getAxisNodes Attribute + evalStep env (Step axisSpec nt pr) ns = withXPVNode "Call to getAxis without a nodeset" - ( evalStep' env pr nt . getAxisNodes axisSpec ) + evalSingleStep ns + where + evalSingleStep = nodeListResToXPathValue . sumNL . map (evalStep' env pr nt) . getAxisNodes axisSpec -- ----------------------------------------------------------------------------- -- the goal: -- evalAttr :: NodeTest -> NavXmlTrees -> XPathValue -evalAttr :: NodeTest -> NodeListRes -> XPathValue -evalAttr nt = nodeListResToXPathValue . mapNL (Right . evalAttrNodeTest nt) +evalAttr :: NodeTest -> NodeListRes -> NodeListRes +evalAttr nt = mapNL (Right . evalAttrNodeTest nt) evalAttrNodeTest :: NodeTest -> NavXmlTree -> NavXmlTrees evalAttrNodeTest (NameTest qn) @@ -528,11 +533,8 @@ -- ----------------------------------------------------------------------------- -evalStep' :: Env -> [Expr] -> NodeTest -> NodeListRes -> XPathValue -evalStep' env pr nt = evalStep'' env pr . nodeTest nt - -evalStep'' :: Env -> [Expr] -> NodeListRes -> XPathValue -evalStep'' env pr = nodeListResToXPathValue . evalPredL env pr +evalStep' :: Env -> [Expr] -> NodeTest -> NodeListRes -> NodeListRes +evalStep' env pr nt = evalPredL env pr . nodeTest nt evalPredL :: Env -> [Expr] -> NodeListRes -> NodeListRes evalPredL env pr ns = foldl (flip $ evalPred env) ns pr @@ -626,20 +628,6 @@ typeTest XPCommentNode = filterNodes' XN.isCmt typeTest XPPINode = filterNodes' XN.isPi typeTest XPTextNode = filterNodes' XN.isText - --- ----------------------------------------------------------------------------- -{- old stuff - --- | --- the filter selects the NTree part of a navigable tree and --- tests whether the node is of the necessary type --- --- * 1.parameter fct : filter function from the XmlTreeFilter module which tests the type of a node - -filterNodes :: (XNode -> Bool) -> XPathFilter -filterNodes fct = withXPVNode "Call to filterNodes without a nodeset" $ - (XPVNode . withNodeSet (filter (fct . dataNT))) -end old stuff -} -- ----------------------------------------------------------------------------- -- |