{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}

-- | The core module of the XPath-generating DSL. This module should be used as a qualified import.
module HaXPath(
  -- * Basic data types
  IsExpression,
  Showed,
  Bool',
  Bool,
  false,
  true,
  Number',
  Number,
  Text',
  Text,
  text,
  -- * Nodes
  Node',
  Node,
  node,
  namedNode,
  DocumentRoot',
  root',
  DocumentRoot,
  root,
  at,
  -- * Basic combinators
  not,
  (&&.),
  (||.),
  contains,
  doesNotContain,
  Eq,
  (=.),
  (/=.),
  Ord,
  (<.),
  (<=.),
  (>.),
  (>=.),
  position,
  -- * Paths
  CurrentContext,
  RootContext,
  IsContext,
  Context,
  Path',
  Path,
  AbsolutePath',
  AbsolutePath,
  RelativePath',
  RelativePath,
  PathLike,
  show',
  show,
  -- * Axes
  ancestor,
  child,
  descendant,
  descendantOrSelf,
  following,
  followingSibling,
  parent,
  self,
  -- * Path combinators
  SlashOperator(..),
  DoubleSlashOperator(..),
  Filterable(..),
  count,
  (|.)
) where

import           Data.List (intercalate)
import           Data.List.NonEmpty (NonEmpty((:|)))
import           Data.Proxy  (Proxy (Proxy))
import Data.Semigroup (sconcat)
import qualified Data.String as S
import           Prelude     (($), (*), (+), (-), (.), (<$>), (<>), (==))
import qualified Prelude     as P

-- | XPath textual (string) data type, which can be showed as the string type @s@.
newtype Text' s = Text { forall s. Text' s -> Expression s
unText :: Expression s }

-- | 'Text'' specialised so it can be shown as 'P.String'.
type Text = Text' P.String

-- | XPath numeric data type, which can be showed as the string type @s@.
newtype Number' s = Number { forall s. Number' s -> Expression s
unNumber :: Expression s }

-- | 'Number'' specialised so it can be shown as 'P.String'.
type Number = Number' P.String

-- | XPath boolean data type, which can be showed as the string type @s@.
newtype Bool' s = Bool { forall s. Bool' s -> Expression s
unBool :: Expression s }

-- | 'Bool'' specialised so it can be shown as 'P.String'.
type Bool = Bool' P.String

-- | XPath @true()@ value.
true :: S.IsString s => Bool' s
true :: forall s. IsString s => Bool' s
true = forall s. Expression s -> Bool' s
Bool forall a b. (a -> b) -> a -> b
$ forall s. s -> [Expression s] -> Expression s
Function s
"true" []

-- | XPath @false()@ value.
false :: S.IsString s => Bool' s
false :: forall s. IsString s => Bool' s
false = forall s. Expression s -> Bool' s
Bool forall a b. (a -> b) -> a -> b
$ forall s. s -> [Expression s] -> Expression s
Function s
"false" []

data PathBegin = FromRootContext | FromCurrentContext deriving (PathBegin -> PathBegin -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathBegin -> PathBegin -> Bool
$c/= :: PathBegin -> PathBegin -> Bool
== :: PathBegin -> PathBegin -> Bool
$c== :: PathBegin -> PathBegin -> Bool
P.Eq)

-- Internal data type to represent an XPath expression using the string-like type s.
data Expression s = Function s [Expression s] |
                    -- Apply the named function to zero or more arguments.
                    Operator s (Expression s) (Expression s) |
                    -- Apply a binary operator to the two operands.
                    Attribute s |
                    -- Access the given attribute of the node (@).
                    TextLiteral s |
                    -- Text value in quotes.
                    IntegerLiteral P.Integer |
                    -- Literal integer (XPath number).
                    NamedNode s |
                    -- Select node with the provided name.
                    FilteredNode (Expression s) [Expression s] |
                    LocationStep Axis (Expression s) |
                    -- From current context move along the given axis and select nodes matching the expression.
                    PathFrom PathBegin (Expression s) (P.Maybe (Expression s)) [Expression s]
                    -- From the starting point, take the first path (expression), then follow the next path (expression)
                    -- (if present) and finally filter by zero or more boolean (expressions).

-- | Class of types which can be used to form a valid XPath expression. Library users should not create instances of
-- this class.
class IsExpression a where
  toExpression :: a -> Expression (Showed a)

instance IsExpression (Text' s) where
  toExpression :: Text' s -> Expression (Showed (Text' s))
toExpression = forall s. Text' s -> Expression s
unText

instance IsExpression (Number' s) where
  toExpression :: Number' s -> Expression (Showed (Number' s))
toExpression = forall s. Number' s -> Expression s
unNumber

instance IsExpression (Bool' s) where
  toExpression :: Bool' s -> Expression (Showed (Bool' s))
toExpression = forall s. Bool' s -> Expression s
unBool

showExpression :: (S.IsString s, P.Show s) => Expression s -> [s]
showExpression :: forall s. (IsString s, Show s) => Expression s -> [s]
showExpression (Function s
f [Expression s]
es) = [s
f, s
"("] forall a. Semigroup a => a -> a -> a
<> [s]
args forall a. Semigroup a => a -> a -> a
<> [s
")"]
  where
    args :: [s]
args = forall a. [a] -> [[a]] -> [a]
intercalate [s
", "] forall a b. (a -> b) -> a -> b
$ forall s. (IsString s, Show s) => Expression s -> [s]
showExpression forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expression s]
es
showExpression (Operator s
o Expression s
a Expression s
b) =
  forall s. (IsString s, Show s) => Expression s -> [s]
showOperand Expression s
a forall a. Semigroup a => a -> a -> a
<> [s
" ", s
o, s
" "] forall a. Semigroup a => a -> a -> a
<> forall s. (IsString s, Show s) => Expression s -> [s]
showOperand Expression s
b
  where
    showOperand :: Expression s -> [s]
showOperand e :: Expression s
e@(TextLiteral s
_)    = forall s. (IsString s, Show s) => Expression s -> [s]
showExpression Expression s
e
    showOperand e :: Expression s
e@(IntegerLiteral Integer
_) = forall s. (IsString s, Show s) => Expression s -> [s]
showExpression Expression s
e
    showOperand e :: Expression s
e@(Function s
_ [Expression s]
_)     = forall s. (IsString s, Show s) => Expression s -> [s]
showExpression Expression s
e
    showOperand e :: Expression s
e@(Attribute s
_)      = forall s. (IsString s, Show s) => Expression s -> [s]
showExpression Expression s
e
    showOperand Expression s
e                    = s
"(" forall a. a -> [a] -> [a]
: forall s. (IsString s, Show s) => Expression s -> [s]
showExpression Expression s
e forall a. Semigroup a => a -> a -> a
<> [s
")"]

showExpression (Attribute s
a) = [s
"@", s
a]
showExpression (TextLiteral s
t) = [forall a. IsString a => String -> a
S.fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
P.show s
t]
showExpression (IntegerLiteral Integer
i) = [forall a. IsString a => String -> a
S.fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
P.show Integer
i]
showExpression (PathFrom PathBegin
begin Expression s
p Maybe (Expression s)
pNextMay [Expression s]
preds) =
  let prefix :: s
prefix = case PathBegin
begin of
        PathBegin
FromRootContext    -> s
"/"
        PathBegin
FromCurrentContext -> s
""
  in
  let showPath :: Expression s -> [s]
showPath Expression s
x = case Expression s
x of
        LocationStep Axis
_ Expression s
_ -> forall s. (IsString s, Show s) => Expression s -> [s]
showExpression Expression s
x
        Expression s
_                -> s
"(" forall a. a -> [a] -> [a]
: forall s. (IsString s, Show s) => Expression s -> [s]
showExpression Expression s
x forall a. Semigroup a => a -> a -> a
<> [s
")"]
  in
  let fullPShowed :: [s]
fullPShowed = s
prefix forall a. a -> [a] -> [a]
: forall s. (IsString s, Show s) => Expression s -> [s]
showPath Expression s
p forall a. Semigroup a => a -> a -> a
<> case Maybe (Expression s)
pNextMay of
        Maybe (Expression s)
P.Nothing    -> []
        P.Just Expression s
pNext -> s
"/" forall a. a -> [a] -> [a]
: forall s. (IsString s, Show s) => Expression s -> [s]
showPath Expression s
pNext
  in
  forall s. (IsString s, Show s) => [s] -> [Expression s] -> [s]
showWithPredicates [s]
fullPShowed [Expression s]
preds
showExpression (LocationStep Axis
axis Expression s
n) = forall s. IsString s => Axis -> s
showAxis Axis
axis forall a. a -> [a] -> [a]
: [s
"::"] forall a. Semigroup a => a -> a -> a
<> forall s. (IsString s, Show s) => Expression s -> [s]
showExpression Expression s
n
showExpression (NamedNode s
n) = [s
n]
showExpression (FilteredNode Expression s
n [Expression s]
preds) = forall s. (IsString s, Show s) => Expression s -> [s]
showExpression Expression s
n forall a. Semigroup a => a -> a -> a
<> forall s. (IsString s, Show s) => [Expression s] -> [s]
showPredicates [Expression s]
preds

showPredicates :: (S.IsString s, P.Show s) => [Expression s] -> [s]
showPredicates :: forall s. (IsString s, Show s) => [Expression s] -> [s]
showPredicates [Expression s]
preds =  s
"[" forall a. a -> [a] -> [a]
: forall a. [a] -> [[a]] -> [a]
intercalate [s
"]["] (forall s. (IsString s, Show s) => Expression s -> [s]
showExpression forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expression s]
preds) forall a. Semigroup a => a -> a -> a
<> [s
"]"]

showWithPredicates :: (S.IsString s, P.Show s) => [s] -> [Expression s] -> [s]
showWithPredicates :: forall s. (IsString s, Show s) => [s] -> [Expression s] -> [s]
showWithPredicates [s]
s [Expression s]
es
  | Bool -> Bool
P.not (forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [Expression s]
es) = s
"(" forall a. a -> [a] -> [a]
: [s]
s forall a. Semigroup a => a -> a -> a
<> [s
")"] forall a. Semigroup a => a -> a -> a
<> forall s. (IsString s, Show s) => [Expression s] -> [s]
showPredicates [Expression s]
es
  | Bool
P.otherwise = [s]
s

-- | Display an XPath expression. This is useful to sending the XPath expression to a separate XPath evaluator e.g.
-- a web browser.
show' :: (PathLike p,
          IsExpression p,
          P.Monoid (Showed p),
          S.IsString (Showed p),
          P.Show (Showed p)) =>
          p -> Showed p
show' :: forall p.
(PathLike p, IsExpression p, Monoid (Showed p),
 IsString (Showed p), Show (Showed p)) =>
p -> Showed p
show' = forall a. Semigroup a => NonEmpty a -> a
sconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Monoid a => a
P.mempty forall a. a -> [a] -> NonEmpty a
:|) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. (IsString s, Show s) => Expression s -> [s]
showExpression forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsExpression a => a -> Expression (Showed a)
toExpression

-- | Specialisation of 'show'' to only generate 'P.String's.
show :: (PathLike p, IsExpression p, Showed p ~ P.String) => p -> P.String
show :: forall p.
(PathLike p, IsExpression p, Showed p ~ String) =>
p -> String
show = forall p.
(PathLike p, IsExpression p, Monoid (Showed p),
 IsString (Showed p), Show (Showed p)) =>
p -> Showed p
show'

instance S.IsString s => S.IsString (Text' s) where
  fromString :: String -> Text' s
fromString = forall s. Expression s -> Text' s
Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. s -> Expression s
TextLiteral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
S.fromString

boolToInt :: Bool' s -> Number' s
boolToInt :: forall s. Bool' s -> Number' s
boolToInt (Bool Expression s
b) = forall s. Expression s -> Number' s
Number Expression s
b

-- | Access the value of a node's attribute in text form (equivalent to XPath's @\@@).
at :: s -> Text' s
at :: forall s. s -> Text' s
at = forall s. Expression s -> Text' s
Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. s -> Expression s
Attribute

-- | Type class of XPath types that can be compared for equality. Library users should not create instances of this
-- class.
class IsExpression t => Eq t

instance Eq (Text' s)
instance Eq (Number' s)
instance Eq (Bool' s)

-- | The XPath @=@ operator.
(=.) :: (Eq a, S.IsString (Showed a)) => a -> a -> Bool' (Showed a)
a
x =. :: forall a. (Eq a, IsString (Showed a)) => a -> a -> Bool' (Showed a)
=. a
y = forall s. Expression s -> Bool' s
Bool forall a b. (a -> b) -> a -> b
$ forall s. s -> Expression s -> Expression s -> Expression s
Operator Showed a
"=" (forall a. IsExpression a => a -> Expression (Showed a)
toExpression a
x) (forall a. IsExpression a => a -> Expression (Showed a)
toExpression a
y)
infix 4 =.

-- | The XPath @!=@ operator.
(/=.) :: (Eq a, S.IsString (Showed a)) => a -> a -> Bool' (Showed a)
a
x /=. :: forall a. (Eq a, IsString (Showed a)) => a -> a -> Bool' (Showed a)
/=. a
y = forall s. Expression s -> Bool' s
Bool forall a b. (a -> b) -> a -> b
$ forall s. s -> Expression s -> Expression s -> Expression s
Operator Showed a
"!=" (forall a. IsExpression a => a -> Expression (Showed a)
toExpression a
x) (forall a. IsExpression a => a -> Expression (Showed a)
toExpression a
y)
infix 4 /=.

-- | Type class of XPath types that can be ordered. Library users should not create instances of this class.
class Eq t => Ord t

instance Ord (Text' s)
instance Ord (Number' s)
instance Ord (Bool' s)

-- | The XPath @<@ operator.
(<.) :: (Ord a, S.IsString (Showed a)) => a -> a -> Bool' (Showed a)
a
x <. :: forall a.
(Ord a, IsString (Showed a)) =>
a -> a -> Bool' (Showed a)
<. a
y = forall s. Expression s -> Bool' s
Bool forall a b. (a -> b) -> a -> b
$ forall s. s -> Expression s -> Expression s -> Expression s
Operator Showed a
"<" (forall a. IsExpression a => a -> Expression (Showed a)
toExpression a
x) (forall a. IsExpression a => a -> Expression (Showed a)
toExpression a
y)
infix 4 <.

-- | The XPath @<=@ operator.
(<=.) :: (Ord a, S.IsString (Showed a)) => a -> a -> Bool' (Showed a)
a
x <=. :: forall a.
(Ord a, IsString (Showed a)) =>
a -> a -> Bool' (Showed a)
<=. a
y = forall s. Expression s -> Bool' s
Bool forall a b. (a -> b) -> a -> b
$ forall s. s -> Expression s -> Expression s -> Expression s
Operator Showed a
"<=" (forall a. IsExpression a => a -> Expression (Showed a)
toExpression a
x) (forall a. IsExpression a => a -> Expression (Showed a)
toExpression a
y)
infix 4 <=.

-- | The XPath @>@ operator.
(>.) :: (Ord a, S.IsString (Showed a)) => a -> a -> Bool' (Showed a)
a
x >. :: forall a.
(Ord a, IsString (Showed a)) =>
a -> a -> Bool' (Showed a)
>. a
y = forall s. Expression s -> Bool' s
Bool forall a b. (a -> b) -> a -> b
$ forall s. s -> Expression s -> Expression s -> Expression s
Operator Showed a
">" (forall a. IsExpression a => a -> Expression (Showed a)
toExpression a
x) (forall a. IsExpression a => a -> Expression (Showed a)
toExpression a
y)
infix 4 >.

-- | The XPath @>=@ operator.
(>=.) :: (Ord a, S.IsString (Showed a)) => a -> a -> Bool' (Showed a)
a
x >=. :: forall a.
(Ord a, IsString (Showed a)) =>
a -> a -> Bool' (Showed a)
>=. a
y = forall s. Expression s -> Bool' s
Bool forall a b. (a -> b) -> a -> b
$ forall s. s -> Expression s -> Expression s -> Expression s
Operator Showed a
">=" (forall a. IsExpression a => a -> Expression (Showed a)
toExpression a
x) (forall a. IsExpression a => a -> Expression (Showed a)
toExpression a
y)
infix 4 >=.

instance  S.IsString s => P.Num (Number' s) where
  Number Expression s
x + :: Number' s -> Number' s -> Number' s
+ Number Expression s
y = forall s. Expression s -> Number' s
Number forall a b. (a -> b) -> a -> b
$ forall s. s -> Expression s -> Expression s -> Expression s
Operator s
"+" Expression s
x Expression s
y

  Number Expression s
x - :: Number' s -> Number' s -> Number' s
- Number Expression s
y = forall s. Expression s -> Number' s
Number forall a b. (a -> b) -> a -> b
$ forall s. s -> Expression s -> Expression s -> Expression s
Operator s
"-" Expression s
x Expression s
y

  Number Expression s
x * :: Number' s -> Number' s -> Number' s
* Number Expression s
y = forall s. Expression s -> Number' s
Number forall a b. (a -> b) -> a -> b
$ forall s. s -> Expression s -> Expression s -> Expression s
Operator s
"*" Expression s
x Expression s
y

  abs :: Number' s -> Number' s
abs Number' s
x = Number' s
x forall a. Num a => a -> a -> a
* forall a. Num a => a -> a
P.signum Number' s
x

  signum :: Number' s -> Number' s
signum Number' s
x = forall s. Bool' s -> Number' s
boolToInt (Number' s
x forall a.
(Ord a, IsString (Showed a)) =>
a -> a -> Bool' (Showed a)
>. Number' s
0) forall a. Num a => a -> a -> a
- forall s. Bool' s -> Number' s
boolToInt (Number' s
x forall a.
(Ord a, IsString (Showed a)) =>
a -> a -> Bool' (Showed a)
<. Number' s
0)

  fromInteger :: Integer -> Number' s
fromInteger = forall s. Expression s -> Number' s
Number forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Integer -> Expression s
IntegerLiteral

-- | The XPath @position()@ function.
position :: S.IsString s => Number' s
position :: forall s. IsString s => Number' s
position = forall s. Expression s -> Number' s
Number forall a b. (a -> b) -> a -> b
$ forall s. s -> [Expression s] -> Expression s
Function s
"position" []

-- | The XPath @text()@ function.
text :: S.IsString s => Text' s
text :: forall s. IsString s => Text' s
text = forall s. Expression s -> Text' s
Text forall a b. (a -> b) -> a -> b
$ forall s. s -> [Expression s] -> Expression s
Function s
"text" []

-- | The XPath @contains()@ function.
contains :: S.IsString s => Text' s -> Text' s -> Bool' s
contains :: forall s. IsString s => Text' s -> Text' s -> Bool' s
contains Text' s
x Text' s
y = forall s. Expression s -> Bool' s
Bool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. s -> [Expression s] -> Expression s
Function s
"contains" forall a b. (a -> b) -> a -> b
$ [forall a. IsExpression a => a -> Expression (Showed a)
toExpression Text' s
x, forall a. IsExpression a => a -> Expression (Showed a)
toExpression Text' s
y]

-- | The opposite of 'contains'.
doesNotContain :: S.IsString s => Text' s -> Text' s -> Bool' s
doesNotContain :: forall s. IsString s => Text' s -> Text' s -> Bool' s
doesNotContain Text' s
x Text' s
y = forall s. IsString s => Bool' s -> Bool' s
not forall a b. (a -> b) -> a -> b
$ forall s. IsString s => Text' s -> Text' s -> Bool' s
contains Text' s
x Text' s
y

-- | The XPath @count()@ function.
count :: (IsContext c, S.IsString s) => Path' c s -> Number' s
count :: forall c s. (IsContext c, IsString s) => Path' c s -> Number' s
count Path' c s
p = forall s. Expression s -> Number' s
Number forall a b. (a -> b) -> a -> b
$ forall s. s -> [Expression s] -> Expression s
Function s
"count" [forall a. IsExpression a => a -> Expression (Showed a)
toExpression Path' c s
p]

-- | The XPath @and@ operator.
(&&.) :: S.IsString s => Bool' s -> Bool' s -> Bool' s
Bool' s
x &&. :: forall s. IsString s => Bool' s -> Bool' s -> Bool' s
&&. Bool' s
y = forall s. Expression s -> Bool' s
Bool forall a b. (a -> b) -> a -> b
$ forall s. s -> Expression s -> Expression s -> Expression s
Operator s
"and" (forall a. IsExpression a => a -> Expression (Showed a)
toExpression Bool' s
x) (forall a. IsExpression a => a -> Expression (Showed a)
toExpression Bool' s
y)
infixr 3 &&.

-- | The XPath @or@ operator.
(||.) :: S.IsString s => Bool' s -> Bool' s -> Bool' s
Bool' s
x ||. :: forall s. IsString s => Bool' s -> Bool' s -> Bool' s
||. Bool' s
y = forall s. Expression s -> Bool' s
Bool forall a b. (a -> b) -> a -> b
$ forall s. s -> Expression s -> Expression s -> Expression s
Operator s
"or" (forall a. IsExpression a => a -> Expression (Showed a)
toExpression Bool' s
x) (forall a. IsExpression a => a -> Expression (Showed a)
toExpression Bool' s
y)
infixr 2 ||.

-- | The XPath @not(.)@ function.
not :: S.IsString s => Bool' s -> Bool' s
not :: forall s. IsString s => Bool' s -> Bool' s
not Bool' s
x = forall s. Expression s -> Bool' s
Bool forall a b. (a -> b) -> a -> b
$ forall s. s -> [Expression s] -> Expression s
Function s
"not" [forall a. IsExpression a => a -> Expression (Showed a)
toExpression Bool' s
x]

data Axis = Ancestor |
            Child |
            Descendant |
            DescendantOrSelf |
            Following |
            FollowingSibling |
            Parent |
            Self

showAxis :: S.IsString s => Axis -> s
showAxis :: forall s. IsString s => Axis -> s
showAxis Axis
axis = case Axis
axis of
  Axis
Ancestor         -> s
"ancestor"
  Axis
Child            -> s
"child"
  Axis
Descendant       -> s
"descendant"
  Axis
DescendantOrSelf -> s
"descendant-or-self"
  Axis
Following        -> s
"following"
  Axis
FollowingSibling -> s
"following-sibling"
  Axis
Parent           -> s
"parent"
  Axis
Self             -> s
"self"

-- | An XPath node which can be showed as the string type @s@.
newtype Node' s = Node { forall s. Node' s -> Expression s
unNode :: Expression s }

-- | 'Node'' specialised so it can be shown as 'P.String'.
type Node = Node' P.String

instance IsExpression (Node' s) where
  toExpression :: Node' s -> Expression (Showed (Node' s))
toExpression = forall s. Node' s -> Expression s
unNode

-- | An XPath beginning from some context @c@ (either the root context or the current context).
newtype Path' c s = Path { forall c s. Path' c s -> Expression s
unPath :: Expression s }

-- | 'Path'' specialised so it can be shown as 'P.String'.
type Path c = Path' c P.String

-- | An XPath relative to the current context.
type RelativePath' = Path' CurrentContext

-- | 'RelativePath'' specialised so it can be shown as 'P.String'.
type RelativePath = RelativePath' P.String

-- | An XPath beginning from the document root.
type AbsolutePath' = Path' RootContext

-- | 'AbsolutePath'' specialised so it can be shown as 'P.String'.
type AbsolutePath = AbsolutePath' P.String

-- | Type to indicate the XPath begins from the current context.
data CurrentContext

-- | Type to indicate the XPath begins from the document root.
data RootContext

-- | Class of valid types for the type parameter @c@ in 'Path''. Library users should not create instances of this
-- class.
class IsContext c where
  toPathBegin :: proxy c -> PathBegin

instance IsContext RootContext where
  toPathBegin :: forall (proxy :: * -> *). proxy RootContext -> PathBegin
toPathBegin proxy RootContext
_ = PathBegin
FromRootContext

instance IsContext CurrentContext where
  toPathBegin :: forall (proxy :: * -> *). proxy CurrentContext -> PathBegin
toPathBegin proxy CurrentContext
_ = PathBegin
FromCurrentContext

instance IsContext c => IsExpression (Path' c s) where
  toExpression :: Path' c s -> Expression (Showed (Path' c s))
toExpression = forall c s. Path' c s -> Expression s
unPath

-- | The XPath @node()@ function.
node :: S.IsString s => Node' s
node :: forall s. IsString s => Node' s
node = forall s. Expression s -> Node' s
Node forall a b. (a -> b) -> a -> b
$ forall s. s -> [Expression s] -> Expression s
Function s
"node" []

-- | Create a node with the given name.
namedNode :: S.IsString s => s -> Node' s
namedNode :: forall s. IsString s => s -> Node' s
namedNode = forall s. Expression s -> Node' s
Node forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. s -> Expression s
NamedNode

-- | Type to represent the root of the document. Useful in forming an XPaths which must begin from the root.
data DocumentRoot' s = DocumentRoot

-- | 'DocumentRoot'' specialised so it can be used in paths to be shown as 'P.String'.
type DocumentRoot = DocumentRoot' P.String

-- | The root of the document. There is no corresponding XPath expression for 'root' but it can be used to indicate that
-- an XPath must be begin from the root by using this as the first step in the path.
root' :: DocumentRoot' s
root' :: forall s. DocumentRoot' s
root' = forall s. DocumentRoot' s
DocumentRoot

-- | Specialisation of 'root'' so it can be used in paths to be shown as 'P.String'.
root :: DocumentRoot
root :: DocumentRoot
root = forall s. DocumentRoot' s
root'

-- | Type family which allows a context to be inferred. This allows for support of abbreviated syntax.
type family Context p where
  Context (Path' c s) = c
  Context (Node' s) = CurrentContext
  Context (DocumentRoot' s) = RootContext

-- | Type family which associates an expression type with the type that will be returned by 'show'' when it is dislayed
-- in XPath syntax. This allows flexiblity to use different string-like types, such as 'P.String', @Text@, @ByteString@
-- or even builders for these types.
type family (Showed p) where
  Showed (Number' s) = s
  Showed (Text' s) = s
  Showed (Bool' s) = s
  Showed (Path' c s) = s
  Showed (Node' s) = s
  Showed (DocumentRoot' s) = s

-- | Constraint for path-like types - i.e. either a 'Path'' or otherwise a type that can be converted to one using
-- abbreviated syntax rules.
type PathLike p = IsContext (Context p)

-- | Type class for the XPath @/@ operator. It can operate on multiple types as the axes can be inferred based on
-- XPath's abbreviated syntax. Library users should not create instances of this class.
class (PathLike p, PathLike q, Showed p ~ Showed q) => SlashOperator p q where
  -- | The XPath @/@ operator.
  (/.) :: p -> q -> Path' (Context p) (Showed q)
  infixl 8 /.

instance IsContext c => SlashOperator (Path' c s) (Path' CurrentContext s) where
  Path' c s
pa /. :: Path' c s
-> Path' CurrentContext s
-> Path' (Context (Path' c s)) (Showed (Path' CurrentContext s))
/. Path' CurrentContext s
nextPa = forall c s. Expression s -> Path' c s
Path forall a b. (a -> b) -> a -> b
$ case forall a. IsExpression a => a -> Expression (Showed a)
toExpression Path' c s
pa of
    PathFrom PathBegin
begin Expression (Showed (Path' c s))
fstPath Maybe (Expression (Showed (Path' c s)))
P.Nothing [Expression (Showed (Path' c s))]
preds -> forall s.
PathBegin
-> Expression s
-> Maybe (Expression s)
-> [Expression s]
-> Expression s
PathFrom PathBegin
begin Expression (Showed (Path' c s))
fstPath (forall a. a -> Maybe a
P.Just forall a b. (a -> b) -> a -> b
$ forall a. IsExpression a => a -> Expression (Showed a)
toExpression Path' CurrentContext s
nextPa) [Expression (Showed (Path' c s))]
preds
    Expression (Showed (Path' c s))
_ -> forall s.
PathBegin
-> Expression s
-> Maybe (Expression s)
-> [Expression s]
-> Expression s
PathFrom
      (forall c (proxy :: * -> *). IsContext c => proxy c -> PathBegin
toPathBegin (forall {k} (t :: k). Proxy t
Proxy :: Proxy c))
      (forall a. IsExpression a => a -> Expression (Showed a)
toExpression forall a b. (a -> b) -> a -> b
$ forall c s. Path' c s -> Path' CurrentContext s
fromCurrentContext Path' c s
pa)
      (forall a. a -> Maybe a
P.Just forall a b. (a -> b) -> a -> b
$ forall a. IsExpression a => a -> Expression (Showed a)
toExpression Path' CurrentContext s
nextPa)
      []

instance IsContext c => SlashOperator (Path' c s) (Node' s) where
  Path' c s
pa /. :: Path' c s
-> Node' s -> Path' (Context (Path' c s)) (Showed (Node' s))
/. Node' s
n = Path' c s
pa forall p q.
SlashOperator p q =>
p -> q -> Path' (Context p) (Showed q)
/. forall s. Node' s -> Path' CurrentContext s
child Node' s
n

instance SlashOperator (Node' s) (Path' CurrentContext s) where
  Node' s
n /. :: Node' s
-> Path' CurrentContext s
-> Path' (Context (Node' s)) (Showed (Path' CurrentContext s))
/. Path' CurrentContext s
pa = forall s. Node' s -> Path' CurrentContext s
child Node' s
n forall p q.
SlashOperator p q =>
p -> q -> Path' (Context p) (Showed q)
/. Path' CurrentContext s
pa

instance SlashOperator (Node' s) (Node' s) where
  Node' s
n /. :: Node' s -> Node' s -> Path' (Context (Node' s)) (Showed (Node' s))
/. Node' s
nextNode = forall s. Node' s -> Path' CurrentContext s
child Node' s
n forall p q.
SlashOperator p q =>
p -> q -> Path' (Context p) (Showed q)
/. forall s. Node' s -> Path' CurrentContext s
child Node' s
nextNode

instance SlashOperator (DocumentRoot' s) (Path' CurrentContext s) where
  DocumentRoot' s
DocumentRoot /. :: DocumentRoot' s
-> Path' CurrentContext s
-> Path'
     (Context (DocumentRoot' s)) (Showed (Path' CurrentContext s))
/. Path' CurrentContext s
p = forall s. Path' CurrentContext s -> Path' RootContext s
fromRootContext Path' CurrentContext s
p

instance SlashOperator (DocumentRoot' s) (Node' s) where
  DocumentRoot' s
DocumentRoot /. :: DocumentRoot' s
-> Node' s -> Path' (Context (DocumentRoot' s)) (Showed (Node' s))
/. Node' s
n = forall s. Path' CurrentContext s -> Path' RootContext s
fromRootContext (forall s. Node' s -> Path' CurrentContext s
child Node' s
n)

-- | Type class for the XPath @//@ operator. It can operate on multiple types as the axes can be inferred based on
-- XPath's abbreviated syntax. Library users should not create instances of this class.
class (PathLike p, PathLike q, Showed p ~ Showed q) => DoubleSlashOperator p q where
  -- | The XPath @//@ operator.
  (//.) :: p -> q -> Path' (Context p) (Showed q)
  infixl 8 //.

instance (IsContext c, S.IsString s) => DoubleSlashOperator (Path' c s) (Path' CurrentContext s) where
  Path' c s
pa //. :: Path' c s
-> Path' CurrentContext s
-> Path' (Context (Path' c s)) (Showed (Path' CurrentContext s))
//. Path' CurrentContext s
nextPa = forall c s. Expression s -> Path' c s
Path forall a b. (a -> b) -> a -> b
$ case forall a. IsExpression a => a -> Expression (Showed a)
toExpression Path' c s
pa of
    PathFrom PathBegin
begin Expression (Showed (Path' c s))
fstPath Maybe (Expression (Showed (Path' c s)))
P.Nothing [Expression (Showed (Path' c s))]
preds -> forall s.
PathBegin
-> Expression s
-> Maybe (Expression s)
-> [Expression s]
-> Expression s
PathFrom PathBegin
begin Expression (Showed (Path' c s))
fstPath Maybe (Expression (Showed (Path' CurrentContext s)))
nextPa' [Expression (Showed (Path' c s))]
preds
    Expression (Showed (Path' c s))
_ -> forall s.
PathBegin
-> Expression s
-> Maybe (Expression s)
-> [Expression s]
-> Expression s
PathFrom (forall c (proxy :: * -> *). IsContext c => proxy c -> PathBegin
toPathBegin (forall {k} (t :: k). Proxy t
Proxy :: Proxy c)) (forall a. IsExpression a => a -> Expression (Showed a)
toExpression forall a b. (a -> b) -> a -> b
$ forall c s. Path' c s -> Path' CurrentContext s
fromCurrentContext Path' c s
pa) Maybe (Expression (Showed (Path' CurrentContext s)))
nextPa' []

    where
      nextPa' :: Maybe (Expression (Showed (Path' CurrentContext s)))
nextPa' = forall a. a -> Maybe a
P.Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsExpression a => a -> Expression (Showed a)
toExpression forall a b. (a -> b) -> a -> b
$ forall s. Node' s -> Path' CurrentContext s
descendantOrSelf forall s. IsString s => Node' s
node forall p q.
SlashOperator p q =>
p -> q -> Path' (Context p) (Showed q)
/. Path' CurrentContext s
nextPa

instance (IsContext c, S.IsString s) => DoubleSlashOperator (Path' c s) (Node' s) where
  Path' c s
pa //. :: Path' c s
-> Node' s -> Path' (Context (Path' c s)) (Showed (Node' s))
//. Node' s
n = Path' c s
pa forall p q.
SlashOperator p q =>
p -> q -> Path' (Context p) (Showed q)
/. forall s. Node' s -> Path' CurrentContext s
descendantOrSelf forall s. IsString s => Node' s
node forall p q.
SlashOperator p q =>
p -> q -> Path' (Context p) (Showed q)
/. Node' s
n

instance S.IsString s => DoubleSlashOperator (Node' s) (Path' CurrentContext s) where
  Node' s
n //. :: Node' s
-> Path' CurrentContext s
-> Path' (Context (Node' s)) (Showed (Path' CurrentContext s))
//. Path' CurrentContext s
pa = forall s. Node' s -> Path' CurrentContext s
child Node' s
n forall p q.
DoubleSlashOperator p q =>
p -> q -> Path' (Context p) (Showed q)
//. Path' CurrentContext s
pa

instance S.IsString s => DoubleSlashOperator (Node' s) (Node' s) where
  Node' s
n //. :: Node' s -> Node' s -> Path' (Context (Node' s)) (Showed (Node' s))
//. Node' s
nextNode = forall s. Node' s -> Path' CurrentContext s
child Node' s
n forall p q.
DoubleSlashOperator p q =>
p -> q -> Path' (Context p) (Showed q)
//. forall s. Node' s -> Path' CurrentContext s
child Node' s
nextNode

instance S.IsString s => DoubleSlashOperator (DocumentRoot' s) (Path' CurrentContext s) where
  DocumentRoot' s
DocumentRoot //. :: DocumentRoot' s
-> Path' CurrentContext s
-> Path'
     (Context (DocumentRoot' s)) (Showed (Path' CurrentContext s))
//. Path' CurrentContext s
p = forall s. Path' CurrentContext s -> Path' RootContext s
fromRootContext (forall s. Node' s -> Path' CurrentContext s
descendantOrSelf forall s. IsString s => Node' s
node) forall p q.
SlashOperator p q =>
p -> q -> Path' (Context p) (Showed q)
/. Path' CurrentContext s
p

instance S.IsString s => DoubleSlashOperator (DocumentRoot' s) (Node' s) where
  DocumentRoot' s
DocumentRoot //. :: DocumentRoot' s
-> Node' s -> Path' (Context (DocumentRoot' s)) (Showed (Node' s))
//. Node' s
n = forall s. Path' CurrentContext s -> Path' RootContext s
fromRootContext (forall s. Node' s -> Path' CurrentContext s
descendantOrSelf forall s. IsString s => Node' s
node forall p q.
SlashOperator p q =>
p -> q -> Path' (Context p) (Showed q)
/. Node' s
n)

locationStep :: Axis -> Node' s -> Path' c s
locationStep :: forall s c. Axis -> Node' s -> Path' c s
locationStep Axis
axis Node' s
n = forall c s. Expression s -> Path' c s
Path forall a b. (a -> b) -> a -> b
$ forall s. Axis -> Expression s -> Expression s
LocationStep Axis
axis (forall a. IsExpression a => a -> Expression (Showed a)
toExpression Node' s
n)

-- | The XPath @ancestor::@ axis.
ancestor :: Node' s -> Path' CurrentContext s
ancestor :: forall s. Node' s -> Path' CurrentContext s
ancestor = forall s c. Axis -> Node' s -> Path' c s
locationStep Axis
Ancestor

-- | The XPath @child::@ axis.
child :: Node' s -> Path' CurrentContext s
child :: forall s. Node' s -> Path' CurrentContext s
child = forall s c. Axis -> Node' s -> Path' c s
locationStep Axis
Child

-- | The XPath @descendant::@ axis.
descendant :: Node' s -> Path' CurrentContext s
descendant :: forall s. Node' s -> Path' CurrentContext s
descendant = forall s c. Axis -> Node' s -> Path' c s
locationStep Axis
Descendant

-- | The XPath @descendant-or-self::@ axis.
descendantOrSelf :: Node' s -> Path' CurrentContext s
descendantOrSelf :: forall s. Node' s -> Path' CurrentContext s
descendantOrSelf = forall s c. Axis -> Node' s -> Path' c s
locationStep Axis
DescendantOrSelf

-- | The XPath @following::@ axis.
following :: Node' s -> Path' CurrentContext s
following :: forall s. Node' s -> Path' CurrentContext s
following = forall s c. Axis -> Node' s -> Path' c s
locationStep Axis
Following

-- | The XPath @following-sibling::@ axis.
followingSibling :: Node' s -> Path' CurrentContext s
followingSibling :: forall s. Node' s -> Path' CurrentContext s
followingSibling = forall s c. Axis -> Node' s -> Path' c s
locationStep Axis
FollowingSibling

-- | The XPath @parent::@ axis.
parent :: Node' s -> Path' CurrentContext s
parent :: forall s. Node' s -> Path' CurrentContext s
parent = forall s c. Axis -> Node' s -> Path' c s
locationStep Axis
Parent

-- | The XPath @self::@ axis.
self :: Node' s -> Path' CurrentContext s
self :: forall s. Node' s -> Path' CurrentContext s
self = forall s c. Axis -> Node' s -> Path' c s
locationStep Axis
Self

changeContext :: PathBegin -> Path' c s -> Path' c' s
changeContext :: forall c s c'. PathBegin -> Path' c s -> Path' c' s
changeContext PathBegin
begin (Path Expression s
p) = forall c s. Expression s -> Path' c s
Path forall a b. (a -> b) -> a -> b
$ case Expression s
p of
  PathFrom PathBegin
_ Expression s
fstPath Maybe (Expression s)
sndPath [Expression s]
preds -> forall s.
PathBegin
-> Expression s
-> Maybe (Expression s)
-> [Expression s]
-> Expression s
PathFrom PathBegin
begin Expression s
fstPath Maybe (Expression s)
sndPath [Expression s]
preds
  LocationStep Axis
_ Expression s
_                 -> if PathBegin
begin forall a. Eq a => a -> a -> Bool
== PathBegin
FromRootContext then forall s.
PathBegin
-> Expression s
-> Maybe (Expression s)
-> [Expression s]
-> Expression s
PathFrom PathBegin
begin Expression s
p forall a. Maybe a
P.Nothing [] else Expression s
p
  Expression s
other                            -> forall s.
PathBegin
-> Expression s
-> Maybe (Expression s)
-> [Expression s]
-> Expression s
PathFrom PathBegin
begin Expression s
other forall a. Maybe a
P.Nothing []

fromCurrentContext :: Path' c s -> Path' CurrentContext s
fromCurrentContext :: forall c s. Path' c s -> Path' CurrentContext s
fromCurrentContext = forall c s c'. PathBegin -> Path' c s -> Path' c' s
changeContext PathBegin
FromCurrentContext

fromRootContext :: Path' CurrentContext s -> Path' RootContext s
fromRootContext :: forall s. Path' CurrentContext s -> Path' RootContext s
fromRootContext = forall c s c'. PathBegin -> Path' c s -> Path' c' s
changeContext PathBegin
FromRootContext

-- | The union of two node-sets.
(|.) :: (PathLike p,
         PathLike q,
         IsExpression p,
         IsExpression q,
         Context p ~ Context q,
         Showed p ~ Showed q,
         S.IsString (Showed q)) =>
         p -> q-> Path' (Context p) (Showed q)
p
x |. :: forall p q.
(PathLike p, PathLike q, IsExpression p, IsExpression q,
 Context p ~ Context q, Showed p ~ Showed q, IsString (Showed q)) =>
p -> q -> Path' (Context p) (Showed q)
|. q
y = forall c s. Expression s -> Path' c s
Path forall a b. (a -> b) -> a -> b
$ forall s. s -> Expression s -> Expression s -> Expression s
Operator Showed q
"|" (forall a. IsExpression a => a -> Expression (Showed a)
toExpression p
x) (forall a. IsExpression a => a -> Expression (Showed a)
toExpression q
y)
infix 7 |.

-- | Type class to allow filtering of node sets. Library users should not create instances of this class.
class (IsExpression p, PathLike p) => Filterable p where
  -- | Filter the nodes returned by @p@ such that they match the list of predicates.
  (#) :: Showed p ~ s => p -> [Bool' s] -> p
  infixl 9 #

instance IsContext c => Filterable (Path' c s) where
  Path' c s
xp # :: forall s.
(Showed (Path' c s) ~ s) =>
Path' c s -> [Bool' s] -> Path' c s
# [Bool' s]
preds =
    let predExps :: [Expression s]
predExps = forall a. IsExpression a => a -> Expression (Showed a)
toExpression forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bool' s]
preds in
    forall c s. Expression s -> Path' c s
Path forall a b. (a -> b) -> a -> b
$ case forall a. IsExpression a => a -> Expression (Showed a)
toExpression Path' c s
xp of
      LocationStep Axis
axis (FilteredNode Expression (Showed (Path' c s))
n [Expression (Showed (Path' c s))]
ps)  -> forall s. Axis -> Expression s -> Expression s
LocationStep Axis
axis (forall s. Expression s -> [Expression s] -> Expression s
FilteredNode Expression (Showed (Path' c s))
n ([Expression (Showed (Path' c s))]
ps forall a. Semigroup a => a -> a -> a
<> [Expression s]
predExps))
      LocationStep Axis
axis Expression (Showed (Path' c s))
e                    -> forall s. Axis -> Expression s -> Expression s
LocationStep Axis
axis (forall s. Expression s -> [Expression s] -> Expression s
FilteredNode Expression (Showed (Path' c s))
e [Expression s]
predExps)
      PathFrom PathBegin
begin Expression (Showed (Path' c s))
firstSteps Maybe (Expression (Showed (Path' c s)))
nextSteps [Expression (Showed (Path' c s))]
ps -> forall s.
PathBegin
-> Expression s
-> Maybe (Expression s)
-> [Expression s]
-> Expression s
PathFrom PathBegin
begin Expression (Showed (Path' c s))
firstSteps Maybe (Expression (Showed (Path' c s)))
nextSteps ([Expression (Showed (Path' c s))]
ps forall a. Semigroup a => a -> a -> a
<> [Expression s]
predExps)
      Expression (Showed (Path' c s))
otherExp                               -> forall s.
PathBegin
-> Expression s
-> Maybe (Expression s)
-> [Expression s]
-> Expression s
PathFrom (forall c (proxy :: * -> *). IsContext c => proxy c -> PathBegin
toPathBegin (forall {k} (t :: k). Proxy t
Proxy :: Proxy c)) Expression (Showed (Path' c s))
otherExp forall a. Maybe a
P.Nothing [Expression s]
predExps

instance Filterable (Node' s) where
  Node' s
n # :: forall s. (Showed (Node' s) ~ s) => Node' s -> [Bool' s] -> Node' s
# [Bool' s]
preds =
    let predExps :: [Expression s]
predExps = forall a. IsExpression a => a -> Expression (Showed a)
toExpression forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bool' s]
preds in
    forall s. Expression s -> Node' s
Node forall a b. (a -> b) -> a -> b
$ case forall a. IsExpression a => a -> Expression (Showed a)
toExpression Node' s
n of
      FilteredNode Expression (Showed (Node' s))
nExp [Expression (Showed (Node' s))]
ps -> forall s. Expression s -> [Expression s] -> Expression s
FilteredNode Expression (Showed (Node' s))
nExp ([Expression (Showed (Node' s))]
ps forall a. Semigroup a => a -> a -> a
<> [Expression s]
predExps)
      Expression (Showed (Node' s))
otherExp             -> forall s. Expression s -> [Expression s] -> Expression s
FilteredNode Expression (Showed (Node' s))
otherExp [Expression s]
predExps