module Text.Xml.Tiny
( Node, name, inner, outer, contents, location
, Attribute(..)
, parse
, children, childrenBy
, attributes, attributeBy
, SrcLoc(..)
, Error(..)
, ErrorType(..)
, rerender
) where
import Control.Exception
import Text.Xml.Tiny.Internal (Node(..), Attribute(..), ParseDetails(ParseDetails), AttributeParseDetails(..), Error(..), ErrorType(..), SrcLoc(..))
import qualified Text.Xml.Tiny.Internal as Slice
import qualified Text.Xml.Tiny.Internal.Parser as Internal
import Data.ByteString.Internal (ByteString(..))
import qualified Data.ByteString.Char8 as BS
import Data.Char
import Data.Int
import Data.Maybe (listToMaybe)
import Data.Monoid
import Config
import Text.Printf
parse :: Config => ByteString -> Either Error Node
parse bs =
case Internal.parse bs of
Left e -> Left e
Right (attV, nV, slices) -> Right $ Node attV nV bs slices
instance Show Node where
show n =
case children n of
[] -> printf "<%s%s/>" nameN attrs
_ -> printf "<%s%s>...</%s>" nameN attrs nameN
where
nameN = BS.unpack $ name n
attrs = unwords [ BS.unpack n <> "=" <> BS.unpack v | Attribute n v <- attributes n]
name, inner, outer :: Config => Node -> ByteString
name Node{source, slices = ParseDetails{..}} = Slice.render name source
inner Node{source, slices = ParseDetails{..}} = Slice.render inner source
outer Node{source, slices = ParseDetails{..}} = Slice.render outer source
attributes :: Config => Node -> [Attribute]
attributes Node{attributesV, source, slices = ParseDetails{attributes}} =
[ Attribute (Slice.render n source) (Slice.render v source)
| AttributeParseDetails n v <- Slice.vector attributes attributesV ]
contents :: Config => Node -> [Either BS.ByteString Node]
contents n@Node{source, slices=ParseDetails{inner}} =
f (Slice.start inner) (children n)
where
f :: Config => Int32 -> [Node] -> [Either BS.ByteString Node]
f i [] = string i (Slice.end inner) ++ []
f i (n@Node{slices=ParseDetails{outer}} : nn) = string i (Slice.start outer) ++ Right n
: f (Slice.end outer) nn
string :: Config => Int32 -> Int32 -> [Either BS.ByteString Node]
string start end
| assert (start<=end || error (printf "start=%d, end=%d" start end)) False = undefined
| start == end = []
| otherwise = [Left $ Slice.render (Slice.fromOpenClose start end) source]
children :: Node -> [Node]
children Node{slices = ParseDetails{nodeContents}, ..} =
[ Node{..} | slices <- Slice.vector nodeContents nodesV ]
childrenBy :: Config => Node -> BS.ByteString -> [Node]
childrenBy node str =
filter (\n -> name n == str) (children node)
attributeBy :: Config => Node -> BS.ByteString -> Maybe Attribute
attributeBy node str = listToMaybe [ a | a@(Attribute name _) <- attributes node, name == str ]
location :: Config => Node -> (Int, Int)
location Node{source, slices=ParseDetails{outer}} =
BS.foldl' f (pair 1 1) $ BS.take (fromIntegral $ Slice.start outer) source
where
pair !a !b = (a,b)
f (!line, !col) c
| c == '\n' = pair (line+1) 1
| c == '\t' = pair line (col+8)
| otherwise = pair line (col+1)
rerender :: Node -> BS.ByteString
rerender = inside
where
inside x = BS.concat $ map (either validStr node) $ contents x
node x = "<" <> BS.unwords (validName (name x) : map attr (attributes x)) <> ">" <>
inside x <>
"</" <> name x <> ">"
attr (Attribute a b) = validName a <> "=\"" <> validAttr b <> "\""
validName x | BS.all (\x -> isAlphaNum x || x `elem` ("-:_" :: String)) x = x
| otherwise = error "Invalid name"
validAttr x | BS.notElem '\"' x = x
| otherwise = error "Invalid attribute"
validStr x | BS.notElem '<' x || BS.isInfixOf "<!--" x = x
| otherwise = error $ show ("Invalid string", x)