{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
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
data Node = Node !ByteString !Int !(UV.Vector Int)
deriving (Eq, Data, Typeable)
instance NFData Node where
rnf !_ = ()
instance Show Node where
show n =
"(Node " ++
show (name n) ++
" " ++ show (attributes n) ++ " " ++ show (contents n) ++ ")"
data Content
= Element {-# UNPACK #-}!Node
| Text {-# UNPACK #-}!ByteString
| CData {-# UNPACK #-}!ByteString
deriving (Eq, Show, Data, Typeable)
instance NFData Content where
rnf !_ = ()
children :: Node -> [Node]
children (Node str start offsets) = collect firstChild
where
collect i
| i < endBoundary =
case offsets ! i of
0x00 -> Node str i offsets : collect (offsets ! (i + 4))
0x01 -> collect (i + 3)
_off -> []
| otherwise = []
firstChild = go (start + 5)
where
go i
| i < endBoundary =
case offsets ! i of
0x02 -> go (i + 5)
_ -> i
| otherwise = i
endBoundary = offsets ! (start + 4)
contents :: Node -> [Content]
contents (Node str start offsets) = collect firstChild
where
collect i
| i < endBoundary =
case offsets ! i of
0x00 ->
Element
(Node str i offsets) :
collect (offsets ! (i + 4))
0x01 ->
Text (substring str (offsets ! (i + 1)) (offsets ! (i + 2))) :
collect (i + 3)
0x03 ->
CData (substring str (offsets ! (i + 1)) (offsets ! (i + 2))) :
collect (i + 3)
_ -> []
| otherwise = []
firstChild = go (start + 5)
where
go i | i < endBoundary =
case offsets ! i of
0x02 -> go (i + 5)
_ -> i
| otherwise = i
endBoundary = offsets ! (start + 4)
attributes :: Node -> [(ByteString,ByteString)]
attributes (Node str start offsets) = collect (start + 5)
where
collect i
| i < endBoundary =
case offsets ! i of
0x02 ->
( substring str (offsets ! (i + 1)) (offsets ! (i + 2))
, substring str (offsets ! (i + 3)) (offsets ! (i + 4))) :
collect (i + 5)
_ -> []
| otherwise = []
endBoundary = offsets ! (start + 4)
name :: Node -> ByteString
name (Node str start offsets) =
case offsets ! start of
0x00 -> substring str (offsets ! (start + 2)) (offsets ! (start + 3))
_ -> error "Node cannot have empty name"
substring :: ByteString -> Int -> Int -> ByteString
substring s' start len = S.take len (S.drop start s')
{-# INLINE substring #-}