<commit_before>------------------------------------------------------------------------------
-- | A zipper for navigating and modifying XML trees.  This is nearly the
-- same exposed interface as the @xml@ package in @Text.XML.Light.Cursor@,
-- with modifications as needed to adapt to different types.
module Text.XmlHtml.Cursor (
    -- * Cursor type
    Cursor,

    -- * Conversion to and from cursors
    fromNode,
    fromNodes,
    topNode,
    topNodes,
    current,
    siblings,

    -- * Cursor navigation
    parent,
    root,
    getChild,
    firstChild,
    lastChild,
    left,
    right,
    nextDF,

    -- * Search
    findChild,
    findLeft,
    findRight,
    findRec,

    -- * Node classification
    isRoot,
    isFirst,
    isLast,
    isLeaf,
    isChild,
    hasChildren,
    getNodeIndex,

    -- * Updates
    setNode,
    modifyNode,
    modifyNodeM,

    -- * Insertions
    insertLeft,
    insertRight,
    insertManyLeft,
    insertManyRight,
    insertFirstChild,
    insertLastChild,
    insertManyFirstChild,
    insertManyLastChild,
    insertGoLeft,
    insertGoRight,
    
    -- * Deletions
    removeLeft,
    removeRight,
    removeGoLeft,
    removeGoRight,
    removeGoUp
    ) where

import           Control.Monad
import           Data.Maybe
import           Data.Text (Text)
import           Text.XmlHtml

------------------------------------------------------------------------------
-- | Data type representing just the tag of an element
data Tag = Tag Text [(Text, Text)] deriving (Eq)


------------------------------------------------------------------------------
-- | Extracts the tag of a node, if it is an element.  Otherwise, gives
-- 'Nothing'
toTag :: Node -> Tag
toTag (Element t a _) = Tag t a
toTag _               = error "toTag on non-element"

------------------------------------------------------------------------------
-- | Reconstructs an element from a tag and a list of its children.
fromTag :: Tag -> [Node] -> Node
fromTag (Tag t a) c = Element t a c


------------------------------------------------------------------------------
-- | A zipper for XML document forests.
data Cursor = Cursor {
    current :: !Node,   -- ^ Retrieves the current node of a 'Cursor'
    lefts   :: ![Node],                 -- right to left
    rights  :: ![Node],                 -- left to right
    parents :: ![([Node], Tag, [Node])] -- parent's tag and siblings
    }
    deriving (Eq)


------------------------------------------------------------------------------
-- | Builds a 'Cursor' for navigating a tree. That is, a forest with a single
-- root 'Node'.
fromNode :: Node -> Cursor
fromNode n = Cursor n [] [] []


------------------------------------------------------------------------------
-- | Builds a 'Cursor' for navigating a forest with the given list of roots.
-- The cursor is initially positioned at the left-most node.  Gives 'Nothing'
-- if the list is empty.
fromNodes :: [Node] -> Maybe Cursor
fromNodes (n:ns) = Just (Cursor n [] ns [])
fromNodes []     = Nothing


------------------------------------------------------------------------------
-- | Retrieves the root node containing the current cursor position.
topNode :: Cursor -> Node
topNode cur  = current (root cur)


------------------------------------------------------------------------------
-- | Retrieves the entire forest of 'Node's corresponding to a 'Cursor'.
topNodes :: Cursor -> [Node]
topNodes cur = siblings (root cur)


------------------------------------------------------------------------------
-- | Retrieves a list of the 'Node's at the same level as the current position
-- of a cursor, including the current node.
siblings :: Cursor -> [Node]
siblings (Cursor cur ls rs _) = foldl (flip (:)) (cur:rs) ls


------------------------------------------------------------------------------
-- | Navigates a 'Cursor' to its parent in the document.
parent :: Cursor -> Maybe Cursor
parent c@(Cursor _ _ _ ((ls,t,rs):ps))
            = Just (Cursor (fromTag t (siblings c)) ls rs ps)
parent _    = Nothing


------------------------------------------------------------------------------
-- | Navigates a 'Cursor' up through parents to reach the root level.
root :: Cursor -> Cursor
root = until isRoot (fromJust . parent)


------------------------------------------------------------------------------
-- | Navigates a 'Cursor' down to the indicated child index.
getChild :: Int -> Cursor -> Maybe Cursor
getChild i (Cursor n ls rs ps) =
    let cs          = childNodes n
        (lls, rest) = splitAt i cs
    in  if i < length cs
            then Just $ Cursor (head rest)
                               (reverse lls)
                               (tail rest)
                               ((ls, toTag n, rs):ps)
            else Nothing


------------------------------------------------------------------------------
-- | Navigates a 'Cursor' down to its first child.
firstChild :: Cursor -> Maybe Cursor
firstChild = getChild 0


------------------------------------------------------------------------------
-- | Navigates a 'Cursor' down to its last child.
lastChild :: Cursor -> Maybe Cursor
lastChild (Cursor (Element t a c) ls rs ps) | not (null c)
    = let rc = reverse c
      in  Just $ Cursor (head rc) (tail rc) [] ((ls, Tag t a, rs):ps)
lastChild _
    = Nothing


------------------------------------------------------------------------------
-- | Moves a 'Cursor' to its left sibling.
left :: Cursor -> Maybe Cursor
left (Cursor c (l:ls) rs ps) = Just (Cursor l ls (c:rs) ps)<commit_msg>Collapsed toTag into getChild to remove unsafe code and improve test coverage.<commit_after>------------------------------------------------------------------------------
-- | A zipper for navigating and modifying XML trees.  This is nearly the
-- same exposed interface as the @xml@ package in @Text.XML.Light.Cursor@,
-- with modifications as needed to adapt to different types.
module Text.XmlHtml.Cursor (
    -- * Cursor type
    Cursor,

    -- * Conversion to and from cursors
    fromNode,
    fromNodes,
    topNode,
    topNodes,
    current,
    siblings,

    -- * Cursor navigation
    parent,
    root,
    getChild,
    firstChild,
    lastChild,
    left,
    right,
    nextDF,

    -- * Search
    findChild,
    findLeft,
    findRight,
    findRec,

    -- * Node classification
    isRoot,
    isFirst,
    isLast,
    isLeaf,
    isChild,
    hasChildren,
    getNodeIndex,

    -- * Updates
    setNode,
    modifyNode,
    modifyNodeM,

    -- * Insertions
    insertLeft,
    insertRight,
    insertManyLeft,
    insertManyRight,
    insertFirstChild,
    insertLastChild,
    insertManyFirstChild,
    insertManyLastChild,
    insertGoLeft,
    insertGoRight,
    
    -- * Deletions
    removeLeft,
    removeRight,
    removeGoLeft,
    removeGoRight,
    removeGoUp
    ) where

import           Control.Monad
import           Data.Maybe
import           Data.Text (Text)
import           Text.XmlHtml

------------------------------------------------------------------------------
-- | Data type representing just the tag of an element
data Tag = Tag Text [(Text, Text)] deriving (Eq)


------------------------------------------------------------------------------
-- | Reconstructs an element from a tag and a list of its children.
fromTag :: Tag -> [Node] -> Node
fromTag (Tag t a) c = Element t a c


------------------------------------------------------------------------------
-- | A zipper for XML document forests.
data Cursor = Cursor {
    current :: !Node,   -- ^ Retrieves the current node of a 'Cursor'
    lefts   :: ![Node],                 -- right to left
    rights  :: ![Node],                 -- left to right
    parents :: ![([Node], Tag, [Node])] -- parent's tag and siblings
    }
    deriving (Eq)


------------------------------------------------------------------------------
-- | Builds a 'Cursor' for navigating a tree. That is, a forest with a single
-- root 'Node'.
fromNode :: Node -> Cursor
fromNode n = Cursor n [] [] []


------------------------------------------------------------------------------
-- | Builds a 'Cursor' for navigating a forest with the given list of roots.
-- The cursor is initially positioned at the left-most node.  Gives 'Nothing'
-- if the list is empty.
fromNodes :: [Node] -> Maybe Cursor
fromNodes (n:ns) = Just (Cursor n [] ns [])
fromNodes []     = Nothing


------------------------------------------------------------------------------
-- | Retrieves the root node containing the current cursor position.
topNode :: Cursor -> Node
topNode cur  = current (root cur)


------------------------------------------------------------------------------
-- | Retrieves the entire forest of 'Node's corresponding to a 'Cursor'.
topNodes :: Cursor -> [Node]
topNodes cur = siblings (root cur)


------------------------------------------------------------------------------
-- | Retrieves a list of the 'Node's at the same level as the current position
-- of a cursor, including the current node.
siblings :: Cursor -> [Node]
siblings (Cursor cur ls rs _) = foldl (flip (:)) (cur:rs) ls


------------------------------------------------------------------------------
-- | Navigates a 'Cursor' to its parent in the document.
parent :: Cursor -> Maybe Cursor
parent c@(Cursor _ _ _ ((ls,t,rs):ps))
            = Just (Cursor (fromTag t (siblings c)) ls rs ps)
parent _    = Nothing


------------------------------------------------------------------------------
-- | Navigates a 'Cursor' up through parents to reach the root level.
root :: Cursor -> Cursor
root = until isRoot (fromJust . parent)


------------------------------------------------------------------------------
-- | Navigates a 'Cursor' down to the indicated child index.
getChild :: Int -> Cursor -> Maybe Cursor
getChild i (Cursor n ls rs ps) =
    case n of
      Element t a cs -> let (lls, rest) = splitAt i cs in
          if i >= length cs
            then Nothing
            else Just $ Cursor (head rest)
                               (reverse lls)
                               (tail rest)
                               ((ls, Tag t a, rs):ps)
      _              -> Nothing


------------------------------------------------------------------------------
-- | Navigates a 'Cursor' down to its first child.
firstChild :: Cursor -> Maybe Cursor
firstChild = getChild 0


------------------------------------------------------------------------------
-- | Navigates a 'Cursor' down to its last child.
lastChild :: Cursor -> Maybe Cursor
lastChild (Cursor (Element t a c) ls rs ps) | not (null c)
    = let rc = reverse c
      in  Just $ Cursor (head rc) (tail rc) [] ((ls, Tag t a, rs):ps)
lastChild _
    = Nothing


------------------------------------------------------------------------------
-- | Moves a 'Cursor' to its left sibling.
left :: Cursor -> Maybe Cursor
left (Cursor c (l:ls) rs ps) = Just (Cursor l ls (c:rs) ps)
{'fraction_non_alphanumeric': 0.30066551189716473, 'fraction_numerical': 0.0001823320266204759, 'mean_word_length': 1.1662717219589258, 'pattern_counts': {'":': 0, '<': 4, '<?xml version=': 0, '>': 35, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 2}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '893978', 'n_tokens_mistral': 2705, 'n_tokens_neox': 2622, 'n_words': 1025}