{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- | Efficient DOM data structure
module Xeno.DOM.Internal
  ( Node(..)
  , Content(..)
  , name
  , attributes
  , contents
  , children
  ) where

import           Control.DeepSeq
import           Data.ByteString          (ByteString)
import qualified Data.ByteString as S
import           Data.Data                (Data, Typeable)
import           Data.Vector.Unboxed      ((!))
import qualified Data.Vector.Unboxed as UV

--import Debug.Trace
--trace _ a = a

-- | Some XML nodes.
data Node = Node !ByteString !Int !(UV.Vector Int)
  deriving (Node -> Node -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq, Typeable Node
Node -> DataType
Node -> Constr
(forall b. Data b => b -> b) -> Node -> Node
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Node -> u
forall u. (forall d. Data d => d -> u) -> Node -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Node -> m Node
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Node
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node -> c Node
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Node)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Node)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Node -> m Node
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Node -> m Node
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Node -> m Node
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Node -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Node -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Node -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Node -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Node -> r
gmapT :: (forall b. Data b => b -> b) -> Node -> Node
$cgmapT :: (forall b. Data b => b -> b) -> Node -> Node
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Node)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Node)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Node)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Node)
dataTypeOf :: Node -> DataType
$cdataTypeOf :: Node -> DataType
toConstr :: Node -> Constr
$ctoConstr :: Node -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Node
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Node
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node -> c Node
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Node -> c Node
Data, Typeable)

instance NFData Node where
  rnf :: Node -> ()
rnf !Node
_ = ()

instance Show Node where
  show :: Node -> String
show Node
n =
    String
"(Node " forall a. [a] -> [a] -> [a]
++
    forall a. Show a => a -> String
show (Node -> ByteString
name Node
n) forall a. [a] -> [a] -> [a]
++
    String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Node -> [(ByteString, ByteString)]
attributes Node
n) forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Node -> [Content]
contents Node
n) forall a. [a] -> [a] -> [a]
++ String
")"

-- | Content of a node.
data Content
  = Element {-# UNPACK #-}!Node
  | Text {-# UNPACK #-}!ByteString
  | CData {-# UNPACK #-}!ByteString
  deriving (Content -> Content -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Content -> Content -> Bool
$c/= :: Content -> Content -> Bool
== :: Content -> Content -> Bool
$c== :: Content -> Content -> Bool
Eq, Int -> Content -> ShowS
[Content] -> ShowS
Content -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Content] -> ShowS
$cshowList :: [Content] -> ShowS
show :: Content -> String
$cshow :: Content -> String
showsPrec :: Int -> Content -> ShowS
$cshowsPrec :: Int -> Content -> ShowS
Show, Typeable Content
Content -> DataType
Content -> Constr
(forall b. Data b => b -> b) -> Content -> Content
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Content -> u
forall u. (forall d. Data d => d -> u) -> Content -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Content -> m Content
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Content
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Content -> c Content
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Content)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Content)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Content -> m Content
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Content -> m Content
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Content -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Content -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Content -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Content -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
gmapT :: (forall b. Data b => b -> b) -> Content -> Content
$cgmapT :: (forall b. Data b => b -> b) -> Content -> Content
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Content)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Content)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Content)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Content)
dataTypeOf :: Content -> DataType
$cdataTypeOf :: Content -> DataType
toConstr :: Content -> Constr
$ctoConstr :: Content -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Content
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Content
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Content -> c Content
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Content -> c Content
Data, Typeable)

instance NFData Content where
  rnf :: Content -> ()
rnf !Content
_ = ()

-- | Get just element children of the node (no text).
children :: Node -> [Node]
children :: Node -> [Node]
children (Node ByteString
str Int
start Vector Int
offsets) = Int -> [Node]
collect Int
firstChild
  where
    collect :: Int -> [Node]
collect Int
i
      | Int
i forall a. Ord a => a -> a -> Bool
< Int
endBoundary =
        case Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! Int
i of
          Int
0x00 -> ByteString -> Int -> Vector Int -> Node
Node ByteString
str Int
i Vector Int
offsets forall a. a -> [a] -> [a]
: Int -> [Node]
collect (Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! (Int
i forall a. Num a => a -> a -> a
+ Int
4))
          Int
0x01 -> Int -> [Node]
collect (Int
i forall a. Num a => a -> a -> a
+ Int
3)
          Int
_off -> [] -- trace ("Offsets " <> show i <> " is " <> show off) []
      | Bool
otherwise = []
    firstChild :: Int
firstChild = Int -> Int
go (Int
start forall a. Num a => a -> a -> a
+ Int
5)
      where
        go :: Int -> Int
go Int
i
          | Int
i forall a. Ord a => a -> a -> Bool
< Int
endBoundary =
            case Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! Int
i of
              Int
0x02 -> Int -> Int
go (Int
i forall a. Num a => a -> a -> a
+ Int
5)
              Int
_ -> Int
i
          | Bool
otherwise = Int
i
    endBoundary :: Int
endBoundary = Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! (Int
start forall a. Num a => a -> a -> a
+ Int
4)

-- | Contents of a node.
contents :: Node -> [Content]
contents :: Node -> [Content]
contents (Node ByteString
str Int
start Vector Int
offsets) = Int -> [Content]
collect Int
firstChild
  where
    collect :: Int -> [Content]
collect Int
i
      | Int
i forall a. Ord a => a -> a -> Bool
< Int
endBoundary =
        case Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! Int
i of
          Int
0x00 ->
            Node -> Content
Element
              (ByteString -> Int -> Vector Int -> Node
Node ByteString
str Int
i Vector Int
offsets) forall a. a -> [a] -> [a]
:
            Int -> [Content]
collect (Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! (Int
i forall a. Num a => a -> a -> a
+ Int
4))
          Int
0x01 ->
            ByteString -> Content
Text (ByteString -> Int -> Int -> ByteString
substring ByteString
str (Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! (Int
i forall a. Num a => a -> a -> a
+ Int
1)) (Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! (Int
i forall a. Num a => a -> a -> a
+ Int
2))) forall a. a -> [a] -> [a]
:
            Int -> [Content]
collect (Int
i forall a. Num a => a -> a -> a
+ Int
3)
          Int
0x03 ->
            ByteString -> Content
CData (ByteString -> Int -> Int -> ByteString
substring ByteString
str (Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! (Int
i forall a. Num a => a -> a -> a
+ Int
1)) (Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! (Int
i forall a. Num a => a -> a -> a
+ Int
2))) forall a. a -> [a] -> [a]
:
            Int -> [Content]
collect (Int
i forall a. Num a => a -> a -> a
+ Int
3)
          Int
_ -> []
      | Bool
otherwise = []
    firstChild :: Int
firstChild = Int -> Int
go (Int
start forall a. Num a => a -> a -> a
+ Int
5)
      where
        go :: Int -> Int
go Int
i | Int
i forall a. Ord a => a -> a -> Bool
< Int
endBoundary =
          case Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! Int
i of
            Int
0x02 -> Int -> Int
go (Int
i forall a. Num a => a -> a -> a
+ Int
5)
            Int
_ -> Int
i
          | Bool
otherwise = Int
i
    endBoundary :: Int
endBoundary = Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! (Int
start forall a. Num a => a -> a -> a
+ Int
4)

-- | Attributes of a node.
attributes :: Node -> [(ByteString,ByteString)]
attributes :: Node -> [(ByteString, ByteString)]
attributes (Node ByteString
str Int
start Vector Int
offsets) = Int -> [(ByteString, ByteString)]
collect (Int
start forall a. Num a => a -> a -> a
+ Int
5)
  where
    collect :: Int -> [(ByteString, ByteString)]
collect Int
i
      | Int
i forall a. Ord a => a -> a -> Bool
< Int
endBoundary =
        case Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! Int
i of
          Int
0x02 ->
            ( ByteString -> Int -> Int -> ByteString
substring ByteString
str (Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! (Int
i forall a. Num a => a -> a -> a
+ Int
1)) (Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! (Int
i forall a. Num a => a -> a -> a
+ Int
2))
            , ByteString -> Int -> Int -> ByteString
substring ByteString
str (Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! (Int
i forall a. Num a => a -> a -> a
+ Int
3)) (Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! (Int
i forall a. Num a => a -> a -> a
+ Int
4))) forall a. a -> [a] -> [a]
:
            Int -> [(ByteString, ByteString)]
collect (Int
i forall a. Num a => a -> a -> a
+ Int
5)
          Int
_ -> []
      | Bool
otherwise = []
    endBoundary :: Int
endBoundary = Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! (Int
start forall a. Num a => a -> a -> a
+ Int
4)

-- | Name of the element.
name :: Node -> ByteString
name :: Node -> ByteString
name (Node ByteString
str Int
start Vector Int
offsets) =
  case Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! Int
start of
    Int
0x00 -> ByteString -> Int -> Int -> ByteString
substring ByteString
str (Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! (Int
start forall a. Num a => a -> a -> a
+ Int
2)) (Vector Int
offsets forall a. Unbox a => Vector a -> Int -> a
! (Int
start forall a. Num a => a -> a -> a
+ Int
3))
    Int
_ -> forall a. HasCallStack => String -> a
error String
"Node cannot have empty name" -- mempty

-- | Get a substring of the BS.
substring :: ByteString -> Int -> Int -> ByteString
substring :: ByteString -> Int -> Int -> ByteString
substring ByteString
s' Int
start Int
len = Int -> ByteString -> ByteString
S.take Int
len (Int -> ByteString -> ByteString
S.drop Int
start ByteString
s')
{-# INLINE substring #-}