{-# OPTIONS -fno-warn-orphans -fno-warn-unused-imports #-}

-- ------------------------------------------------------------

{- |
   Module     : Text.XML.HXT.DOM.Binary
   Copyright  : Copyright (C) 2008 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : stable
   Portability: portable

   De-/Serialisation for XmlTrees
-}

-- ------------------------------------------------------------

module Text.XML.HXT.DOM.Binary
where

import Data.Binary
import Data.List
import Data.Maybe
import Data.Tree.NTree.Binary

import Text.XML.HXT.DOM.TypeDefs
import Text.XML.HXT.DOM.QualifiedName

-- -----------------------------------------------------------------------------

instance Binary XNode where
    put	(XText s)		= put (0::Word8) >> put s
    put (XCharRef i)		= put (1::Word8) >> put i
    put (XEntityRef n)		= put (2::Word8) >> put n
    put (XCmt c)		= put (3::Word8) >> put c
    put (XCdata s)		= put (4::Word8) >> put s
    put (XPi qn ts)		= put (5::Word8) >> put qn >> put ts
    put (XTag qn cs)		= put (6::Word8) >> put qn >> put cs
    put (XDTD de al)		= put (7::Word8) >> put de >> put al
    put (XAttr qn)		= put (8::Word8) >> put qn
    put (XError n e)		= put (9::Word8) >> put n  >> put e

    get				= do
                                  tag <- getWord8
                                  case tag of
                                    0 -> get >>= return . XText
                                    1 -> get >>= return . XCharRef
                                    2 -> get >>= return . XEntityRef
                                    3 -> get >>= return . XCmt
                                    4 -> get >>= return . XCdata
                                    5 -> do
                                         qn <- get
                                         get >>= return . XPi qn
                                    6 -> do
                                         qn <- get
                                         get >>= return . XTag qn
                                    7 -> do
                                         de <- get
                                         get >>= return . XDTD de
                                    8 -> get >>= return . XAttr
                                    9 -> do
                                         n <- get
                                         get >>= return . XError n
                                    _ -> error "XNode.get: error while decoding XNode"

-- -----------------------------------------------------------------------------

dtdElems			:: [DTDElem]
dtdElems			= [ DOCTYPE
                                  , ELEMENT
                                  , CONTENT
                                  , ATTLIST
                                  , ENTITY
                                  , PENTITY
                                  , NOTATION
                                  , CONDSECT
                                  , NAME
                                  , PEREF
                                  ]

instance Binary DTDElem where
--  put de			= put ((toEnum . fromEnum $ de)::Word8)		-- DTDElem is not yet instance of Enum
    put	de			= let
                                  i = fromJust . elemIndex de $ dtdElems
                                  in
                                  put ((toEnum i)::Word8)

    get				= do
                                  tag <- getWord8
                                  return $ dtdElems !! (fromEnum tag)
--				  return . toEnum . fromEnum $ tag		-- see above

-- -----------------------------------------------------------------------------

instance Binary QName where
    put qn		= let
                          px = namePrefix   qn
                          lp = localPart    qn
                          ns = namespaceUri qn
                          in
                          put px >> put lp >> put ns
    get			= do
                          px <- get
                          lp <- get
                          ns <- get
                          return $ mkQName px lp ns

-- -----------------------------------------------------------------------------