content: -- | This module provides for simple DOM traversal. It is inspired by XPath. There are two central concepts here:
  --
  -- * A 'Cursor' represents a node in the DOM. It also contains information on the node's /location/. While the 'Node' datatype will only know of its children, a @Cursor@ knows about its parent and siblings as well. (The underlying mechanism allowing this is called a zipper, see <http://www.haskell.org/haskellwiki/Zipper> and <http://www.haskell.org/haskellwiki/Tying_the_Knot>.)
  --
  -- * An 'Axis', in its simplest form, takes a @Cursor@ and returns a list of @Cursor@s. It is used for selections, such as finding children, ancestors, etc. Axes can be chained together to express complex rules, such as all children named /foo/.
  --
  -- The terminology used in this module is taken directly from the XPath
  -- specification: <http://www.w3.org/TR/xpath/>. For those familiar with XPath,
  -- the one major difference is that attributes are not considered nodes in this
  -- module.
  module Text.XML.Cursor
      (
      -- * Data types
        Cursor
      , Axis
      -- * Production
      , fromDocument
      , fromNode
      , cut
      -- * Axes
      , parent
      , CG.precedingSibling
      , CG.followingSibling
      , child
      , node
      , CG.preceding
      , CG.following
      , CG.ancestor
      , descendant
      , orSelf
        -- ** Filters
      , check
      , checkNode
      , checkElement
      , checkName
      , anyElement
      , element
      , laxElement
      , content
      , attribute
      , laxAttribute
      , hasAttribute
      , attributeIs
      -- * Operators
      , (CG.&|)
      , (CG.&/)
      , (CG.&//)
      , (CG.&.//)
      , (CG.$|)
      , (CG.$/)
      , (CG.$//)
      , (CG.$.//)
      , (CG.>=>)
      -- * Type classes
      , Boolean(..)
      -- * Error handling
      , force
      , forceM
      ) where
  
  import           Control.Exception            (Exception)
  import           Control.Monad
  import           Control.Monad.Trans.Resource (MonadThrow, throwM)
  import           Data.Function                (on)
  import qualified Data.Map                     as Map
  import           Data.Maybe                   (maybeToList)
  import qualified Data.Text                    as T
  import           Text.XML
  import           Text.XML.Cursor.Generic      (child, descendant, node, orSelf,
                                                 parent)
  import qualified Text.XML.Cursor.Generic      as CG
  
  -- TODO: Consider [Cursor] -> [Cursor]?
  -- | The type of an Axis that returns a list of Cursors.
  -- They are roughly modeled after <http://www.w3.org/TR/xpath/#axes>.
  --
  -- Axes can be composed with '>=>', where e.g. @f >=> g@ means that on all results of
  -- the @f@ axis, the @g@ axis will be applied, and all results joined together.
  -- Because Axis is just a type synonym for @Cursor -> [Cursor]@, it is possible to use
  -- other standard functions like '>>=' or 'concatMap' similarly.
  --
  -- The operators '&|', '&/', '&//' and '&.//' can be used to combine axes so that the second
  -- axis works on the context nodes, children, descendants, respectively the context node as
  -- well as its descendants of the results of the first axis.
  --
  -- The operators '$|', '$/', '$//' and '$.//' can be used to apply an axis (right-hand side)
  -- to a cursor so that it is applied on the cursor itself, its children, its descendants,
  -- respectively itself and its descendants.
  --
  -- Note that many of these operators also work on /generalised Axes/ that can return
  -- lists of something other than Cursors, for example Content elements.
  type Axis = Cursor -> [Cursor]
  
  -- XPath axes as in http://www.w3.org/TR/xpath/#axes
  
  -- TODO: Decide whether to use an existing package for this
  -- | Something that can be used in a predicate check as a boolean.
  class Boolean a where
      bool :: a -> Bool
  
  instance Boolean Bool where
      bool = id
  instance Boolean [a] where
      bool = not . null
  instance Boolean (Maybe a) where
      bool (Just _) = True
      bool _        = False
  instance Boolean (Either a b) where
      bool (Left _)  = False
      bool (Right _) = True
  
  -- | A cursor: contains an XML 'Node' and pointers to its children, ancestors and siblings.
  type Cursor = CG.Cursor Node
  
  -- | Cut a cursor off from its parent. The idea is to allow restricting the scope of queries on it.
  cut :: Cursor -> Cursor
  cut = fromNode . CG.node
  
  -- | Convert a 'Document' to a 'Cursor'. It will point to the document root.
  fromDocument :: Document -> Cursor
  fromDocument = fromNode . NodeElement . documentRoot
  
  -- | Convert a 'Node' to a 'Cursor' (without parents).
  fromNode :: Node -> Cursor
  fromNode =
      CG.toCursor cs
    where
      cs (NodeElement (Element _ _ x)) = x
      cs _                             = []
  
  -- | Filter cursors that don't pass a check.
  check :: Boolean b => (Cursor -> b) -> Axis
  check f c = [c | bool $ f c]
  
  -- | Filter nodes that don't pass a check.
  checkNode :: Boolean b => (Node -> b) -> Axis
  checkNode f = check (f . node)
  
  -- | Filter elements that don't pass a check, and remove all non-elements.
  checkElement :: Boolean b => (Element -> b) -> Axis
  checkElement f c = case node c of
                       NodeElement e -> [c | bool $ f e]
                       _ -> []
  
  -- | Filter elements that don't pass a name check, and remove all non-elements.
  checkName :: Boolean b => (Name -> b) -> Axis
  checkName f = checkElement (f . elementName)
  
  -- | Remove all non-elements. Compare roughly to XPath:
  -- /A node test * is true for any node of the principal node type. For example, child::* will select all element children of the context node [...]/.
  anyElement :: Axis
  anyElement = checkElement (const True)
  
  -- | Select only those elements with a matching tag name. XPath:
  -- /A node test that is a QName is true if and only if the type of the node (see [5 Data Model]) is the principal node type and has an expanded-name equal to the expanded-name specified by the QName./
  element :: Name -> Axis
  element n = checkName (== n)
  
  -- | Select only those elements with a loosely matching tag name. Namespace and case are ignored. XPath:
  -- /A node test that is a QName is true if and only if the type of the node (see [5 Data Model]) is the principal node type and has an expanded-name equal to the expanded-name specified by the QName./
  laxElement :: T.Text -> Axis
  laxElement n = checkName (on (==) T.toCaseFold n . nameLocalName)
  
  -- | Select only text nodes, and directly give the 'Content' values. XPath:
  -- /The node test text() is true for any text node./
  --
  -- Note that this is not strictly an 'Axis', but will work with most combinators.
  content :: Cursor -> [T.Text]
  content c = case node c of
                (NodeContent v) -> [v]
                _               -> []
  
  -- | Select attributes on the current element (or nothing if it is not an element). XPath:
  -- /the attribute axis contains the attributes of the context node; the axis will be empty unless the context node is an element/
  --
  -- Note that this is not strictly an 'Axis', but will work with most combinators.
  --
  -- The return list of the generalised axis contains as elements lists of 'Content'
  -- elements, each full list representing an attribute value.
  attribute :: Name -> Cursor -> [T.Text]
  attribute n c =
      case node c of
          NodeElement e -> maybeToList $ Map.lookup n $ elementAttributes e
          _             -> []
  
  -- | Select attributes on the current element (or nothing if it is not an element).  Namespace and case are ignored. XPath:
  -- /the attribute axis contains the attributes of the context node; the axis will be empty unless the context node is an element/
  --
  -- Note that this is not strictly an 'Axis', but will work with most combinators.
  --
  -- The return list of the generalised axis contains as elements lists of 'Content'
  -- elements, each full list representing an attribute value.
  laxAttribute :: T.Text -> Cursor -> [T.Text]
  laxAttribute n c =
      case node c of
          NodeElement e -> do
              (n', v) <- Map.toList $ elementAttributes e
              guard $ (on (==) T.toCaseFold) n (nameLocalName n')
              return v
          _ -> []
  
  -- | Select only those element nodes with the given attribute.
  hasAttribute :: Name -> Axis
  hasAttribute n c =
      case node c of
          NodeElement (Element _ as _) -> maybe [] (const [c]) $ Map.lookup n as
          _ -> []
  
  -- | Select only those element nodes containing the given attribute key/value pair.
  attributeIs :: Name -> T.Text -> Axis
  attributeIs n v c =
      case node c of
          NodeElement (Element _ as _) -> [ c | Just v == Map.lookup n as]
          _                            -> []
  
  force :: (Exception e, MonadThrow f) => e -> [a] -> f a
  force e []    = throwM e
  force _ (x:_) = return x
  
  forceM :: (Exception e, MonadThrow f) => e -> [f a] -> f a
  forceM e []    = throwM e
  forceM _ (x:_) = x
  