import Test.HUnit hiding (Node)
import Text.XML.Expat.Pickle
import Text.XML.Expat.Tree
import Text.XML.Expat.Format
import Control.Exception.Extensible as E
import Control.Parallel.Strategies
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString as B
import Data.ByteString.Internal (c2w)
import qualified Data.Map as M
import Control.Arrow
-- | Tests where input and XML output differ
u2 :: (NFData a, Eq a, Show a) => String -> String -> String -> Either String a -> PU (UNodes String) a -> IO ()
u2 title inXML chkXML inEVal inPU = do
let inTree = parseTreeThrowing (Just UTF8) (L.pack $ map c2w inXML)
inTreeXML = formatTree' 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 = parseTreeThrowing (Just UTF8) (L.pack $ map c2w chkXML) :: UNode String
chkTreeXML = formatTree' chkTree
outXML = pickleXML' (xpRoot inPU) val
assertEqual (title++" - pickle") chkTreeXML outXML
Left err ->
-- Make sure that the lazy unpickler also fails, but we don't care
-- what the message is (it won't be the same)
E.catch (do
let val2 = unpickleTree (xpRoot inPU) inTree
rnf val2 `seq`
assertFailure $ title++" - lazy unpickle didn't throw expected exception ("++err++")"
) (\exc -> return (exc::SomeException) >> return ())
-- | Tests where input and output XML are the same
u title inXML inEVal inPU = u2 title inXML inXML inEVal inPU
main = runTestTT $ TestList $ map TestCase $ [
u "xpUnit"
"<top/>" (Right ()) $ xpElemNodes "top" xpUnit,
u "xpUnit"
"<top/>"
(Left "in <top>, got xpZero" :: Either String ()) $
xpElemNodes "top" xpZero,
u "xpLift"
"<top/>" (Right "banana") $ xpElemNodes "top" $ xpLift "banana",
u "xpElem"
"<top><fruit>apple</fruit><pet>cat</pet></top>"
(Right ("apple","cat")) $
xpElemNodes "top" $
xpPair
(xpElemNodes "fruit" $ xpContent xpText)
(xpElemNodes "pet" $ xpContent xpText),
u2 "xpElem - with elements out of order"
"<top><fruit>apple</fruit><pet>cat</pet></top>"
"<top><pet>cat</pet><fruit>apple</fruit></top>"
(Right ("cat","apple")) $
xpElemNodes "top" $
xpPair
(xpElemNodes "pet" $ xpContent xpText)
(xpElemNodes "fruit" $ xpContent xpText),
u2 "xpElem - Check ignoring of extra elements"
"<top><vegetable>onion</vegetable><fruit>apple</fruit><furniture>chair</furniture><pet>cat</pet></top>"
"<top><fruit>apple</fruit><pet>cat</pet></top>"
(Right ("apple","cat")) $
xpElemNodes "top" $
xpPair
(xpElemNodes "fruit" $ xpContent xpText)
(xpElemNodes "pet" $ xpContent xpText),
u2 "xpElem - Check ignoring of extra text"
"<top>Onion<fruit>apple</fruit><furniture>chair</furniture>Chair<pet>cat</pet></top>"
"<top><fruit>apple</fruit><pet>cat</pet></top>"
(Right ("apple","cat")) $
xpElemNodes "top" $
xpPair
(xpElemNodes "fruit" $ xpContent xpText)
(xpElemNodes "pet" $ xpContent xpText),
u "xpElem - check missing element"
"<top><fruit>apple</fruit></top>"
(Left "in <top>, in 2nd of pair, can't find <pet>") $
xpElemNodes "top" $
xpPair
(xpElemNodes "fruit" $ xpContent xpText)
(xpElemNodes "pet" $ xpContent xpText),
u "xpAttr"
"<top fruit=\"apple\" pet=\"cat\"/>"
(Right ("apple", "cat")) $
xpElemAttrs "top" $
xpPair
(xpAttr "fruit" xpText0)
(xpAttr "pet" xpText),
u2 "xpAttr - Attributes out of order"
"<top pet=\"cat\" fruit=\"apple\"/>"
"<top fruit=\"apple\" pet=\"cat\"/>"
(Right ("apple", "cat")) $
xpElemAttrs "top" $
xpPair
(xpAttr "fruit" xpText0)
(xpAttr "pet" xpText),
u2 "xpAttr - Ignore extra attributes"
"<top pet=\"cat\" furniture=\"chair\" fruit=\"apple\"/>"
"<top fruit=\"apple\" pet=\"cat\"/>"
(Right ("apple", "cat")) $
xpElemAttrs "top" $
xpPair
(xpAttr "fruit" xpText0)
(xpAttr "pet" xpText),
u "xpAttr - Missing attribute"
"<top pet=\"cat\"/>"
(Left "in <top>, in 1st of pair, can't find attribute fruit") $
xpElemAttrs "top" $
xpPair
(xpAttr "fruit" xpText0)
(xpAttr "pet" xpText),
u "xpAttrImplied - Nothing value"
"<top/>"
(Right Nothing) $
xpElemAttrs "top" $
xpAttrImplied "missing" xpText0,
u "xpAttrImplied - Just value"
"<top missing=\"not missing\"/>"
(Right $ Just "not missing") $
xpElemAttrs "top" $
xpAttrImplied "missing" xpText0,
u "xpAttrFixed"
"<top fixed=\"horse\"/>"
(Right ()) $
xpElemAttrs "top" $
xpAttrFixed "fixed" "horse",
u "xpAttrFixed - missing attribute on unpickle"
"<top/>"
(Left "in <top>, can't find attribute fixed") $
xpElemAttrs "top" $
xpAttrFixed "fixed" "horse",
u "xpAddFixedAttr"
"<top fixed=\"horse\" unfixed=\"sheep\"/>"
(Right "sheep") $
xpElemAttrs "top" $
xpAddFixedAttr "fixed" "horse" $
xpAttr "unfixed" xpText0,
u "xpContent xpText0"
"<top>Shoe</top>"
(Right "Shoe") $
xpElemNodes "top" $ xpContent $ xpText0,
u "xpAttr .. xpText0"
"<top clothes=\"Shoe\"/>"
(Right "Shoe") $
xpElemAttrs "top" $ xpAttr "clothes" xpText0,
u "xpContent xpText0 - empty string"
"<top/>"
(Right "") $
xpElemNodes "top" $ xpContent $ xpText0,
u "xpAttr .. xpText0 - empty string"
"<top clothes=\"\"/>"
(Right "") $
xpElemAttrs "top" $ xpAttr "clothes" xpText0,
u "xpContent xpText"
"<top>Shoe</top>"
(Right "Shoe") $
xpElemNodes "top" $ xpContent $ xpText,
u "xpAttr .. xpText"
"<top clothes=\"Shoe\"/>"
(Right "Shoe") $
xpElemAttrs "top" $ xpAttr "clothes" xpText,
u "xpContent xpText - empty string"
"<top/>"
(Left "in <top>, empty text") $
xpElemNodes "top" $ xpContent $ xpText,
u "xpAttr .. xpText - empty string"
"<top clothes=\"\"/>"
(Left "in <top>, in attribute clothes, empty text") $
xpElemAttrs "top" $ xpAttr "clothes" xpText,
u "xpPrim"
"<top>1234</top>"
(Right 1234 :: Either String Int) $
xpElemNodes "top" $ xpContent $ xpPrim,
u "xpPrim"
"<top>1234!</top>"
(Left "in <top>, failed to read text: 1234!" :: Either String Int) $
xpElemNodes "top" $ xpContent $ xpPrim,
u "xpPair"
"<top><a>1</a><b>2</b></top>"
(Right (1,2) :: Either String (Int,Int)) $
xpElemNodes "top" $ xpPair
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpContent xpPrim),
u "xpPair - failure in 1st"
"<top><a>1</a><b>2</b></top>"
(Left "in <top>, in 1st of pair, in <a>, got xpZero" :: Either String (Int,Int)) $
xpElemNodes "top" $ xpPair
(xpElemNodes "a" $ xpZero)
(xpElemNodes "b" $ xpContent xpPrim),
u "xpPair - failure in 2nd"
"<top><a>1</a><b>2</b></top>"
(Left "in <top>, in 2nd of pair, in <b>, got xpZero" :: Either String (Int,Int)) $
xpElemNodes "top" $ xpPair
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpZero),
u "xpTriple"
"<top><a>1</a><b>2</b><c>3</c></top>"
(Right (1,2,3) :: Either String (Int,Int,Int)) $
xpElemNodes "top" $ xpTriple
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpContent xpPrim)
(xpElemNodes "c" $ xpContent xpPrim),
u "xpTriple - failure in 1st"
"<top><a>1</a><b>2</b><c>3</c></top>"
(Left "in <top>, in 1st of triple, in <a>, got xpZero" :: Either String (Int,Int,Int)) $
xpElemNodes "top" $ xpTriple
(xpElemNodes "a" $ xpZero)
(xpElemNodes "b" $ xpContent xpPrim)
(xpElemNodes "c" $ xpContent xpPrim),
u "xpTriple - failure in 2nd"
"<top><a>1</a><b>2</b><c>3</c></top>"
(Left "in <top>, in 2nd of triple, in <b>, got xpZero" :: Either String (Int,Int,Int)) $
xpElemNodes "top" $ xpTriple
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpZero)
(xpElemNodes "c" $ xpContent xpPrim),
u "xpTriple - failure in 3rd"
"<top><a>1</a><b>2</b><c>3</c></top>"
(Left "in <top>, in 3rd of triple, in <c>, got xpZero" :: Either String (Int,Int,Int)) $
xpElemNodes "top" $ xpTriple
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpContent xpPrim)
(xpElemNodes "c" $ xpZero),
u "xp4Tuple"
"<top><a>1</a><b>2</b><c>3</c><d>4</d></top>"
(Right (1,2,3,4) :: Either String (Int,Int,Int,Int)) $
xpElemNodes "top" $ xp4Tuple
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpContent xpPrim)
(xpElemNodes "c" $ xpContent xpPrim)
(xpElemNodes "d" $ xpContent xpPrim),
u "xp4Tuple - failure in 1st"
"<top><a>1</a><b>2</b><c>3</c><d>4</d></top>"
(Left "in <top>, in 1st of 4-tuple, in <a>, got xpZero" :: Either String (Int,Int,Int,Int)) $
xpElemNodes "top" $ xp4Tuple
(xpElemNodes "a" $ xpZero)
(xpElemNodes "b" $ xpContent xpPrim)
(xpElemNodes "c" $ xpContent xpPrim)
(xpElemNodes "d" $ xpContent xpPrim),
u "xp4Tuple - failure in 2nd"
"<top><a>1</a><b>2</b><c>3</c><d>4</d></top>"
(Left "in <top>, in 2nd of 4-tuple, in <b>, got xpZero" :: Either String (Int,Int,Int,Int)) $
xpElemNodes "top" $ xp4Tuple
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpZero)
(xpElemNodes "c" $ xpContent xpPrim)
(xpElemNodes "d" $ xpContent xpPrim),
u "xp4Tuple - failure in 3rd"
"<top><a>1</a><b>2</b><c>3</c><d>4</d></top>"
(Left "in <top>, in 3rd of 4-tuple, in <c>, got xpZero" :: Either String (Int,Int,Int,Int)) $
xpElemNodes "top" $ xp4Tuple
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpContent xpPrim)
(xpElemNodes "c" $ xpZero)
(xpElemNodes "d" $ xpContent xpPrim),
u "xp4Tuple - failure in 4th"
"<top><a>1</a><b>2</b><c>3</c><d>4</d></top>"
(Left "in <top>, in 4th of 4-tuple, in <d>, got xpZero" :: Either String (Int,Int,Int,Int)) $
xpElemNodes "top" $ xp4Tuple
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpContent xpPrim)
(xpElemNodes "c" $ xpContent xpPrim)
(xpElemNodes "d" $ xpZero),
u "xp5Tuple"
"<top><a>1</a><b>2</b><c>3</c><d>4</d><e>5</e></top>"
(Right (1,2,3,4,5) :: Either String (Int,Int,Int,Int,Int)) $
xpElemNodes "top" $ xp5Tuple
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpContent xpPrim)
(xpElemNodes "c" $ xpContent xpPrim)
(xpElemNodes "d" $ xpContent xpPrim)
(xpElemNodes "e" $ xpContent xpPrim),
u "xp5Tuple - failure in 1st"
"<top><a>1</a><b>2</b><c>3</c><d>4</d><e>5</e></top>"
(Left "in <top>, in 1st of 5-tuple, in <a>, got xpZero" :: Either String (Int,Int,Int,Int,Int)) $
xpElemNodes "top" $ xp5Tuple
(xpElemNodes "a" $ xpZero)
(xpElemNodes "b" $ xpContent xpPrim)
(xpElemNodes "c" $ xpContent xpPrim)
(xpElemNodes "d" $ xpContent xpPrim)
(xpElemNodes "e" $ xpContent xpPrim),
u "xp5Tuple - failure in 2nd"
"<top><a>1</a><b>2</b><c>3</c><d>4</d><e>5</e></top>"
(Left "in <top>, in 2nd of 5-tuple, in <b>, got xpZero" :: Either String (Int,Int,Int,Int,Int)) $
xpElemNodes "top" $ xp5Tuple
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpZero)
(xpElemNodes "c" $ xpContent xpPrim)
(xpElemNodes "d" $ xpContent xpPrim)
(xpElemNodes "e" $ xpContent xpPrim),
u "xp5Tuple - failure in 3rd"
"<top><a>1</a><b>2</b><c>3</c><d>4</d><e>5</e></top>"
(Left "in <top>, in 3rd of 5-tuple, in <c>, got xpZero" :: Either String (Int,Int,Int,Int,Int)) $
xpElemNodes "top" $ xp5Tuple
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpContent xpPrim)
(xpElemNodes "c" $ xpZero)
(xpElemNodes "d" $ xpContent xpPrim)
(xpElemNodes "e" $ xpContent xpPrim),
u "xp5Tuple - failure in 4th"
"<top><a>1</a><b>2</b><c>3</c><d>4</d><e>5</e></top>"
(Left "in <top>, in 4th of 5-tuple, in <d>, got xpZero" :: Either String (Int,Int,Int,Int,Int)) $
xpElemNodes "top" $ xp5Tuple
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpContent xpPrim)
(xpElemNodes "c" $ xpContent xpPrim)
(xpElemNodes "d" $ xpZero)
(xpElemNodes "e" $ xpContent xpPrim),
u "xp5Tuple - failure in 5th"
"<top><a>1</a><b>2</b><c>3</c><d>4</d><e>5</e></top>"
(Left "in <top>, in 5th of 5-tuple, in <e>, got xpZero" :: Either String (Int,Int,Int,Int,Int)) $
xpElemNodes "top" $ xp5Tuple
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpContent xpPrim)
(xpElemNodes "c" $ xpContent xpPrim)
(xpElemNodes "d" $ xpContent xpPrim)
(xpElemNodes "e" $ xpZero),
u "xp6Tuple"
"<top><a>1</a><b>2</b><c>3</c><d>4</d><e>5</e><f>6</f></top>"
(Right (1,2,3,4,5,6) :: Either String (Int,Int,Int,Int,Int,Int)) $
xpElemNodes "top" $ xp6Tuple
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpContent xpPrim)
(xpElemNodes "c" $ xpContent xpPrim)
(xpElemNodes "d" $ xpContent xpPrim)
(xpElemNodes "e" $ xpContent xpPrim)
(xpElemNodes "f" $ xpContent xpPrim),
u "xp6Tuple - failure in 1st"
"<top><a>1</a><b>2</b><c>3</c><d>4</d><e>5</e><f>6</f></top>"
(Left "in <top>, in 1st of 6-tuple, in <a>, got xpZero" :: Either String (Int,Int,Int,Int,Int,Int)) $
xpElemNodes "top" $ xp6Tuple
(xpElemNodes "a" $ xpZero)
(xpElemNodes "b" $ xpContent xpPrim)
(xpElemNodes "c" $ xpContent xpPrim)
(xpElemNodes "d" $ xpContent xpPrim)
(xpElemNodes "e" $ xpContent xpPrim)
(xpElemNodes "f" $ xpContent xpPrim),
u "xp6Tuple - failure in 2nd"
"<top><a>1</a><b>2</b><c>3</c><d>4</d><e>5</e><f>6</f></top>"
(Left "in <top>, in 2nd of 6-tuple, in <b>, got xpZero" :: Either String (Int,Int,Int,Int,Int,Int)) $
xpElemNodes "top" $ xp6Tuple
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpZero)
(xpElemNodes "c" $ xpContent xpPrim)
(xpElemNodes "d" $ xpContent xpPrim)
(xpElemNodes "e" $ xpContent xpPrim)
(xpElemNodes "f" $ xpContent xpPrim),
u "xp6Tuple - failure in 3rd"
"<top><a>1</a><b>2</b><c>3</c><d>4</d><e>5</e><f>6</f></top>"
(Left "in <top>, in 3rd of 6-tuple, in <c>, got xpZero" :: Either String (Int,Int,Int,Int,Int,Int)) $
xpElemNodes "top" $ xp6Tuple
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpContent xpPrim)
(xpElemNodes "c" $ xpZero)
(xpElemNodes "d" $ xpContent xpPrim)
(xpElemNodes "e" $ xpContent xpPrim)
(xpElemNodes "f" $ xpContent xpPrim),
u "xp6Tuple - failure in 4th"
"<top><a>1</a><b>2</b><c>3</c><d>4</d><e>5</e><f>6</f></top>"
(Left "in <top>, in 4th of 6-tuple, in <d>, got xpZero" :: Either String (Int,Int,Int,Int,Int,Int)) $
xpElemNodes "top" $ xp6Tuple
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpContent xpPrim)
(xpElemNodes "c" $ xpContent xpPrim)
(xpElemNodes "d" $ xpZero)
(xpElemNodes "e" $ xpContent xpPrim)
(xpElemNodes "f" $ xpContent xpPrim),
u "xp6Tuple - failure in 5th"
"<top><a>1</a><b>2</b><c>3</c><d>4</d><e>5</e><f>6</f></top>"
(Left "in <top>, in 5th of 6-tuple, in <e>, got xpZero" :: Either String (Int,Int,Int,Int,Int,Int)) $
xpElemNodes "top" $ xp6Tuple
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpContent xpPrim)
(xpElemNodes "c" $ xpContent xpPrim)
(xpElemNodes "d" $ xpContent xpPrim)
(xpElemNodes "e" $ xpZero)
(xpElemNodes "f" $ xpContent xpPrim),
u "xp6Tuple - failure in 6th"
"<top><a>1</a><b>2</b><c>3</c><d>4</d><e>5</e><f>6</f></top>"
(Left "in <top>, in 6th of 6-tuple, in <f>, got xpZero" :: Either String (Int,Int,Int,Int,Int,Int)) $
xpElemNodes "top" $ xp6Tuple
(xpElemNodes "a" $ xpContent xpPrim)
(xpElemNodes "b" $ xpContent xpPrim)
(xpElemNodes "c" $ xpContent xpPrim)
(xpElemNodes "d" $ xpContent xpPrim)
(xpElemNodes "e" $ xpContent xpPrim)
(xpElemNodes "f" $ xpZero),
u "xpList0"
"<top><name>Matthew</name><name>Stephen</name></top>"
(Right ["Matthew", "Stephen"]) $
xpElemNodes "top" $ xpList0 $ xpElemNodes "name" $ xpContent xpText0,
u "xpList0 with failure in element"
"<top><name>Matthew</name><kiwifruit>Stephen</kiwifruit></top>"
(Left "in <top>, in list, can't find <name>") $
xpElemNodes "top" $ xpList0 $ xpElemNodes "name" $ xpContent xpText0,
u "xpList0 with empty list"
"<top/>"
(Right []) $
xpElemNodes "top" $ xpList0 $ xpElemNodes "name" $ xpContent xpText0,
u "xpList"
"<top><name>Matthew</name><name>Stephen</name></top>"
(Right ["Matthew", "Stephen"]) $
xpElemNodes "top" $ xpList $ xpElemNodes "name" $ xpContent xpText0,
u2 "xpList with failure in element"
"<top><name>Matthew</name><kiwifruit>Stephen</kiwifruit></top>"
"<top><name>Matthew</name></top>"
(Right ["Matthew"]) $
xpElemNodes "top" $ xpList $ xpElemNodes "name" $ xpContent xpText0,
u "xpList with empty list"
"<top/>"
(Right []) $
xpElemNodes "top" $ xpList $ xpElemNodes "name" $ xpContent xpText0,
u "xpListMinLength (len 2)"
"<top><name>Matthew</name><name>Stephen</name></top>"
(Right ["Matthew", "Stephen"]) $
xpElemNodes "top" $ xpListMinLen 1 $ xpElemNodes "name" $ xpContent xpText0,
u "xpListMinLength (len 1)"
"<top><name>Matthew</name></top>"
(Right ["Matthew"]) $
xpElemNodes "top" $ xpListMinLen 1 $ xpElemNodes "name" $ xpContent xpText0,
u "xpListMinLength (len 0)"
"<top/>"
(Left "in <top>, Expecting at least 1 elements") $
xpElemNodes "top" $ xpListMinLen 1 $ xpElemNodes "name" $ xpContent xpText0,
u2 "xpListMinLength error in 2nd elt"
"<top><name>Matthew</name><orange>Stephen</orange></top>"
"<top><name>Matthew</name></top>"
(Right ["Matthew"]) $
xpElemNodes "top" $ xpListMinLen 1 $ xpElemNodes "name" $ xpContent xpText0,
u "xpListMinLength error in 1st elt"
"<top><apricot>Matthew</apricot><orange>Stephen</orange></top>"
(Left "in <top>, Expecting at least 1 elements") $
xpElemNodes "top" $ xpListMinLen 1 $ xpElemNodes "name" $ xpContent xpText0,
u2 "xpMap"
"<top><animal name=\"dog\">4</animal><animal name=\"spider\">8</animal><animal name=\"fish\">0</animal></top>"
"<top><animal name=\"dog\">4</animal><animal name=\"fish\">0</animal><animal name=\"spider\">8</animal></top>"
(Right $ M.fromList [("dog",4),("spider",8),("fish",0)] :: Either String (M.Map String Int)) $
xpElemNodes "top" $ xpMap "animal" "name" xpText0 (xpContent xpickle),
u "xpMap - empty"
"<top/>"
(Right $ M.empty :: Either String (M.Map String Int)) $
xpElemNodes "top" $ xpMap "animal" "name" xpText0 (xpContent xpickle),
u2 "xpMap - error in elt"
"<top><animal name=\"dog\">4</animal><plant name=\"spider plant\">378</plant><animal name=\"fish\">0</animal></top>"
"<top><animal name=\"dog\">4</animal></top>"
(Right $ M.fromList [("dog",4)] :: Either String (M.Map String Int)) $
xpElemNodes "top" $ xpMap "animal" "name" xpText0 (xpContent xpickle),
u "xpWrap"
"<top><animal name=\"dog\">4</animal><animal name=\"spider\">8</animal><animal name=\"fish\">0</animal></top>"
(Right [("_dog",400),("_spider",800),("_fish",0)] :: Either String [(String,Int)]) $
xpElemNodes "top" $ xpList $
xpWrap (('_':) *** (*100), tail *** (`div` 100)) $
xpElem "animal" (xpAttr "name" xpText0) (xpContent xpickle),
u "xpWrapMaybe"
"<top><animal name=\"dog\">4</animal><animal name=\"spider\">8</animal><animal name=\"fish\">0</animal></top>"
(Right [("_dog",400),("_spider",800),("_fish",0)] :: Either String [(String,Int)]) $
xpElemNodes "top" $ xpList $
xpWrapMaybe (Just . (('_':) *** (*100)), tail *** (`div` 100)) $
xpElem "animal" (xpAttr "name" xpText0) (xpContent xpickle),
u2 "xpWrapMaybe failure with xpList"
"<top><animal name=\"dog\">4</animal><animal name=\"spider\">8</animal><animal name=\"fish\">0</animal></top>"
"<top><animal name=\"dog\">4</animal></top>"
(Right [("_dog",400)] :: Either String [(String,Int)]) $
xpElemNodes "top" $ xpList $
xpWrapMaybe (\(a,b) -> if b < 6 then Just (('_':a),b*100) else Nothing, tail *** (`div` 100)) $
xpElem "animal" (xpAttr "name" xpText0) (xpContent xpickle),
u "xpWrapMaybe with xpList0"
"<top><animal name=\"dog\">4</animal><animal name=\"spider\">8</animal><animal name=\"fish\">0</animal></top>"
(Right [("_dog",400),("_spider",800),("_fish",0)] :: Either String [(String,Int)]) $
xpElemNodes "top" $ xpList0 $
xpWrapMaybe (Just . (('_':) *** (*100)), tail *** (`div` 100)) $
xpElem "animal" (xpAttr "name" xpText0) (xpContent xpickle),
u "xpWrapMaybe failure with xpList0"
"<top><animal name=\"dog\">4</animal><animal name=\"spider\">8</animal><animal name=\"fish\">0</animal></top>"
(Left "in <top>, in list, xpWrapMaybe can't encode Nothing value" :: Either String [(String,Int)]) $
xpElemNodes "top" $ xpList0 $
xpWrapMaybe (\(a,b) -> if b < 6 then Just (('_':a),b*100) else Nothing, tail *** (`div` 100)) $
xpElem "animal" (xpAttr "name" xpText0) (xpContent xpickle),
u "xpWrapMaybe_ failure with xpList0"
"<top><animal name=\"dog\">4</animal><animal name=\"spider\">8</animal><animal name=\"fish\">0</animal></top>"
(Left "in <top>, in list, no invertebrates, please" :: Either String [(String,Int)]) $
xpElemNodes "top" $ xpList0 $
xpWrapMaybe_ "no invertebrates, please" (\(a,b) -> if b < 6 then Just (('_':a),b*100) else Nothing, tail *** (`div` 100)) $
xpElem "animal" (xpAttr "name" xpText0) (xpContent xpickle),
u "xpWrapEither"
"<top><animal name=\"dog\">4</animal><animal name=\"spider\">8</animal><animal name=\"fish\">0</animal></top>"
(Right [("_dog",400),("_spider",800),("_fish",0)] :: Either String [(String,Int)]) $
xpElemNodes "top" $ xpList0 $
xpWrapEither (Right . (('_':) *** (*100)), tail *** (`div` 100)) $
xpElem "animal" (xpAttr "name" xpText0) (xpContent xpickle),
u "xpWrapEither failure"
"<top><animal name=\"dog\">4</animal><animal name=\"spider\">8</animal><animal name=\"fish\">0</animal></top>"
(Left "in <top>, in list, no invertibrates, I said" :: Either String [(String,Int)]) $
xpElemNodes "top" $ xpList0 $
xpWrapEither (\(a,b) -> if b < 6 then Right (('_':a),b*100) else Left "no invertibrates, I said", tail *** (`div` 100)) $
xpElem "animal" (xpAttr "name" xpText0) (xpContent xpickle),
u "xpOption present"
"<top><mineral>salt</mineral></top>"
(Right $ Just "salt") $
xpElemNodes "top" $ xpOption $ xpElemNodes "mineral" $ xpContent xpText0,
u "xpOption absent"
"<top/>"
(Right $ Nothing) $
xpElemNodes "top" $ xpOption $ xpElemNodes "mineral" $ xpContent xpText0,
u "xpDefault present"
"<top><mineral>salt</mineral></top>"
(Right $ "salt") $
xpElemNodes "top" $ xpDefault "quartz" $ xpElemNodes "mineral" $ xpContent xpText0,
u "xpDefault absent"
"<top/>" -- omits default if it matches
(Right $ "quartz") $
xpElemNodes "top" $ xpDefault "quartz" $ xpElemNodes "mineral" $ xpContent xpText0,
u "xpWithDefault present"
"<top><mineral>salt</mineral></top>"
(Right $ "salt") $
xpElemNodes "top" $ xpDefault "quartz" $ xpElemNodes "mineral" $ xpContent xpText0,
u2 "xpWithDefault absent"
"<top/>"
"<top><mineral>quartz</mineral></top>" -- encodes default on pickle
(Right $ "quartz") $
xpElemNodes "top" $ xpWithDefault "quartz" $ xpElemNodes "mineral" $ xpContent xpText0,
u "xpAlt"
"<top><duck/><pukeko/><swan/></top>"
(Right $ [1,0,2] :: Either String [Int]) $
xpElemNodes "top" $ xpList0 $
xpAlt id [xpElemNodes "pukeko" $ xpContent $ xpLift 0,
xpElemNodes "duck" $ xpContent $ xpLift 1,
xpElemNodes "swan" $ xpContent $ xpLift 2],
u2 "xpTryCatch"
"<top>five</top>"
"<top>4</top>"
(Right 4 :: Either String Int) $
xpElemNodes "top" $ xpContent $
xpTryCatch xpPrim (xpWrap (length, const "x") xpText0),
u "xpThrow"
"<top/>"
(Left "in <top>, Oh!" :: Either String Int) $
xpElemNodes "top" $ xpThrow "Oh!",
u "xpAttrs"
"<top name=\"Stephen\" favouriteColour=\"green\"/>"
(Right [("name", "Stephen"),("favouriteColour","green")]) $
xpElemAttrs "top" xpAttrs,
u "xpTree"
"<top test=\"1\">hello</top>"
(Right (Element "top" [("test","1")] [Text "hello"])) $
xpTree,
u "xpTrees"
"<top test=\"1\">hello</top>"
(Right [Element "top" [("test","1")] [Text "hello"]]) $
xpTrees
]