-- ------------------------------------------------------------

{- |
   Module     : Text.XML.HXT.XPath.XPathDataTypes
   Copyright  : Copyright (C) 2006 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : experimental
   Portability: portable

   The core data types of XPath.
   The Type NodeSet is based on the module "NavTree" which was adapted from
   HXML (<http://www.flightlab.com/~joe/hxml/>)

-}

-- ------------------------------------------------------------

module Text.XML.HXT.XPath.XPathDataTypes
    ( module Text.XML.HXT.XPath.XPathDataTypes
    , module Text.XML.HXT.XPath.NavTree
    )
where

import Data.Function			( on )
import Data.Map				( Map )
import qualified
       Data.Map				as M

import Text.XML.HXT.XPath.NavTree
import Text.XML.HXT.DOM.Interface

-- -----------------------------------------------------------------------------
--
-- Expr

-- | Represents expression
-- 

data Expr     = GenExpr Op [Expr]             -- ^ generic expression with an operator and one or more operands
              | PathExpr (Maybe Expr) (Maybe LocationPath)
	                                      -- ^ a path expression contains an optional filter-expression
					      -- or an optional locationpath. one expression is urgently
					      -- necessary, both are possible
              | FilterExpr [Expr]             -- ^ filter-expression with zero or more predicates
              | VarExpr VarName               -- ^ variable
              | LiteralExpr Literal           -- ^ string
              | NumberExpr XPNumber           -- ^ number
              | FctExpr FctName FctArguments  -- ^ a function with a name and an optional list of arguments
              deriving (Show, Eq)


-- -----------------------------------------------------------------------------
--
-- Op

-- | Represents XPath operators

data Op       = Or | And | Eq | NEq | Less | Greater | LessEq
              | GreaterEq |Plus | Minus | Div | Mod | Mult| Unary | Union
              deriving (Show, Eq)


-- -----------------------------------------------------------------------------
--
-- |
-- Represents a floating-point number according the IEEE 754 standard
--
-- The standard includes a special Not-a-Number (NaN) value,
-- positive and negative infinity, positive and negative zero.

data XPNumber = Float Float  -- ^ floating-point number
              | NaN          -- ^ not-a-number
              | NegInf       -- ^ negative infinity
              | Neg0         -- ^ negative zero
              | Pos0         -- ^ positive zero
              | PosInf       -- ^ positive infinity


instance Show XPNumber
    where
    show NaN           = "NaN"
    show NegInf        = "-Infinity"
    show Neg0          = "-0"
    show Pos0          = "0"
    show (Float f)     = show f
    show PosInf        = "Infinity"



-- Negative zero is equal to positive zero,
-- equality test with NaN-value is always false
instance Eq XPNumber
    where
    NegInf  == NegInf  = True
    Pos0    == Neg0    = True
    Neg0    == Pos0    = True
    Pos0    == Pos0    = True
    Neg0    == Neg0    = True
    Float f == Float g = f == g
    PosInf  == PosInf  = True
    _       == _       = False


instance Ord XPNumber
    where
    a       <= b       = (a < b) || (a == b)
    a       >= b       = (a > b) || (a == b)
    a       >  b       =  b < a

    NaN     < _        = False
    _       < NaN      = False

    _       < NegInf   = False
    NegInf  < _	       = True

    Neg0    < Neg0     = False
    Pos0    < Pos0     = False
    Pos0    < Neg0     = False
    Neg0    < Pos0     = False

    Neg0    < Float f  = 0 < f
    Pos0    < Float f  = 0 < f
    Float f < Neg0     = f < 0
    Float f < Pos0     = f < 0

    Float f < Float g  = f < g

    PosInf  < _        = False
    _       < PosInf   = True


-- -----------------------------------------------------------------------------
-- | Represents location path
--
-- A location path consists of a sequence of one or more location steps.

data LocationPath = LocPath Path [XStep]
                  deriving (Show, Eq)


-- -----------------------------------------------------------------------------                  
-- |
-- A location path is either a relative or an absolute path.

data Path         = Rel
		  | Abs
                  deriving (Show, Eq)
					

-- | Represents location step
-- 
-- A location step consists of an axis, a node-test and zero or more predicates.

data XStep        = Step AxisSpec NodeTest [Expr]
                  deriving (Show, Eq)

			
-- -----------------------------------------------------------------------------
--
-- AxisSpec

-- | Represents XPath axis

data AxisSpec     = Ancestor
		  | AncestorOrSelf
		  | Attribute
		  | Child
		  | Descendant  
                  | DescendantOrSelf
		  | Following
		  | FollowingSibling
                  | Namespace
		  | Parent
		  | Preceding
		  | PrecedingSibling
		  | Self
                  deriving (Show, Eq)

-- -----------------------------------------------------------------------------
--
-- NodeTest

-- | Represents XPath node-tests

--data NodeTest     = NameTest Name     -- ^ name-test
data NodeTest     = NameTest QName     -- ^ name-test
                  | PI String           -- ^ processing-instruction-test with a literal argument
                  | TypeTest XPathNode  -- ^ all nodetype-tests
                  deriving (Show, Eq)

-- -----------------------------------------------------------------------------
--
-- XPathNode

-- | Represents nodetype-tests

data XPathNode    = XPNode            -- ^ all 7 nodetypes
                                      --  (root, element, attribute, namespace, pi, comment, text)
                  | XPCommentNode     -- ^ comment-nodes
                  | XPPINode          -- ^ processing-instruction-nodes
                  | XPTextNode        -- ^ text-nodes: cdata, character data
                  deriving (Show, Eq)


-- -----------------------------------------------------------------------------
--
-- useful type definitions

type Name 		= (NamePrefix, LocalName)
type NamePrefix 	= String
type LocalName 		= String

-- | Variable name
type VarName      	= Name

-- | a string
type Literal      	= String					

-- | Function name
type FctName      	= String

-- | Function arguments
type FctArguments 	= [Expr]

-- | Evaluation context
type Context      	= (ConPos ,ConLen, ConNode)

-- | Context position
type ConPos       	= Int

-- | Context length
type ConLen       	= Int

-- | Context node
type ConNode      	= NavXmlTree


-- -----------------------------------------------------------------------------
--
-- XPathValue

-- | Represents XPath results

data XPathValue   = XPVNode NodeSet      -- ^ node-set
                  | XPVBool Bool         -- ^ boolean value
                  | XPVNumber XPNumber   -- ^ number according the IEEE 754 standard
                  | XPVString String     -- ^ string value
                  | XPVError String      -- ^ error message with text
                  deriving (Show, Eq, Ord)

-- -----------------------------------------------------------------------------
--
-- Basic types for navigable tree and filters

-- | Node of navigable tree representation

type NavXmlTree   	= NavTree XNode

-- | List of nodes of navigable tree representation

type NavXmlTrees  	= [NavXmlTree]

-- | Set of navigable trees identified by their document position (NodePath)

newtype NodeSet      	= NS { unNS :: Map NodePath NavXmlTree }
			  deriving (Show)

-- | path represented as list of indices starting at root

type NodePath		= [Int]

-- | A functions that takes a XPath result and returns a XPath result

type XPathFilter  	= XPathValue -> XPathValue

-- -----------------------------------------------------------------------------

withXPVNode		:: String -> (NodeSet -> XPathValue) -> XPathFilter
withXPVNode s f	n	= case n of
			  XPVNode ns		-> f ns
			  e@(XPVError _)	-> e
			  _			-> XPVError s

-- -----------------------------------------------------------------------------

-- | node set functions

emptyNodeSet		:: NodeSet
emptyNodeSet		= NS M.empty

singletonNodeSet	:: NavXmlTree -> NodeSet
singletonNodeSet	= toNodeSet . (:[])

nullNodeSet		:: NodeSet -> Bool
nullNodeSet		= M.null . unNS

cardNodeSet		:: NodeSet -> Int
cardNodeSet		= M.size . unNS

deleteNodeSet		:: NodePath -> NodeSet -> NodeSet
deleteNodeSet p		= NS . M.delete p . unNS

insertNodeSet		:: NavXmlTree -> NodeSet -> NodeSet
insertNodeSet t		= NS . M.insert (pathNT t) t . unNS

unionNodeSet		:: NodeSet -> NodeSet -> NodeSet
unionNodeSet ns1	= NS . M.union (unNS ns1) . unNS

unionsNodeSet		:: [NodeSet] -> NodeSet
unionsNodeSet		= NS . foldl (\ res ns -> M.union res $ unNS ns) M.empty

elemsNodeSet		:: NodeSet -> [(NodePath, NavXmlTree)]
elemsNodeSet		= M.toList . unNS

fromNodeSet		:: NodeSet -> NavXmlTrees
fromNodeSet		= M.elems . unNS

toNodeSet		:: NavXmlTrees -> NodeSet
toNodeSet		= NS . foldl (\ m t -> M.insert (pathNT t) t m) M.empty

headNodeSet		:: NodeSet -> NavXmlTree
headNodeSet		= head . fromNodeSet

withNodeSet		:: (NavXmlTrees -> NavXmlTrees) -> NodeSet -> NodeSet
withNodeSet f		= toNodeSet . f . fromNodeSet

instance Eq NodeSet where
    (==)		= (==) `on` (M.keys . unNS)

instance Ord NodeSet where
    compare		= compare `on` (M.keys . unNS)

-- -----------------------------------------------------------------------------
--
-- Env

-- | XPath environment
--
-- All variables are stored in the environment,
-- each variable name is bound to a value.

type VarTab       	= [(VarName, XPathValue)]
type KeyTab       	= [(QName, String, NavXmlTree)]

type Env          	= (VarTab, KeyTab)

varEnv 			:: Env
varEnv 			= ( [ (("", "name"), XPVNumber NaN) ]
			  , []
			  )

-- -----------------------------------------------------------------------------