xml-query-0.9.0.2: library/XMLQuery.hs

module XMLQuery
where

import XMLQuery.Prelude hiding (Text)
import qualified XMLQuery.Prelude as Prelude
import qualified XMLQuery.AST as AST


-- * Text
-------------------------

-- |
-- Parser in the context of a textual value.
type Text =
  Alt AST.Text

-- |
-- Lifts an arbitrary textual parser function to the text-value parser.
-- 
-- Provides a doorway for composition with such libraries as \"parsec\" or \"attoparsec\".
text :: (Prelude.Text -> Either Prelude.Text a) -> Text a
text =
  liftAlt . AST.Text

-- ** Derivatives
-------------------------

-- |
-- Simply extracts the textual value.
textValue :: Text Prelude.Text
textValue =
  text pure


-- * Element
-------------------------

type Element =
  Alt AST.Element

elementNameText :: Text a -> Element a
elementNameText =
  liftAlt . AST.ElementNameText

-- |
-- Parses one of element's attributes without any regard to order.
elementAttr :: Attr a -> Element a
elementAttr =
  liftAlt . AST.ElementAttr

-- |
-- Parses all of element's nodes.
-- 
-- Can be used multiple times,
-- thus allowing for parallel parsing of element's child-nodes.
-- Naturally this will result in traversing the element's nodes multiple times.
elementNodes :: Nodes a -> Element a
elementNodes =
  liftAlt . AST.ElementNodes

-- ** Derivatives
-------------------------

elementNameIs :: Prelude.Text -> Element ()
elementNameIs expected =
  elementNameText (text textParserFn)
  where
    textParserFn actual =
      if actual == expected
        then Right ()
        else Left ("elementNameIs: The actual name \"" <> actual <> "\" does not equal the expected \"" <> expected <> "\"")


-- * Attr
-------------------------

type Attr =
  Alt AST.Attr

-- |
-- Parses the attribute's name using the provided textual parser.
attrNameText :: Text a -> Attr a
attrNameText =
  liftAlt . AST.AttrNameText

-- |
-- Parses the attribute's value using the provided textual parser.
attrValueText :: Text a -> Attr a
attrValueText =
  liftAlt . AST.AttrValueText

-- ** Derivatives
-------------------------

-- |
-- A parser, which succeeds if the attribute's name matches the provided value.
attrNameIs :: Prelude.Text -> Attr ()
attrNameIs expected =
  attrNameText (text textParserFn)
  where
    textParserFn actual =
      if actual == expected
        then Right ()
        else Left ("attrNameIs: The actual name \"" <> actual <> "\" does not equal the expected \"" <> expected <> "\"")

-- |
-- A parser, which succeeds if the attribute's value matches the provided value.
attrValueIs :: Prelude.Text -> Attr ()
attrValueIs expected =
  attrValueText (text textParserFn)
  where
    textParserFn actual =
      if actual == expected
        then Right ()
        else Left ("attrValueIs: The actual name \"" <> actual <> "\" does not equal the expected \"" <> expected <> "\"")


-- * Nodes
-------------------------

-- |
-- A sequential backtracking parser of nodes.
type Nodes =
  Alt AST.Nodes

-- |
-- Parses the next node.
nodesImmediateNode :: Node a -> Nodes a
nodesImmediateNode =
  liftAlt . AST.NodesNode

-- |
-- Parses one of the following nodes.
nodesEventualNode :: Node a -> Nodes a
nodesEventualNode node =
  fix $ \loop ->
    nodesImmediateNode node <|> (nodesImmediateNode (pure ()) *> loop)


-- * Node
-------------------------

type Node =
  Alt AST.Node

nodeElement :: Element a -> Node a
nodeElement =
  liftAlt . AST.NodeElement

nodeText :: Text a -> Node a
nodeText =
  liftAlt . AST.NodeText