-- | 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
    { forall node. Cursor node -> Maybe (Cursor node)
parent' :: Maybe (Cursor node)
    , forall node. Cursor node -> DiffCursor node
precedingSibling' :: DiffCursor node
    , forall node. Cursor node -> DiffCursor node
followingSibling' :: DiffCursor node
    -- | The child axis. XPath:
    -- /the child axis contains the children of the context node/.
    , forall node. Cursor node -> [Cursor node]
child :: [Cursor node]
    -- | The current node.
    , forall 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 @ " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show node
n

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

toCursor' :: (node -> [node])
          -> Maybe (Cursor node) -> DiffCursor node -> DiffCursor node -> node -> Cursor node
toCursor' :: forall node.
(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 = 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 forall a. a -> a
id [node]
chi' []
    go :: DiffCursor node -> [node] -> DiffCursor node
go DiffCursor node
_ [] = forall a. a -> a
id
    go DiffCursor node
pre' (node
n':[node]
ns') =
        (:) Cursor node
me' forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffCursor node
fol'
      where
        me' :: Cursor node
me' = forall node.
(node -> [node])
-> Maybe (Cursor node)
-> DiffCursor node
-> DiffCursor node
-> node
-> Cursor node
toCursor' node -> [node]
cs (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' 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 :: forall node. Cursor node -> [Cursor node]
parent = forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall node. Cursor node -> [Cursor node]
precedingSibling = (forall a b. (a -> b) -> a -> b
$ []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall node. Cursor node -> [Cursor node]
followingSibling = (forall a b. (a -> b) -> a -> b
$ []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall node. Cursor node -> [Cursor node]
preceding Cursor node
c =
    forall {t :: * -> *} {node}.
Foldable t =>
t (Cursor node) -> [Cursor node] -> [Cursor node]
go (forall node. Cursor node -> DiffCursor node
precedingSibling' Cursor node
c []) (forall node. Cursor node -> [Cursor node]
parent Cursor node
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall node. Cursor node -> [Cursor node]
preceding)
  where
    go :: t (Cursor node) -> [Cursor node] -> [Cursor node]
go t (Cursor node)
x [Cursor node]
y = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip  Cursor node -> [Cursor node] -> [Cursor node]
go') (Cursor node
x forall a. a -> [a] -> [a]
: [Cursor node]
rest) (forall node. Cursor node -> [Cursor 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 :: forall node. Cursor node -> [Cursor node]
following Cursor node
c =
    forall {t :: * -> *} {a} {node}.
Foldable t =>
([a] -> t (Cursor node)) -> [Cursor node] -> [Cursor node]
go (forall node. Cursor node -> DiffCursor node
followingSibling' Cursor node
c) (forall node. Cursor node -> [Cursor node]
parent Cursor node
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall node. Cursor node -> [Cursor node]
following)
  where
    go :: ([a] -> t (Cursor node)) -> [Cursor node] -> [Cursor node]
go [a] -> t (Cursor node)
x [Cursor node]
z = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 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 forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Cursor node -> [Cursor node] -> [Cursor node]
go' [Cursor node]
rest (forall node. Cursor node -> [Cursor 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 :: forall node. Cursor node -> [Cursor node]
ancestor = forall node. Cursor node -> [Cursor node]
parent forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (\Cursor node
p -> Cursor node
p forall a. a -> [a] -> [a]
: forall node. Cursor node -> [Cursor 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 :: forall node. Cursor node -> [Cursor node]
descendant = forall node. Cursor node -> [Cursor node]
child forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (\Cursor node
c -> Cursor node
c forall a. a -> [a] -> [a]
: forall node. Cursor node -> [Cursor 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 :: forall node. Axis node -> Axis node
orSelf Axis node
ax Cursor node
c = Cursor node
c 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 &| :: forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| a -> b
g = forall a b. (a -> b) -> [a] -> [b]
map a -> b
g 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 &/ :: forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor node -> [a]
g = Axis node
f forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall node. Cursor node -> [Cursor node]
child 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 &// :: forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&// Cursor node -> [a]
g = Axis node
f forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall node. Cursor node -> [Cursor node]
descendant 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 &.// :: forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&.// Cursor node -> [a]
g = Axis node
f forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall node. Axis node -> Axis node
orSelf forall node. Cursor node -> [Cursor node]
descendant 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 $| :: forall node a. 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 $/ :: forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor node -> [a]
f = forall node. Cursor node -> [Cursor node]
child Cursor node
v 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 $// :: forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Cursor node -> [a]
f = forall node. Cursor node -> [Cursor node]
descendant Cursor node
v 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 $.// :: forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$.// Cursor node -> [a]
f = forall node. Axis node -> Axis node
orSelf forall node. Cursor node -> [Cursor node]
descendant Cursor node
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Cursor node -> [a]
f