hexpat-pickle 0.5 → 0.6

raw patch · 5 files changed

+12/−164 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Text.XML.Expat.Pickle: gxFromCStringLen :: GenericXMLString s => CStringLen -> IO s

+ Text.XML.Expat.Pickle: gxFromByteString :: GenericXMLString s => ByteString -> s

Files

Text/XML/Expat/Pickle.hs +2/−2
hexpat-pickle.cabal +5/−4
test/test.hs +0/−151
test/test.xml +0/−2
test/tests.hs +5/−5

Text/XML/Expat/Pickle.hs view

@@ -224,7 +224,7 @@              PU (Node tag text) a           -> a           -> BL.ByteString -pickleXML pu value = formatTree $ pickleTree pu value+pickleXML pu value = format $ pickleTree pu value  -- | A helper that combines 'pickleTree' with 'formatXML' to pickle to an -- XML document. Strict variant returning strict ByteString.@@ -232,7 +232,7 @@               PU (Node tag text) a            -> a            -> B.ByteString -pickleXML' pu value = formatTree' $ pickleTree pu value+pickleXML' pu value = format' $ pickleTree pu value  -- | A helper that combines 'parseXML' with 'unpickleTree' to unpickle from an -- XML document - lazy version.   In the event of an error, it throws either

hexpat-pickle.cabal view

@@ -1,6 +1,6 @@-Cabal-Version: >= 1.2+Cabal-Version: >= 1.6 Name: hexpat-pickle-Version: 0.5+Version: 0.6 Synopsis: XML picklers based on hexpat, source-code-similar to those of the HXT package Description:   A library of combinators that allows Haskell data structures to be pickled@@ -25,13 +25,14 @@ Homepage: http://code.haskell.org/hexpat-pickle/ Extra-Source-Files:   test/tests.hs,-  test/test.hs,-  test/test.xml,   test/example.hs,   test/lazyUnpickle.hs,   test/lazyUnpickleThrow.hs Build-Type: Simple Stability: beta+source-repository head+    type:     darcs+    location: http://code.haskell.org/hexpat-pickle/  Library   Build-Depends:

− test/test.hs

@@ -1,151 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}--import Text.XML.Expat.Tree-import Text.XML.Expat.Pickle-import Text.XML.Expat.Format-import Data.Tree-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L-import Data.ByteString.Internal (w2c, c2w)-import Control.Monad-import Data.Maybe-import Data.Either-import Data.List-import Data.Char-import Debug.Trace-import Data.Time.Clock-import Numeric-import System.IO-import Data.Monoid--class Key k where-    keyValue :: k -> String--class Key k => LanguageKey k where-    isoOf :: k -> String-    makeLanguageKey :: String -> k--data MnemonicKey = MnemonicKey String-    deriving Show--instance Key MnemonicKey where-    keyValue (MnemonicKey str) = str--data LanguageKey k => MultiText k = MultiText {-        lang         :: k,-        languageText :: String,-        timestamp    :: Integer-    }-    deriving (Eq, Show)--instance LanguageKey k => XmlPickler (UNodes String) (MultiText k) where-    xpickle = xpMultiText "text"--data SiteLanguageKey = SiteLanguageKey String-    deriving Show--instance Key SiteLanguageKey where-    keyValue (SiteLanguageKey a) = a--instance LanguageKey SiteLanguageKey where-    isoOf = keyValue-    makeLanguageKey str = SiteLanguageKey str--maybeRead :: Read a => String -> Maybe a-maybeRead s = case reads s of-    [(x, "")] -> Just x-    _         -> Nothing--xpMultiText :: LanguageKey k => String -> PU (UNodes String) (MultiText k)-xpMultiText tagName =-    xpWrap (-        (\((lan, tex1, tim), tex2) -> MultiText-            (makeLanguageKey lan)-            (if tex2 /= "" then tex2 else fromMaybe "" tex1)-            (truncate $ fromMaybe 0 ((maybeRead (fromMaybe "0" tim))::Maybe Float))),-        (\(MultiText lan tex tim) -> ((isoOf lan, Nothing, Just $ show tim), tex))-    ) $-    xpElem tagName-        (xpTriple-            (xpAttr "lang" xpText0)-            (xpOption $ xpAttr "text" xpText0)-            (xpOption $ xpAttr "time" xpText0))-        (xpContent xpText0)--data LanguageKey k => MultiLanguage k = MultiLanguage {-        texts :: [MultiText k]-    }-    deriving (Eq, Show)--nullMultiLanguage :: LanguageKey k => MultiLanguage k-nullMultiLanguage = MultiLanguage []--instance XmlPickler (UNodes String) (MultiLanguage SiteLanguageKey) where-    xpickle = xpMultiLanguage "text"--xpMultiLanguage :: LanguageKey k => String -> PU (UNodes String) (MultiLanguage k)-xpMultiLanguage childTagName =-    xpWrap (-        (\ts -> MultiLanguage ts),-        (\(MultiLanguage ts) -> ts)-    ) $-    xpList (xpMultiText childTagName)--data Mnemonic = Mnemonic {-        mnemonicKey   :: MnemonicKey,-        category      :: String,-        comment       :: String,-        multiLanguage :: MultiLanguage SiteLanguageKey,-        linkTo        :: Maybe MnemonicKey-    }-    deriving (Show)--instance XmlPickler (UNodes String) Mnemonic where-    xpickle = xpMnemonic--xpMnemonic :: PU (UNodes String) Mnemonic-xpMnemonic =-    xpWrap (-        (\((mne, cat, com, lin), tex) ->-            Mnemonic (MnemonicKey mne) cat (fromMaybe "" com) tex-                (liftM (MnemonicKey . ("category."++)) lin)),-        (\(Mnemonic (MnemonicKey mne) cat com tex lin) ->-            ((mne, cat, if com == "" then Nothing else Just com,-                liftM ((fromMaybe "" . stripPrefix "category.") . keyValue) lin), tex))-    ) $-    xpElem "mnemonic"-        (xp4Tuple-            (xpAttr "name" xpText0)-            (xpAttr "category" xpText0)-            (xpOption $ xpAttr "comment" $ xpText0)-            (xpOption $ xpAttr "link" $ xpText))-        (xpMultiLanguage "text")--main_tree doc = do-  start <- getCurrentTime-  let pickler = xpRoot $ xpElemNodes "mnemonics" $ xpList xpMnemonic-  case unpickleXML' defaultParserOptions pickler doc of-      Right mnems -> do-          let xml = mconcat . L.toChunks $ pickleXML pickler mnems `mappend` L.pack (map c2w "\n")-          if xml == doc-              then do-                  let mnems = unpickleXML defaultParserOptions pickler $ L.fromChunks [doc]-                      xml = mconcat . L.toChunks $ pickleXML pickler mnems `mappend` L.pack (map c2w "\n")-                  if xml == doc-                      then do-                          end <- getCurrentTime-                          let took = end `diffUTCTime` start-                          hPutStrLn stderr $ "passed"-                          hPutStrLn stderr $ "took "++showFFloat (Just 3) (realToFrac took) ""++" sec"-                      else do-                          hPutStrLn stderr $ "Failed test 2 - mismatch:"-                          B.putStr xml-              else do-                  hPutStrLn stderr $ "Failed test 1 - mismatch:"-                  B.putStr xml-      Left error -> do-          hPutStrLn stderr $ "FAILED: "++error--main = do-  xml <- B.readFile "test.xml"-  main_tree xml

− test/test.xml

@@ -1,2 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<mnemonics><mnemonic name="geo.BD" category="geo"><text lang="" time="0">Gana Prajatantri Bangladesh</text><text lang="scn" time="0">Bangladesci</text><text lang="gd" time="0">Bangladesh</text><text lang="ga" time="0">An Bhanglaidéis</text><text lang="gl" time="0">Bangladesh - বাংলাদেশ</text><text lang="la" time="0">Bangladesia</text><text lang="lo" time="0">ບັງກະລາເທດ</text><text lang="tr" time="0">Bangladeş</text><text lang="li" time="0">Bangladesj</text><text lang="lv" time="0">Bangladeša</text><text lang="lt" time="0">Bangladešas</text><text lang="th" time="0">บังคลาเทศ</text><text lang="tg" time="0">Бангладеш</text><text lang="te" time="0">బంగ్లాదేశ్</text><text lang="ta" time="0">பங்களாதேஷ்</text><text lang="de" time="0">Bangladesch</text><text lang="da" time="0">Bangladesh</text><text lang="dz" time="0">བངྒ་ལ་དེཤ</text><text lang="qu" time="0">Bangladesh</text><text lang="kn" time="0">ಬಾಂಗ್ಲಾದೇಶ</text><text lang="bpy" time="0">বাংলাদেশ</text><text lang="el" time="0">Μπανγκλαντές</text><text lang="eo" time="0">Bangladeŝo</text><text lang="en" time="0">Bangladesh</text><text lang="zh" time="0">孟加拉国</text><text lang="eu" time="0">Bangladesh</text><text lang="et" time="0">Bangladesh</text><text lang="es" time="0">Bangladesh</text><text lang="ru" time="0">Бангладеш</text><text lang="ro" time="0">Bangladesh</text><text lang="be" time="0">Бангладэш</text><text lang="bg" time="0">Бангладеш</text><text lang="ms" time="0">Bangladesh</text><text lang="ast" time="0">Bangladesh</text><text lang="bn" time="0">Gonaoprojatontri Bangladesh</text><text lang="bs" time="0">Bangladeš</text><text lang="ja" time="0">バングラデシュ</text><text lang="oc" time="0">Bangladèsh</text><text lang="nds" time="0">Bangladesch</text><text lang="os" time="0">Бангладеш</text><text lang="ca" time="0">Bangla Desh</text><text lang="cy" time="0">Bangladesh</text><text lang="cs" time="0">Bangladéš</text><text lang="ps" time="0">بنګله‌دیش</text><text lang="pt" time="0">Bangladesh</text><text lang="tl" time="0">Bangladesh</text><text lang="pl" time="0">Bangladesz</text><text lang="hy" time="0">Բանգլադեշ</text><text lang="hr" time="0">Bangladeš</text><text lang="ht" time="0">Bangladèch</text><text lang="hu" time="0">Banglades</text><text lang="hi" time="0">बंगलादेश</text><text lang="he" time="0">בנגלאדש</text><text lang="fur" time="0">Bangladesh</text><text lang="ml" time="0">ബംഗ്ലാദേശ്</text><text lang="mk" time="0">Бангладеш</text><text lang="ur" time="0">بنگلہ دیش</text><text lang="mt" time="0">Bangladexx</text><text lang="uk" time="0">Бангладеш</text><text lang="mr" time="0">बांगलादेश</text><text lang="ug" time="0">بېنگلا</text><text lang="af" time="0">Bangladesj</text><text lang="vi" time="0">Bangladesh</text><text lang="is" time="0">Bangladess</text><text lang="am" time="0">ባንግላዲሽ</text><text lang="it" time="0">Bangladesh</text><text lang="an" time="0">Bangladesh</text><text lang="ar" time="0">بنغلاديش</text><text lang="io" time="0">Bangladesh</text><text lang="ia" time="0">Bangladesh</text><text lang="id" time="0">Bangladesh</text><text lang="ks" time="0">बंगलादेश</text><text lang="nl" time="0">Bangladesh</text><text lang="nn" time="0">Bangladesh</text><text lang="no" time="0">Bangladesh</text><text lang="na" time="0">Bangladesh</text><text lang="nb" time="0">Bangladesh</text><text lang="so" time="0">Bangaala-Deesh</text><text lang="pam" time="0">Bangladesh</text><text lang="fr" time="0">Bangladesh</text><text lang="fy" time="0">Banglades</text><text lang="fa" time="0">بنگلادش</text><text lang="fi" time="0">Bangladesh</text><text lang="fo" time="0">Bangladesj</text><text lang="ka" time="0">ბანგლადეში</text><text lang="sr" time="0">Бангладеш</text><text lang="sq" time="0">Bangladeshi</text><text lang="ko" time="0">방글라데시</text><text lang="sv" time="0">Bangladesh</text><text lang="km" time="0">បង់ក្លាដេស្ហ</text><text lang="sk" time="0">Bangladéš</text><text lang="sh" time="0">Bangladeš</text><text lang="kw" time="0">Bangladesh</text><text lang="ku" time="0">Bangladeş</text><text lang="sl" time="0">Bangladeš</text><text lang="se" time="0">Bangladesh</text></mnemonic><mnemonic name="geo.BE" category="geo"><text lang="" time="0">Belgien</text><text lang="gv" time="0">Yn Velg</text><text lang="zea" time="0">België</text><text lang="scn" time="0">Belgiu</text><text lang="ga" time="0">An Bheilg</text><text lang="gl" time="0">Bélxica - België</text><text lang="nov" time="0">Belgia</text><text lang="lb" time="0">Belsch</text><text lang="la" time="0">Belgia</text><text lang="ln" time="0">Bɛ́ljika</text><text lang="lo" time="0">ເບວຢຽມ</text><text lang="tr" time="0">Belçika</text><text lang="li" time="0">Belsj</text><text lang="lv" time="0">Beļģija</text><text lang="tl" time="0">Belhika</text><text lang="th" time="0">เบลเยียม</text><text lang="tg" time="0">Белгия</text><text lang="ta" time="0">பெல்ஜியம்</text><text lang="de" time="0">Belgien</text><text lang="da" time="0">Belgien</text><text lang="dz" time="0">བེལ་ཇིཡམ</text><text lang="bar" time="0">Belgien</text><text lang="vls" time="0">Belgje</text><text lang="qu" time="0">Bilgasuyu</text><text lang="gd" time="0">A&apos; Bheilg</text><text lang="el" time="0">Βέλγιο</text><text lang="eo" time="0">Belgujo</text><text lang="en" time="0">Belgium</text><text lang="zh" time="0">比利时</text><text lang="pms" time="0">Belgio</text><text lang="arc" time="0">ܒܠܓܝܟܐ</text><text lang="eu" time="0">Belgika</text><text lang="et" time="0">Belgia</text><text lang="tet" time="0">Béljika</text><text lang="es" time="0">Bélgica</text><text lang="ru" time="0">Бельгия</text><text lang="rm" time="0">Belgia</text><text lang="ro" time="0">Belgia</text><text lang="bn" time="0">বেল্জিয়ম</text><text lang="hsb" time="0">Belgiska</text><text lang="be" time="0">Бэльгія</text><text lang="bg" time="0">Белгия</text><text lang="uk" time="0">Бельгія</text><text lang="wa" time="0">Beldjike</text><text lang="ast" time="0">Bélxica</text><text lang="jv" time="0">Belgia</text><text lang="bo" time="0">པེར་ཅིན</text><text lang="br" time="0">Belgia</text><text lang="bs" time="0">Belgija</text><text lang="ja" time="0">ベルギー</text><text lang="ilo" time="0">Belgium</text><text lang="oc" time="0">Belgica</text><text lang="nds" time="0">Belgien</text><text lang="os" time="0">Бельги</text><text lang="ca" time="0">Bèlgica</text><text lang="cy" time="0">Gwlad Belg</text><text lang="cs" time="0">Belgie</text><text lang="cv" time="0">Бельги</text><text lang="ps" time="0">بلجيم</text><text lang="pt" time="0">Bélgica</text><text lang="lt" time="0">Belgija</text><text lang="frp" time="0">Bèlg·ique</text><text lang="vi" time="0">Bỉ</text><text lang="war" time="0">Belhika</text><text lang="pl" time="0">Belgia</text><text lang="hy" time="0">Բելգիա</text><text lang="nrm" time="0">Belgique</text><text lang="hr" time="0">Belgija</text><text lang="ht" time="0">Bèljik</text><text lang="hu" time="0">Belgium</text><text lang="hi" time="0">बेल्जियम</text><text lang="he" time="0">בלגיה</text><text lang="fur" time="0">Belgjo</text><text lang="mk" time="0">Белгија</text><text lang="mt" time="0">Belġju</text><text lang="ms" time="0">Belgium</text><text lang="mr" time="0">बेल्जियम</text><text lang="ang" time="0">Belgium</text><text lang="af" time="0">België</text><text lang="ko" time="0">벨기에</text><text lang="is" time="0">Belgía</text><text lang="am" time="0">ቤልጄም</text><text lang="it" time="0">Belgio</text><text lang="an" time="0">Belchica</text><text lang="ar" time="0">بلجيكا</text><text lang="km" time="0">បែលហ្ស៉ិក</text><text lang="io" time="0">Belgia</text><text lang="ia" time="0">Belgica</text><text lang="id" time="0">Belgia</text><text lang="nl" time="0">Koninkrijk België</text><text lang="nn" time="0">Belgia</text><text lang="no" time="0">Belgia</text><text lang="na" time="0">Belgium</text><text lang="nb" time="0">Belgia</text><text lang="ne" time="0">बेल्जियम</text><text lang="so" time="0">Beljiyam</text><text lang="pam" time="0">Belgium</text><text lang="fr" time="0">Belgique</text><text lang="fy" time="0">Belgje</text><text lang="fa" time="0">بلژیک</text><text lang="fi" time="0">Belgia</text><text lang="fo" time="0">Belgia</text><text lang="ka" time="0">ბელგია</text><text lang="sr" time="0">Белгија</text><text lang="sq" time="0">Belgjikë</text><text lang="sw" time="0">Ubelgiji</text><text lang="sv" time="0">Belgien</text><text lang="tpi" time="0">Belsum</text><text lang="sk" time="0">Belgicko</text><text lang="sh" time="0">Belgija</text><text lang="kw" time="0">Pow Belg</text><text lang="ku" time="0">Belçîka</text><text lang="sl" time="0">Belgija</text><text lang="jbo" time="0">gugdrbelgi</text><text lang="sa" time="0">बेल्जियम</text><text lang="se" time="0">Belgia</text></mnemonic></mnemonics>

test/tests.hs view

@@ -3,7 +3,7 @@ import Text.XML.Expat.Tree import Text.XML.Expat.Format import Control.Exception.Extensible as E-import Control.Parallel.Strategies+import Control.DeepSeq import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as B import Data.ByteString.Internal (c2w)@@ -13,16 +13,16 @@ -- | Tests where input and XML output differ u2 :: (NFData a, Eq a, Show a) => String -> String -> String -> Either String a -> PU [UNode String] a -> IO () u2 title inXML chkXML inEVal inPU = do-    let inTree = parseThrowing (defaultParseOptions { defaultEncoding = Just UTF8 }) (L.pack $ map c2w inXML)-        inTreeXML = formatTree' inTree+    let inTree = parseThrowing (defaultParseOptions { overrideEncoding = Just UTF8 }) (L.pack $ map c2w inXML)+        inTreeXML = format' inTree         eVal = unpickleTree' (xpRoot inPU) inTree     assertEqual (title++" - strict unpickle") inEVal eVal     case eVal of         Right val -> do             -- Make sure that the lazy unpickler gives the same result             assertEqual (title++" - lazy unpickle") val (unpickleTree (xpRoot inPU) inTree)-            let chkTree = parseThrowing (defaultParseOptions { defaultEncoding = Just UTF8 }) (L.pack $ map c2w chkXML) :: UNode String-                chkTreeXML = formatTree' chkTree+            let chkTree = parseThrowing (defaultParseOptions { overrideEncoding = Just UTF8 }) (L.pack $ map c2w chkXML) :: UNode String+                chkTreeXML = format' chkTree                 outXML = pickleXML' (xpRoot inPU) val             assertEqual (title++" - pickle") chkTreeXML outXML         Left err ->