-- | Generalized cursors to be applied to different nodes.
module Text.XML.Cursor.Generic
    ( -- * Core
      Cursor
    , Axis
    , toCursor
    , node
      -- * Axes
    , child
    , parent
    , precedingSibling
    , followingSibling
    , ancestor
    , descendant
    , orSelf
    , preceding
    , following
      -- * Operators
    , (&|)
    , (&/)
    , (&//)
    , (&.//)
    , ($|)
    , ($/)
    , ($//)
    , ($.//)
    , (>=>)
    ) where

import Data.Maybe (maybeToList)
import Data.List (foldl')
import Control.Monad ((>=>))

type DiffCursor node = [Cursor node] -> [Cursor node]
type Axis node = Cursor node -> [Cursor node]

-- | A cursor: contains an XML 'Node' and pointers to its children, ancestors and siblings.
data Cursor node = Cursor
    { Cursor node -> Maybe (Cursor node)
parent' :: Maybe (Cursor node)
    , Cursor node -> DiffCursor node
precedingSibling' :: DiffCursor node
    , Cursor node -> DiffCursor node
followingSibling' :: DiffCursor node
    -- | The child axis. XPath:
    -- /the child axis contains the children of the context node/.
    , Cursor node -> [Cursor node]
child :: [Cursor node]
    -- | The current node.
    , Cursor node -> node
node :: node
    }

instance Show node => Show (Cursor node) where
    show :: Cursor node -> String
show Cursor { node :: forall node. Cursor node -> node
node = node
n } = String
"Cursor @ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ node -> String
forall a. Show a => a -> String
show node
n

toCursor :: (node -> [node]) -- ^ get children
         -> node
         -> Cursor node
toCursor :: (node -> [node]) -> node -> Cursor node
toCursor node -> [node]
cs = (node -> [node])
-> Maybe (Cursor node)
-> DiffCursor node
-> DiffCursor node
-> node
-> Cursor node
forall node.
(node -> [node])
-> Maybe (Cursor node)
-> DiffCursor node
-> DiffCursor node
-> node
-> Cursor node
toCursor' node -> [node]
cs Maybe (Cursor node)
forall a. Maybe a
Nothing DiffCursor node
forall a. a -> a
id DiffCursor node
forall a. a -> a
id

toCursor' :: (node -> [node])
          -> Maybe (Cursor node) -> DiffCursor node -> DiffCursor node -> node -> Cursor node
toCursor' :: (node -> [node])
-> Maybe (Cursor node)
-> DiffCursor node
-> DiffCursor node
-> node
-> Cursor node
toCursor' node -> [node]
cs Maybe (Cursor node)
par DiffCursor node
pre DiffCursor node
fol node
n =
    Cursor node
me
  where
    me :: Cursor node
me = Maybe (Cursor node)
-> DiffCursor node
-> DiffCursor node
-> [Cursor node]
-> node
-> Cursor node
forall node.
Maybe (Cursor node)
-> DiffCursor node
-> DiffCursor node
-> [Cursor node]
-> node
-> Cursor node
Cursor Maybe (Cursor node)
par DiffCursor node
pre DiffCursor node
fol [Cursor node]
chi node
n
    chi' :: [node]
chi' = node -> [node]
cs node
n
    chi :: [Cursor node]
chi = DiffCursor node -> [node] -> DiffCursor node
go DiffCursor node
forall a. a -> a
id [node]
chi' []
    go :: DiffCursor node -> [node] -> DiffCursor node
go DiffCursor node
_ [] = DiffCursor node
forall a. a -> a
id
    go DiffCursor node
pre' (node
n':[node]
ns') =
        (:) Cursor node
me' DiffCursor node -> DiffCursor node -> DiffCursor node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffCursor node
fol'
      where
        me' :: Cursor node
me' = (node -> [node])
-> Maybe (Cursor node)
-> DiffCursor node
-> DiffCursor node
-> node
-> Cursor node
forall node.
(node -> [node])
-> Maybe (Cursor node)
-> DiffCursor node
-> DiffCursor node
-> node
-> Cursor node
toCursor' node -> [node]
cs (Cursor node -> Maybe (Cursor node)
forall a. a -> Maybe a
Just Cursor node
me) DiffCursor node
pre' DiffCursor node
fol' node
n'
        fol' :: DiffCursor node
fol' = DiffCursor node -> [node] -> DiffCursor node
go (DiffCursor node
pre' DiffCursor node -> DiffCursor node -> DiffCursor node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Cursor node
me') [node]
ns'

-- | The parent axis. As described in XPath:
-- /the parent axis contains the parent of the context node, if there is one/.
--
-- Every node but the root element of the document has a parent. Parent nodes
-- will always be 'NodeElement's.
parent :: Axis node
parent :: Axis node
parent = Maybe (Cursor node) -> [Cursor node]
forall a. Maybe a -> [a]
maybeToList (Maybe (Cursor node) -> [Cursor node])
-> (Cursor node -> Maybe (Cursor node)) -> Axis node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor node -> Maybe (Cursor node)
forall node. Cursor node -> Maybe (Cursor node)
parent'

-- | The preceding-sibling axis. XPath:
-- /the preceding-sibling axis contains all the preceding siblings of the context node [...]/.
precedingSibling :: Axis node
precedingSibling :: Axis node
precedingSibling = (([Cursor node] -> [Cursor node]) -> [Cursor node] -> [Cursor node]
forall a b. (a -> b) -> a -> b
$ []) (([Cursor node] -> [Cursor node]) -> [Cursor node])
-> (Cursor node -> [Cursor node] -> [Cursor node]) -> Axis node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor node -> [Cursor node] -> [Cursor node]
forall node. Cursor node -> DiffCursor node
precedingSibling'

-- | The following-sibling axis. XPath:
-- /the following-sibling axis contains all the following siblings of the context node [...]/.
followingSibling :: Axis node
followingSibling :: Axis node
followingSibling = (([Cursor node] -> [Cursor node]) -> [Cursor node] -> [Cursor node]
forall a b. (a -> b) -> a -> b
$ []) (([Cursor node] -> [Cursor node]) -> [Cursor node])
-> (Cursor node -> [Cursor node] -> [Cursor node]) -> Axis node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor node -> [Cursor node] -> [Cursor node]
forall node. Cursor node -> DiffCursor node
followingSibling'

-- | The preceding axis. XPath:
-- /the preceding axis contains all nodes in the same document as the context node that are before the context node in document order, excluding any ancestors and excluding attribute nodes and namespace nodes/.
preceding :: Axis node
preceding :: Axis node
preceding Cursor node
c =
    [Cursor node] -> [Cursor node] -> [Cursor node]
forall (t :: * -> *) node.
Foldable t =>
t (Cursor node) -> [Cursor node] -> [Cursor node]
go (Cursor node -> [Cursor node] -> [Cursor node]
forall node. Cursor node -> DiffCursor node
precedingSibling' Cursor node
c []) (Axis node
forall node. Axis node
parent Cursor node
c [Cursor node] -> Axis node -> [Cursor node]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Axis node
forall node. Axis node
preceding)
  where
    go :: t (Cursor node) -> [Cursor node] -> [Cursor node]
go t (Cursor node)
x [Cursor node]
y = ([Cursor node] -> Cursor node -> [Cursor node])
-> [Cursor node] -> t (Cursor node) -> [Cursor node]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Cursor node -> [Cursor node] -> [Cursor node])
-> [Cursor node] -> Cursor node -> [Cursor node]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Cursor node -> [Cursor node] -> [Cursor node]
forall node. Cursor node -> DiffCursor node
go') [Cursor node]
y t (Cursor node)
x
    go' :: Cursor node -> [Cursor node] -> [Cursor node]
go' Cursor node
x [Cursor node]
rest = ([Cursor node] -> Cursor node -> [Cursor node])
-> [Cursor node] -> [Cursor node] -> [Cursor node]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Cursor node -> [Cursor node] -> [Cursor node])
-> [Cursor node] -> Cursor node -> [Cursor node]
forall a b c. (a -> b -> c) -> b -> a -> c
flip  Cursor node -> [Cursor node] -> [Cursor node]
go') (Cursor node
x Cursor node -> [Cursor node] -> [Cursor node]
forall a. a -> [a] -> [a]
: [Cursor node]
rest) (Cursor node -> [Cursor node]
forall node. Axis node
child Cursor node
x)

-- | The following axis. XPath:
-- /the following axis contains all nodes in the same document as the context node that are after the context node in document order, excluding any descendants and excluding attribute nodes and namespace nodes/.
following :: Axis node
following :: Axis node
following Cursor node
c =
    ([Cursor node] -> [Cursor node]) -> [Cursor node] -> [Cursor node]
forall (t :: * -> *) a node.
Foldable t =>
([a] -> t (Cursor node)) -> [Cursor node] -> [Cursor node]
go (Cursor node -> [Cursor node] -> [Cursor node]
forall node. Cursor node -> DiffCursor node
followingSibling' Cursor node
c) (Axis node
forall node. Axis node
parent Cursor node
c [Cursor node] -> Axis node -> [Cursor node]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Axis node
forall node. Axis node
following)
  where
    go :: ([a] -> t (Cursor node)) -> [Cursor node] -> [Cursor node]
go [a] -> t (Cursor node)
x [Cursor node]
z = (Cursor node -> [Cursor node] -> [Cursor node])
-> [Cursor node] -> t (Cursor node) -> [Cursor node]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Cursor node -> [Cursor node] -> [Cursor node]
forall node. Cursor node -> DiffCursor node
go' [Cursor node]
z ([a] -> t (Cursor node)
x [])
    go' :: Cursor node -> [Cursor node] -> [Cursor node]
go' Cursor node
x [Cursor node]
rest = Cursor node
x Cursor node -> [Cursor node] -> [Cursor node]
forall a. a -> [a] -> [a]
: (Cursor node -> [Cursor node] -> [Cursor node])
-> [Cursor node] -> [Cursor node] -> [Cursor node]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Cursor node -> [Cursor node] -> [Cursor node]
go' [Cursor node]
rest (Cursor node -> [Cursor node]
forall node. Axis node
child Cursor node
x)

-- | The ancestor axis. XPath:
-- /the ancestor axis contains the ancestors of the context node; the ancestors of the context node consist of the parent of context node and the parent's parent and so on; thus, the ancestor axis will always include the root node, unless the context node is the root node/.
ancestor :: Axis node
ancestor :: Axis node
ancestor = Axis node
forall node. Axis node
parent Axis node -> Axis node -> Axis node
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (\Cursor node
p -> Cursor node
p Cursor node -> [Cursor node] -> [Cursor node]
forall a. a -> [a] -> [a]
: Axis node
forall node. Axis node
ancestor Cursor node
p)

-- | The descendant axis. XPath:
-- /the descendant axis contains the descendants of the context node; a descendant is a child or a child of a child and so on; thus the descendant axis never contains attribute or namespace nodes/.
descendant :: Axis node
descendant :: Axis node
descendant = Axis node
forall node. Axis node
child Axis node -> Axis node -> Axis node
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (\Cursor node
c -> Cursor node
c Cursor node -> [Cursor node] -> [Cursor node]
forall a. a -> [a] -> [a]
: Axis node
forall node. Axis node
descendant Cursor node
c)

-- | Modify an axis by adding the context node itself as the first element of the result list.
orSelf :: Axis node -> Axis node
orSelf :: Axis node -> Axis node
orSelf Axis node
ax Cursor node
c = Cursor node
c Cursor node -> [Cursor node] -> [Cursor node]
forall a. a -> [a] -> [a]
: Axis node
ax Cursor node
c

infixr 1 &|
infixr 1 &/ 
infixr 1 &// 
infixr 1 &.// 
infixr 1 $|
infixr 1 $/
infixr 1 $//
infixr 1 $.//

-- | Apply a function to the result of an axis.
(&|) :: (Cursor node -> [a]) -> (a -> b) -> (Cursor node -> [b])
Cursor node -> [a]
f &| :: (Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| a -> b
g = (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
g ([a] -> [b]) -> (Cursor node -> [a]) -> Cursor node -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor node -> [a]
f

-- | Combine two axes so that the second works on the children of the results
-- of the first.
(&/) :: Axis node -> (Cursor node -> [a]) -> (Cursor node -> [a])
Axis node
f &/ :: Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor node -> [a]
g = Axis node
f Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Axis node
forall node. Axis node
child Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor node -> [a]
g

-- | Combine two axes so that the second works on the descendants of the results
-- of the first.
(&//) :: Axis node -> (Cursor node -> [a]) -> (Cursor node -> [a])
Axis node
f &// :: Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&// Cursor node -> [a]
g = Axis node
f Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Axis node
forall node. Axis node
descendant Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor node -> [a]
g

-- | Combine two axes so that the second works on both the result nodes, and their
-- descendants.
(&.//) :: Axis node -> (Cursor node -> [a]) -> (Cursor node -> [a])
Axis node
f &.// :: Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&.// Cursor node -> [a]
g = Axis node
f Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Axis node -> Axis node
forall node. Axis node -> Axis node
orSelf Axis node
forall node. Axis node
descendant Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor node -> [a]
g

-- | Apply an axis to a 'Cursor node'.
($|) :: Cursor node -> (Cursor node -> a) -> a
Cursor node
v $| :: Cursor node -> (Cursor node -> a) -> a
$| Cursor node -> a
f = Cursor node -> a
f Cursor node
v

-- | Apply an axis to the children of a 'Cursor node'.
($/) :: Cursor node -> (Cursor node -> [a]) -> [a]
Cursor node
v $/ :: Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor node -> [a]
f = Cursor node -> [Cursor node]
forall node. Axis node
child Cursor node
v [Cursor node] -> (Cursor node -> [a]) -> [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Cursor node -> [a]
f

-- | Apply an axis to the descendants of a 'Cursor node'.
($//) :: Cursor node -> (Cursor node -> [a]) -> [a]
Cursor node
v $// :: Cursor node -> (Cursor node -> [a]) -> [a]
$// Cursor node -> [a]
f = Axis node
forall node. Axis node
descendant Cursor node
v [Cursor node] -> (Cursor node -> [a]) -> [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Cursor node -> [a]
f

-- | Apply an axis to a 'Cursor node' as well as its descendants.
($.//) :: Cursor node -> (Cursor node -> [a]) -> [a]
Cursor node
v $.// :: Cursor node -> (Cursor node -> [a]) -> [a]
$.// Cursor node -> [a]
f = Axis node -> Axis node
forall node. Axis node -> Axis node
orSelf Axis node
forall node. Axis node
descendant Cursor node
v [Cursor node] -> (Cursor node -> [a]) -> [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Cursor node -> [a]
f