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 :: (Text -> Either Text a) -> Text a
text =
  Text a -> Text a
forall (f :: * -> *) a. f a -> Alt f a
liftAlt (Text a -> Text a)
-> ((Text -> Either Text a) -> Text a)
-> (Text -> Either Text a)
-> Text a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text -> Either Text a) -> Text a
forall a. (Text -> Either Text a) -> Text a
AST.Text

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

-- |
-- Simply extracts the textual value.
textValue :: Text Prelude.Text
textValue :: Text Text
textValue =
  (Text -> Either Text Text) -> Text Text
forall a. (Text -> Either Text a) -> Text a
text Text -> Either Text Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure


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

type Element =
  Alt AST.Element

elementNameText :: Text a -> Element a
elementNameText :: Text a -> Element a
elementNameText =
  Element a -> Element a
forall (f :: * -> *) a. f a -> Alt f a
liftAlt (Element a -> Element a)
-> (Text a -> Element a) -> Text a -> Element a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text a -> Element a
forall a. Alt Text a -> Element a
AST.ElementNameText

-- |
-- Parses one of element's attributes without any regard to order.
elementAttr :: Attr a -> Element a
elementAttr :: Attr a -> Element a
elementAttr =
  Element a -> Element a
forall (f :: * -> *) a. f a -> Alt f a
liftAlt (Element a -> Element a)
-> (Attr a -> Element a) -> Attr a -> Element a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Attr a -> Element a
forall a. Alt Attr a -> Element a
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 :: Nodes a -> Element a
elementNodes =
  Element a -> Element a
forall (f :: * -> *) a. f a -> Alt f a
liftAlt (Element a -> Element a)
-> (Nodes a -> Element a) -> Nodes a -> Element a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Nodes a -> Element a
forall a. Alt Nodes a -> Element a
AST.ElementNodes

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

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


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

type Attr =
  Alt AST.Attr

-- |
-- Parses the attribute's name using the provided textual parser.
attrNameText :: Text a -> Attr a
attrNameText :: Text a -> Attr a
attrNameText =
  Attr a -> Attr a
forall (f :: * -> *) a. f a -> Alt f a
liftAlt (Attr a -> Attr a) -> (Text a -> Attr a) -> Text a -> Attr a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text a -> Attr a
forall a. Alt Text a -> Attr a
AST.AttrNameText

-- |
-- Parses the attribute's value using the provided textual parser.
attrValueText :: Text a -> Attr a
attrValueText :: Text a -> Attr a
attrValueText =
  Attr a -> Attr a
forall (f :: * -> *) a. f a -> Alt f a
liftAlt (Attr a -> Attr a) -> (Text a -> Attr a) -> Text a -> Attr a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text a -> Attr a
forall a. Alt Text a -> Attr a
AST.AttrValueText

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

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

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


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

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

-- |
-- Parses the next node.
nodesImmediateNode :: Node a -> Nodes a
nodesImmediateNode :: Node a -> Nodes a
nodesImmediateNode =
  Nodes a -> Nodes a
forall (f :: * -> *) a. f a -> Alt f a
liftAlt (Nodes a -> Nodes a) -> (Node a -> Nodes a) -> Node a -> Nodes a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Node a -> Nodes a
forall a. Alt Node a -> Nodes a
AST.NodesNode

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


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

type Node =
  Alt AST.Node

nodeElement :: Element a -> Node a
nodeElement :: Element a -> Node a
nodeElement =
  Node a -> Node a
forall (f :: * -> *) a. f a -> Alt f a
liftAlt (Node a -> Node a) -> (Element a -> Node a) -> Element a -> Node a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Element a -> Node a
forall a. Alt Element a -> Node a
AST.NodeElement

nodeText :: Text a -> Node a
nodeText :: Text a -> Node a
nodeText =
  Node a -> Node a
forall (f :: * -> *) a. f a -> Alt f a
liftAlt (Node a -> Node a) -> (Text a -> Node a) -> Text a -> Node a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text a -> Node a
forall a. Alt Text a -> Node a
AST.NodeText