hxt-binary (empty) → 0.0.1
raw patch · 9 files changed
+359/−0 lines, 9 filesdep +basedep +binarydep +bytestringsetup-changed
Dependencies added: base, binary, bytestring, bzlib, haskell98, hxt
Files
- LICENCE +9/−0
- Setup.lhs +8/−0
- hxt-binary.cabal +35/−0
- src/Data/Tree/NTree/Binary.hs +34/−0
- src/Text/XML/HXT/Arrow/Binary.hs +71/−0
- src/Text/XML/HXT/DOM/Binary.hs +109/−0
- test/Makefile +14/−0
- test/TestXmlTreeBinary.hs +57/−0
- test/t.xml +22/−0
+ LICENCE view
@@ -0,0 +1,9 @@+The MIT License++Copyright (c) 2005 Uwe Schmidt, Martin Schmidt, Torben Kuseler++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.lhs view
@@ -0,0 +1,8 @@+#!/usr/bin/runhaskell++> module Main where++> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ hxt-binary.cabal view
@@ -0,0 +1,35 @@+name: hxt-binary+version: 0.0.1+license: OtherLicense+license-file: LICENCE+maintainer: Uwe Schmidt <uwe@fh-wedel.de>+stability: experimental+category: XML+synopsis: Serialisation and deserialisation of HXT XmlTrees.+description: Extension for storing and loading already parsed XML documents in an internal format.+ Serialisation and Deserialisation is done with the binary package.+homepage: http://www.fh-wedel.de/~si/HXmlToolbox/index.html+copyright: Copyright (c) 2009 Uwe Schmidt+build-type: Simple+cabal-version: >=1.6++extra-source-files:+ test/TestXmlTreeBinary.hs+ test/t.xml+ test/Makefile++library+ exposed-modules:+ Text.XML.HXT.Arrow.Binary+ Text.XML.HXT.DOM.Binary+ Data.Tree.NTree.Binary++ hs-source-dirs: src+ ghc-options: -Wall++ build-depends: base >= 4 && < 5,+ haskell98 >= 1 && < 2,+ bytestring >= 0.9 && < 1,+ binary >= 0.5 && < 1,+ bzlib >= 0.5 && < 1,+ hxt >= 8.2 && < 9
+ src/Data/Tree/NTree/Binary.hs view
@@ -0,0 +1,34 @@+{-# OPTIONS -fno-warn-orphans #-}++-- ------------------------------------------------------------++{- |+ Module : Data.Tree.NTree.Binary+ Copyright : Copyright (C) 2009 Uwe Schmidt+ License : MIT++ Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)+ Stability : experimental+ Portability: portable++ De-/Serialisation for NTrees++-}++-- ------------------------------------------------------------++module Data.Tree.NTree.Binary+where+++import Data.Binary+import Data.Tree.NTree.TypeDefs++instance (Binary a) => Binary (NTree a) where+ put (NTree n cs) = put n >> put cs+ get = do+ n <- get+ cs <- get+ return (NTree n cs)++-- ------------------------------------------------------------
+ src/Text/XML/HXT/Arrow/Binary.hs view
@@ -0,0 +1,71 @@+-- ------------------------------------------------------------++{- |+ Module : Text.XML.HXT.Arrow.Binary+ Copyright : Copyright (C) 2008 Uwe Schmidt+ License : MIT++ Maintainer : Uwe Schmidt (uwe@fh-wedel.de)+ Stability : experimental+ Portability: portable++ De-/Serialisation arrows for XmlTrees and other arbitrary values with a Binary instance+-}++-- ------------------------------------------------------------++module Text.XML.HXT.Arrow.Binary+ ( readBinaryValue+ , writeBinaryValue+ )+where++import Control.Exception ( SomeException+ , try+ )+import Codec.Compression.BZip ( compress+ , decompress+ )+import Data.Binary+import qualified Data.ByteString.Lazy as B+ +import Text.XML.HXT.Arrow++-- ------------------------------------------------------------++-- | Read a serialied value from a file. The the flag indicates uncompressing.+-- In case of an error, the error message is issued and the arrow fails++readBinaryValue :: (Binary a) => Bool -> String -> IOStateArrow s b a+readBinaryValue c f = arrIO (\ _ -> try' $ dec c)+ >>>+ issueExc "readBinaryValue"+ where+ dec False = decodeFile f+ dec True = B.readFile f >>= return . decode . decompress++-- | Serialize a value, optionally compress it, and write it to a file.+-- In case of an error, the error message is issued and the arrow fails++writeBinaryValue :: (Binary a) => Bool -> String -> IOStateArrow s a ()+writeBinaryValue c f = arrIO (\ x -> try' $ enc c x)+ >>>+ issueExc "writeBinaryXmlTree"+ where+ enc False = encodeFile f+ enc True = B.writeFile f . compress . encode+++issueExc :: String -> IOStateArrow s (Either SomeException a) a+issueExc s = ( ( issueFatal $< arr ((("Exception in " ++ s ++ ": ") ++) . show)+ >>>+ none+ )+ |||+ this+ )++try' :: IO a -> IO (Either SomeException a)+try' = try+ +-- ------------------------------------------------------------
+ src/Text/XML/HXT/DOM/Binary.hs view
@@ -0,0 +1,109 @@+{-# 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++-- -----------------------------------------------------------------------------
+ test/Makefile view
@@ -0,0 +1,14 @@+PROG = TestXmlTreeBinary++all : $(PROG)++$(PROG) : $(PROG).hs+ ghc --make -i../src -o $(PROG) $(PROG).hs++test : $(PROG)+ ./$(PROG)++clean :+ rm -f *.o *.hi t.bin t.bin.bz $(PROG)++
+ test/TestXmlTreeBinary.hs view
@@ -0,0 +1,57 @@+-- ------------------------------------------------------------++module Main -- TestXmlTreeBinary+where++import Text.XML.HXT.DOM.Binary -- the Binary instance for XmlTree++import Text.XML.HXT.Arrow+import Text.XML.HXT.Arrow.Binary++-- ------------------------------------------------------------++main :: IO ()+main = do+ runX ( readDocument [] "t.xml"+ >>>+ withTraceLevel 4 (traceDoc "file t.xml read")+ >>>+ ( this+ &&&+ ( traceMsg 0 "writing file t.bin and t.bin.bz"+ >>>+ ( writeBinaryValue False "t.bin"+ &&&+ writeBinaryValue True "t.bin.bz"+ )+ >>>+ traceMsg 0 "files written, reading t.bin and t.bin.bz"+ >>>+ ( readBinaryValue False "t.bin"+ &&&+ readBinaryValue True "t.bin.bz"+ )+ >>>+ withTraceLevel 4 ( (perform $ arr fst >>> traceDoc "contents of binary file")+ >>>+ (perform $ arr snd >>> traceDoc "contents of compressed binary file")+ )+ )+ )+ >>>+ traceMsg 0 "comparing documents"+ >>>+ ( ( isA (\ (i, (o1, o2)) -> i == o1 && i == o2)+ >>>+ traceMsg 0 "test passed: documents are equal"+ )+ `orElse`+ ( traceMsg 0 "test failed: documents differ"+ >>>+ none+ )+ )+ )+ return ()++-- ------------------------------------------------------------
+ test/t.xml view
@@ -0,0 +1,22 @@+<?xml version="1.0" encoding="ISO-8859-1" ?>++<!DOCTYPE a [+<!ATTLIST a att1 NMTOKENS #IMPLIED+ att2 ID #REQUIRED>+<!ATTLIST b btt2 ID #REQUIRED+ btt3 IDREF #REQUIRED>+<!ELEMENT a (b, cü?)>+<!ELEMENT b EMPTY>+<!ELEMENT cü (#PCDATA)>+]>++<?pi a processing instruction?>++<a att1=" test+ äöüß+ test "+ att2="root"+>+ <b btt2="b1" btt3="root"/>+ <cü>hello world äöüß test</cü>+</a>