roundtrip-xml 0.3.0.0 → 0.3.0.1

raw patch · 3 files changed

+68/−3 lines, 3 files

Files

• roundtrip-xml.cabal +1/−1
• src/Text/Roundtrip/Xml/Printer.hs +1/−1
• tests/Tests.hs +66/−1

@@ -1,5 +1,5 @@ Name:           roundtrip-xml-Version:        0.3.0.0+Version:        0.3.0.1 Synopsis:       Bidirectional (de-)serialization for XML. Description:    Roundtrip allows the definition of bidirectional                 (de-)serialization specifications. This package provides

@@ -115,7 +115,7 @@             XmlTypesEvent ev : rest -> ev : convEvents rest             PxBeginElement name : rest ->                 let (attrs, nonAttrs) = convAttrs rest-                in EventBeginElement name attrs : convEvents rest+                in EventBeginElement name attrs : convEvents nonAttrs             attr@(PxAttribute _ _) : _ -> error $ "unexpected " ++ show attr       convAttrs :: [PxEvent] -> ([(Name, [Content])], [PxEvent])       convAttrs pxes =

@@ -1,9 +1,11 @@ {-# OPTIONS_GHC -F -pgmF htfpp #-}-{-# LANGUAGE OverloadedStrings, RankNTypes #-}+{-# LANGUAGE OverloadedStrings, RankNTypes, TemplateHaskell #-}  import Control.Exception (throw) import System.Environment (getArgs) import System.FilePath+import Control.Monad (liftM2)+import Data.Maybe (isJust, fromJust)  import qualified Data.ByteString as BS @@ -23,6 +25,69 @@ import Text.XML.Enumerator.Parse (parseBytes, decodeEntities)  import Test.Framework++--+-- Specification for expressions+--++data Expr = Var String+          | Lit Int+          | Plus Expr Expr+            deriving (Show, Eq)++$(defineIsomorphisms ''Expr)++xmlVariable :: XmlSyntax d => d String+xmlVariable = xmlElem "var" (xmlAttr "name" textStringIso)++xmlInteger :: XmlSyntax d => d Int+xmlInteger = xmlElem "lit" (xmlAttr "value" readShowTextIso)++pXmlExpr :: XmlSyntax d => d Expr+pXmlExpr = var  <$> xmlVariable+       <|> lit  <$> xmlInteger+       <|> plus <$> xmlElem "plus" (pXmlExpr <*> pXmlExpr)++instance Arbitrary Expr where+    arbitrary = sized arbExpr+        where arbExpr 0 = frequency simpleExprs+              arbExpr n = frequency (simpleExprs +++                                     [(5, liftM2 Plus (arbExpr (n `div` 2))+                                                      (arbExpr (n `div` 2)))])+              simpleExprs = [(1, do n <- arbitrary+                                    return (Lit n)),+                             (1, do v <- elements letters+                                    vs <- listOf (elements lettersOrDigits)+                                    return (Var (v:vs)))]+              letters = ['a'..'z'] ++ ['A'..'Z']+              lettersOrDigits = letters ++ ['0'..'9']+    shrink (Var _) = []+    shrink (Lit _) = []+    shrink (Plus e1 e2) = [e1, e2]++test_exprParser :: IO ()+test_exprParser =+    do let epe = runXmlParserString pXmlExpr "<string>" defaultEntityRenderer+                   "<plus><lit value=\"1\"/><plus><var name=\"foo\"/><lit value=\"2\"/></plus></plus>"+       pe <- assertRight epe+       assertEqual (Plus (Lit 1) (Plus (Var "foo") (Lit 2))) pe++test_exprPrinter :: IO ()+test_exprPrinter =+    do let ms = runXmlPrinterString pXmlExpr (Plus (Lit 1) (Plus (Var "foo") (Lit 2)))+       s <- assertJust ms+       assertEqual "<plus><lit value=\"1\"/><plus><var name=\"foo\"/><lit value=\"2\"/></plus></plus>" s++prop_exprPrinterDoesNotFail :: Expr -> Bool+prop_exprPrinterDoesNotFail expr = isJust (runXmlPrinterString pXmlExpr expr)++prop_exprPrinterParserInverse :: Expr -> Bool+prop_exprPrinterParserInverse expr =+    let code = fromJust (runXmlPrinterString pXmlExpr expr)+    in case runXmlParserString pXmlExpr "<string>" defaultEntityRenderer code of+         Left err -> error (show err)+         Right expr' -> expr == expr'+  -- -- Parsing, invalid lookahead, David, 2011-07-23