e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaederDescription : XPath utilities
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian MaederCopyright : (c) Christian Maeder, DFKI GmbH 2010
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuLicense : GPLv2 or higher, see LICENSE.txt
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaederMaintainer : Christian.Maeder@dfki.de
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaederStability : provisional
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaederPortability : portable
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian MaederXPath utilities independent of xml package.
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder<http://www.galiel.net/el/study/XPath_Overview.html>
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder<http://www.fh-wedel.de/~si/HXmlToolbox/hxpath/diplomarbeit.pdf>
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder<http://hackage.haskell.org/package/hxt-xpath>
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder(modules XPathParser, XPathDataTypes)
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder<http://hackage.haskell.org/package/hxt-8.5.0>
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder(modules Text.XML.HXT.DOM.Unicode, Text.XML.HXT.Parser.XmlCharParser)
a3631d87c556bfbce810f6207abeee30ca6a6590Christian MaederUnicode is not
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maederfully supported. A qualified name is an ncName or two ncNames
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maederseparated by a colon (different from OWL uris).
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- * data types and pretty printing (via show)
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | axis specifier
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder = Ancestor Bool -- ^ or self?
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder | Descendant Bool -- ^ or self?
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder | Following Bool -- ^ sibling?
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder | Preceding Bool -- ^ sibling?
e418cbe496169f326cdaa6b4ba60f23d74c6b0bdChristian Maeder deriving Show
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | all possible values
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaederallAxis :: [Axis]
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaederallAxis = let bl = [True, False] in
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder ++ [ Ancestor b | b <- bl ]
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder ++ [ Descendant b | b <- bl ]
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder ++ [ Following b | b <- bl ]
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder ++ [ Preceding b | b <- bl ]
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | utility to show (constant) constructors as lower case strings
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian MaederlowerShow :: Show a => a -> String
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian MaederlowerShow = map toLower . show
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | proper string representation (do not use show)
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaedershowAxis :: Axis -> String
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder let s = takeWhile isAlpha $ lowerShow a
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder orSelf b = if b then s ++ "-or-self" else s
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder sibl b = if b then s ++ "-sibling" else s
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder Ancestor c -> orSelf c
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder Descendant c -> orSelf c
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder Following c -> sibl c
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder Preceding c -> sibl c
3ad16624913db70ceae0d45c15de9cb0c0a7d8e1Christian Maeder-- | testing attribute, namespace or element nodes (usually) by name
3ad16624913db70ceae0d45c15de9cb0c0a7d8e1Christian Maeder = NameTest String -- ^ optional prefix and local part (possibly a * wildcard)
3ad16624913db70ceae0d45c15de9cb0c0a7d8e1Christian Maeder | PI String -- ^ processing-instruction node type with optional literal
3ad16624913db70ceae0d45c15de9cb0c0a7d8e1Christian Maeder | Node -- ^ true for any node (therefore rarely used)
3ad16624913db70ceae0d45c15de9cb0c0a7d8e1Christian Maeder | Comment -- ^ true for comment nodes
3ad16624913db70ceae0d45c15de9cb0c0a7d8e1Christian Maeder | Text -- ^ true for text nodes
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder deriving Show
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | all node types without processing-instruction
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian MaedernodeTypes :: [NodeTest]
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian MaedernodeTypes = [Node, Comment, Text]
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | the processing-instruction string
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaederpIS = "processing-instruction"
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | put parens arount a string
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maederparen :: String -> String
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maederparen = ('(' :) . (++ ")")
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | proper string representation (do not use show)
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaedershowNodeTest :: NodeTest -> String
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian MaedershowNodeTest t = case t of
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder NameTest q -> q
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder PI s -> pIS ++ paren s
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder _ -> lowerShow t ++ paren ""
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | the stuff of a path between the slashes
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maederdata Step = Step Axis NodeTest [Expr] -- ^ with predicate list
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | string representation considering abbreviations
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaedershowStep :: Step -> String
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaedershowStep (Step a n ps) =
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder let t = showNodeTest n in
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder case (a, n) of
f52a4838c101d52bbbd689f6b51f2c1c9202f0a8Christian Maeder (Attribute, _) -> '@' : t
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder (Child, _) -> t
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder (Self, Node) -> "."
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder (Parent, Node) -> ".."
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder _ -> showAxis a ++ "::" ++ t
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder ++ concatMap showPred ps
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maederinstance Show Step where
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder show = showStep
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | test for @descendant-or-self::node()@ step
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederisDescOrSelfNode :: Step -> Bool
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederisDescOrSelfNode (Step a n _) = case (a, n) of
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder (Descendant True, Node) -> True
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | only absolute paths may be empty
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maederdata Path = Path Bool [Step] -- ^ absolute?
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | show a path abbreviating @\/descendant-or-self::node()\/@
adda0e6252b14215228e4071b347c49b808894f8Christian MaedershowSteps :: Bool -> [Step] -> String
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian MaedershowSteps abso sts = let h = if abso then "/" else "" in case sts of
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder s : r -> let f = h ++ showStep s in case r of
adda0e6252b14215228e4071b347c49b808894f8Christian Maeder _ -> if abso && isDescOrSelfNode s then "//" ++ showSteps False r
adda0e6252b14215228e4071b347c49b808894f8Christian Maeder else f ++ showSteps True r
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maederinstance Show Path where
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder show (Path abso sts) = showSteps abso sts
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | indicator for primary expressions
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder = Var -- ^ leading dollar
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder | Literal -- ^ single or double quotes
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder | Number -- ^ digits possibly with decimal point
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | expressions where function calls, unary and infix expressions are generic
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder = GenExpr Bool String [Expr] -- ^ infix?, op or fct, and arguments
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder | PathExpr (Maybe Expr) Path -- ^ optional filter and path
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder | FilterExpr Expr [Expr] -- ^ primary expression with predicates
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder | PrimExpr PrimKind String
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maederinstance Show Expr where
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder show = showExpr
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | put square brackets around an expression
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaedershowPred :: Expr -> String
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaedershowPred e = '[' : showExpr e ++ "]"
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | show expression with minimal parens
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaedershowExpr :: Expr -> String
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaedershowExpr e = case e of
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder GenExpr infx op args ->
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder showInfixExpr op args
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder else op ++ paren (intercalate "," $ map showExpr args)
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder PathExpr m p -> case m of
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder Nothing -> ""
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder Just f -> showExpr f
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder FilterExpr pe ps ->
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder (if isPrimExpr pe then id else paren) (showExpr pe)
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder ++ concatMap showPred ps
95894a5e04344f915a76542612de99a058d1abffChristian Maeder PrimExpr k s -> case k of
95894a5e04344f915a76542612de99a058d1abffChristian Maeder Literal -> show $ filter (/= '"') s
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder{- | show arguments with minimal parens interspersed with the infix operator.
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian MaederAlso treat the unary minus where the argument list is a singleton.
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian MaederAlphanumeric operators are shown with spaces, which looks bad for @mod@ and
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder@div@ in conjunction with additive, relational, or equality operators. The
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maederunary minus gets a leading blank if the preceding character is a
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder'ncNameChar'. -}
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaedershowInfixExpr :: String -> [Expr] -> String
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaedershowInfixExpr op args = case args of
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder [] -> op -- cannot happen
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder [arg] -> -- unary minus
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder let s = showExpr arg
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder in op ++ case arg of
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder GenExpr True aOp _ -> case aOp of
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder arg : rargs ->
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder let mi = findIndex (elem op) inOps
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder f = parenExpr False mi arg
3ad16624913db70ceae0d45c15de9cb0c0a7d8e1Christian Maeder | any isAlpha op = ' ' : op ++ " "
3ad16624913db70ceae0d45c15de9cb0c0a7d8e1Christian Maeder | elem op addOps && not (null f) && ncNameChar (last f) = ' ' : op
3ad16624913db70ceae0d45c15de9cb0c0a7d8e1Christian Maeder | otherwise = op
31d3d7a2f915455d04aadfd36560d1032942b771Christian Maeder in f ++ concatMap ((padOp ++) . parenExpr True mi) rargs
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder{- | put parens around arguments that have a lower precedence or
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder equal precendence if they are a right argument. -}
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaederparenExpr :: Bool -> Maybe Int -> Expr -> String
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaederparenExpr rst mi e =
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder let s = showExpr e
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder GenExpr True op (_ : _ : _) ->
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder let mj = findIndex (elem op) inOps
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder putPar = case (mi, mj) of
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder (Just i, Just j) -> i > j || rst && i == j
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder in if putPar then paren s else s
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | test if expression is primary
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian MaederisPrimExpr :: Expr -> Bool
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian MaederisPrimExpr e = case e of
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder PrimExpr _ _ -> True
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder GenExpr False _ _ -> True
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- * infix operators
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | unequal (@!=@) and equal (@=@)
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian MaedereqOps :: [String]
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian MaedereqOps = ["!=", "="]
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | the four other comparisons
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian MaederrelOps :: [String]
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian MaederrelOps = ["<=", ">=", "<", ">"]
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | @+@ and @-@, where @-@ is allowed within names and as unary operator
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian MaederaddOps :: [String]
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian MaederaddOps = ["+", "-"]
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | @*@, div and mod, where @*@ is also used as wildcard for node names
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian MaedermultOps :: [String]
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian MaedermultOps = ["*", "div", "mod"]
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder{- | all infix operators. Lowest precedence for @or@ followed by @and@,
cf39e23ee25b89496d451fcafc70ece1cf760891Christian Maederhighest is union(@|@). Only these three operators may get more than two
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian MaederinOps :: [[String]]
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | skip trailing spaces
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maederskips :: Parser a -> Parser a
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maederskips = (<< spaces)
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | parse keyword and skip spaces
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maedersymbol :: String -> Parser String
10b02b2343246df6773585636fe3ddbefa3b6a1bChristian Maedersymbol = skips . tryString
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | skip left paren
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maederlpar :: Parser ()
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maederlpar = forget (symbol "(")
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | skip right paren
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maederrpar :: Parser ()
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maederrpar = forget (symbol ")")
1fac054baed931dc57f0e41dd0ade39adac28c49Christian Maeder-- | non-abbreviated axis parser
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maederaxis :: Parser Axis
1fac054baed931dc57f0e41dd0ade39adac28c49Christian Maederaxis = choice (map (\ a -> symbol (showAxis a) >> return a) allAxis)
1fac054baed931dc57f0e41dd0ade39adac28c49Christian Maeder-- | the axis specifier parser
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaederabbrAxis :: Parser Axis
1fac054baed931dc57f0e41dd0ade39adac28c49Christian Maeder (symbol "@" >> return Attribute)
1fac054baed931dc57f0e41dd0ade39adac28c49Christian Maeder <|> try (axis << symbol "::")
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maeder <|> return Child
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder <?> "abbrAxis"
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | starting name character (no unicode)
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaederncNameStart :: Char -> Bool
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaederncNameStart c = isAlpha c || c == '_'
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | name character (without @+@) including centered dot (and no other unicode)
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaederncNameChar :: Char -> Bool
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian MaederncNameChar c = isAlphaNum c || elem c ".-_\183"
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | non-colon xml names (non-skipping)
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaederncName :: Parser String
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederncName = satisfy ncNameStart <:> many (satisfy ncNameChar) <?> "ncName"
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | literal string within single or double quotes (skipping)
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian Maederliteral :: Parser String
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maederliteral = skips $
95894a5e04344f915a76542612de99a058d1abffChristian Maeder (char '"' >> many (satisfy (/= '"')) << string "\"")
95894a5e04344f915a76542612de99a058d1abffChristian Maeder <|> (char '\'' >> many (satisfy (/= '\'')) << string "'")
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | ncName or wild-card (@*@) (skipping)
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederlocalName :: Parser String
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederlocalName = symbol "*" <|> skips ncName <?> "localName"
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | the node test parser
e2ca90217abd35b3d5f98bfe73ecffb34badd837Christian MaedernodeTest :: Parser NodeTest
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian MaedernodeTest = fmap PI (symbol pIS >> lpar >> literal << rpar)
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder <|> choice (map (\ t -> symbol (lowerShow t)
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder >> lpar >> rpar >> return t) nodeTypes)
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder p <- try (ncName <++> string ":")
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder l <- localName
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder return $ NameTest $ p ++ l
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder l <- localName
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder return $ NameTest l
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder <?> "nodeTest"
1fac054baed931dc57f0e41dd0ade39adac28c49Christian Maeder-- | parent or self abbreviated steps
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederabbrStep :: Parser Step
1fac054baed931dc57f0e41dd0ade39adac28c49Christian Maeder (symbol ".." >> return (Step Parent Node []))
1fac054baed931dc57f0e41dd0ade39adac28c49Christian Maeder <|> (symbol "." >> return (Step Self Node []))
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder <?> "abbrStep"
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | the predicate (expression in square brackets) parser
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maederpredicate :: Parser Expr
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maederpredicate = symbol "[" >> expr << symbol "]" <?> "predicate"
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | the step (stuff between slashes) parser
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maederstep :: Parser Step
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maederstep = abbrStep <|> do
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder a <- abbrAxis
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder t <- nodeTest
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder ps <- many predicate
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder return (Step a t ps)
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | the implicit @descendant-or-self::node()@ step constant
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederdescOrSelfStep :: Step
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian MaederdescOrSelfStep = Step (Descendant True) Node []
1fac054baed931dc57f0e41dd0ade39adac28c49Christian Maeder-- | a double or single slash
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederdoubleSlash :: Parser Bool
1fac054baed931dc57f0e41dd0ade39adac28c49Christian MaederdoubleSlash = (symbol "//" >> return True) <|> (symbol "/" >> return False)
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder{- | a step starting with a single or double slash,
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder the latter yielding two steps. -}
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederslashStep :: Parser [Step]
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederslashStep = do
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder b <- doubleSlash
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder return (if b then [descOrSelfStep, s] else [s])
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder <?> "slashStep"
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | parse the steps of a relative path
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederrelPath :: Parser [Step]
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder sl <- many slashStep
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder return (s : concat sl)
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder <?> "relPath"
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | a (possibly empty) absolute or (non-empty) relative path
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maederpath :: Parser Path
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder m <- optionMaybe doubleSlash
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder s <- (case m of
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder Just False -> optionL
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder _ -> id) relPath
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder return (case m of
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder Nothing -> Path False s
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder Just b -> Path True $ if b then descOrSelfStep : s else s)
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | at least one digit and at most one decimal point (skipping)
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maedernumber :: Parser String
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maedernumber = skips $ many1 digit <++> optionL (char '.' <:> many digit)
b7413fd7a18b060775364d271c3e706c07227b13Christian Maeder <|> try (char '.' <:> many1 digit)
5c37a9e2ecfe62f615c383db85582a67e3511e10Christian Maeder-- | a qualified name (prefixed or unprefixed)
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian MaederqualName :: Parser String
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian MaederqualName = skips $ ncName <++> optionL (char ':' <:> ncName)
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | parse a primary expression (including 'fct' or 'expr' in parens)
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederprimExpr :: Parser Expr
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian MaederprimExpr = fmap (PrimExpr Var) (char '$' <:> qualName)
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder <|> (lpar >> expr << rpar)
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder <|> fmap (PrimExpr Literal) literal
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder <|> fmap (PrimExpr Number) number
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | parse a function call by checking the qname and the left paren
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maederfct :: Parser Expr
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder q <- try $ do
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder n <- qualName
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder if elem n $ pIS : map lowerShow nodeTypes
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder then fail $ n ++ " not allowed as function name"
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder else lpar >> return n
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder args <- sepBy expr (symbol ",")
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder return $ GenExpr False q args
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | parse a filter expresssion as primary expression followed by predicates
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederfilterExpr :: Parser Expr
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederfilterExpr = do
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder e <- primExpr
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder ps <- many predicate
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder return $ if null ps then e else FilterExpr e ps
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder{- | a path expression is either a filter expression followed by a (non-empty)
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder absoulte path or an ordinary 'path'. -}
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederpathExpr :: Parser Expr
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder f <- filterExpr
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder s <- optionL $ do
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder b <- doubleSlash
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder return $ if b then descOrSelfStep : r else r
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder return $ if null s then f else PathExpr (Just f) $ Path True s
45ad02e03fb913ba373d8fdcfe50244be3df31eaChristian Maeder <|> fmap (PathExpr Nothing) path
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | parse multiple argument expressions separated by an infix symbol
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaedersingleInfixExpr :: Parser Expr -> String -> Parser Expr
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaedersingleInfixExpr p s = do
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder l <- sepBy1 p $ symbol s
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder return $ case l of
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder _ -> GenExpr True s l
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | 'pathExpr' are arguments of union expression
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederunionExpr :: Parser Expr
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederunionExpr = singleInfixExpr pathExpr "|"
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | 'unionExpr' can be prefixed by the unary minus
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederunaryExpr :: Parser Expr
adefa7a7c4ddbd32fd50ea55ffa7d0e7e0df70b2Christian MaederunaryExpr = fmap (GenExpr True "-" . (: [])) (symbol "-" >> unaryExpr)
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder <|> unionExpr
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder{- | parse as many arguments separated by any infix symbol as possible
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder but construct left-associative binary application trees. -}
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederleftAssocExpr :: Parser Expr -> [String] -> Parser Expr
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederleftAssocExpr p ops =
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder chainl1 p $ do
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder op <- choice $ map symbol ops
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maeder return $ \ a b -> GenExpr True op [a, b]
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- * all final infix parsers using 'leftAssocExpr' or 'singleInfixExpr'
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaedermultExpr :: Parser Expr
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaedermultExpr = leftAssocExpr unaryExpr multOps
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederaddExpr :: Parser Expr
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederaddExpr = leftAssocExpr multExpr addOps
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederrelExpr :: Parser Expr
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederrelExpr = leftAssocExpr addExpr relOps
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaedereqExpr :: Parser Expr
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaedereqExpr = leftAssocExpr relExpr eqOps
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederandExpr :: Parser Expr
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian MaederandExpr = singleInfixExpr eqExpr "and"
ee31a8a5f5d786472f2b5dfb271b38e6d401fa35Christian Maeder-- | the top-level expressions interspersed by @or@.
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maederexpr :: Parser Expr
7bffb8b0e6cae4bb7ecb59b99327add6106c06b9Christian Maederexpr = singleInfixExpr andExpr "or"
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder-- * checking sanity of paths
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maederdata PrincipalNodeType
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian MaederprincipalNodeType :: Axis -> PrincipalNodeType
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian MaederprincipalNodeType a = case a of
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder Attribute -> TAttribute
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder Namespace -> TNamespace
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder _ -> TElement
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder-- | may this step have further steps
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian MaederisElementNode :: Step -> Bool
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian MaederisElementNode (Step a t _) =
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder principalNodeType a == TElement && case t of
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder NameTest _ -> True
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian MaederisLegalPath :: [Step] -> Bool
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian MaederisLegalPath l = case l of
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder s : r -> isElementNode s && isLegalPath r
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian MaederfinalStep :: Path -> Maybe Step
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian MaederfinalStep (Path _ l) = case l of
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder [] -> Nothing
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder _ -> Just $ last l
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian MaederfinalPrincipalNodeType :: Path -> PrincipalNodeType
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian MaederfinalPrincipalNodeType p = case finalStep p of
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder Nothing -> TElement
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder Just (Step a _ _) -> principalNodeType a
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maederdata BasicType
6596e6462e9356ac01f15a6dcada971e1f346b63Christian Maedertype FctEnv = [(String, (BasicType, [BasicType]))]
6596e6462e9356ac01f15a6dcada971e1f346b63Christian Maedertype VarEnv = [(String, BasicType)]
6596e6462e9356ac01f15a6dcada971e1f346b63Christian MaedercoreFcts :: FctEnv
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder [ ("last", (Numeral, []))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("position", (Numeral, []))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("count", (Numeral, [NodeSet]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("id", (NodeSet, [Object]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("local-name", (String, [NodeSet]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("namespace-uri", (String, [NodeSet]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("name", (String, [NodeSet]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("string", (String, [Object]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("concat", (String, [String, String]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("substring-before", (String, [String, String]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("substring-after", (String, [String, String]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("substring", (String, [String, Numeral, Numeral]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("starts-with", (Boolean, [String, String]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("contains", (Boolean, [String, String]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("string-length", (Numeral, [String]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("normalize-space", (String, [String]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("translate", (String, [String, String, String]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("boolean", (Boolean, [Object]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("not", (Boolean, [Boolean]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("true", (Boolean, []))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("false", (Boolean, []))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("lang", (Boolean, [String]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("number", (Numeral, [Object]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("sum", (Numeral, [NodeSet]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("floor", (Numeral, [Numeral]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("ceiling", (Numeral, [Numeral]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder , ("round", (Numeral, [Numeral]))
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian MaederbasicType :: Expr -> BasicType
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian MaederbasicType e = case e of
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder GenExpr infx op _ ->
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder if infx then case op of
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder "|" -> NodeSet
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder _ | elem op $ ["or", "and"] ++ eqOps ++ relOps -> Boolean
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder | elem op $ addOps ++ multOps -> Numeral
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder else case lookup op coreFcts of
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder Just (t, _) -> t
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder Nothing -> Object
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder PrimExpr k _ -> case k of
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder Number -> Numeral
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder Literal -> String
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder Var -> Object
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian MaederisPathExpr :: Expr -> Bool
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian MaederisPathExpr e = case e of
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder GenExpr True "|" args -> all isPathExpr args
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder GenExpr False "id" [_] -> True
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder PrimExpr Var _ -> True
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder PathExpr m (Path _ s) -> isLegalPath s && maybe True isPathExpr m
133498fca44f178d10e2eb6d965ce3442d2e2e32Christian Maeder FilterExpr p _ -> isPathExpr p
6596e6462e9356ac01f15a6dcada971e1f346b63Christian Maeder-- | parse string
6596e6462e9356ac01f15a6dcada971e1f346b63Christian MaederparseExpr :: String -> Either String Expr
6596e6462e9356ac01f15a6dcada971e1f346b63Christian MaederparseExpr s = case parse (expr << eof) "" s of
6596e6462e9356ac01f15a6dcada971e1f346b63Christian Maeder Right e | isPathExpr e -> Right e
6596e6462e9356ac01f15a6dcada971e1f346b63Christian Maeder Left e -> Left $ show e
6596e6462e9356ac01f15a6dcada971e1f346b63Christian Maeder _ -> Left "not a legal path expression"
6596e6462e9356ac01f15a6dcada971e1f346b63Christian MaedergetPaths :: Expr -> [Path]
6596e6462e9356ac01f15a6dcada971e1f346b63Christian MaedergetPaths e = case e of
6596e6462e9356ac01f15a6dcada971e1f346b63Christian Maeder GenExpr True "|" args -> concatMap getPaths args
6596e6462e9356ac01f15a6dcada971e1f346b63Christian Maeder PathExpr m p@(Path _ s) -> case m of
6596e6462e9356ac01f15a6dcada971e1f346b63Christian Maeder Nothing -> [p]
6596e6462e9356ac01f15a6dcada971e1f346b63Christian Maeder Just fe -> map (\ (Path r f) -> Path r $ f ++ s) $ getPaths fe
6596e6462e9356ac01f15a6dcada971e1f346b63Christian Maeder FilterExpr p _ -> getPaths p