/usr/share/doc/libhugs-haxml-bundled/examples/HaXml/SimpleTestD.hs is in libhugs-haxml-bundled 98.200609.21-5.3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | module Main where
import IO
import System (getArgs)
--import List (isPrefixOf)
import Text.XML.HaXml.XmlContent
-- Test stuff
data MyType a = ConsA Int a
| ConsB String
{-! derive : XmlContent !-}
instance Eq a => Eq (MyType a) where
(ConsA a b) == (ConsA c d) = a==c && b==d
(ConsB e) == (ConsB f) = e `isPrefixOf` f || f `isPrefixOf` e
_ == _ = False
{-
-- Hand-written example of preferred instance declaration.
instance Haskell2Xml a => Haskell2Xml (MyType a) where
toHType v = Defined "MyType" [toHType a]
[Constr "ConsA" [toHType a] [Prim "Int" "int", toHType a]
,Constr "ConsB" [] [String]
]
where (ConsA _ a) = v
toContents v@(ConsA n a) = [mkElemC (showConstr 0 (toHType v))
(concat [toContents n, toContents a])]
toContents v@(ConsB s) = [mkElemC (showConstr 1 (toHType v)) (toContents s)]
fromContents (CElem (Elem constr [] cs) : etc)
| "ConsA-" `isPrefixOf` constr =
(\(i,cs')-> (\(a,_) -> (ConsA i a,etc))
(fromContents cs')) (fromContents cs)
| "ConsB" `isPrefixOf` constr =
(\(s,_)-> (ConsB s, etc)) (fromContents cs)
-}
value1 :: Maybe ([(Bool,Int)],(String,Maybe Char))
value1 = Just ([(True,42),(False,0)],("Hello World",Nothing))
value2 :: (MyType [Int], MyType ())
value2 = (ConsA 2 [42,0], ConsB "hello world")
value3 :: MyType [Int]
value3 = ConsA 2 [42,0]
-- Main wrapper
main =
getArgs >>= \args->
if length args /= 3 then
putStrLn "Usage: <app> [1|2|3] [-w|-r] <xmlfile>"
else
let (arg0:arg1:arg2:_) = args in
( case arg1 of
"-w"-> return (stdout,WriteMode)
"-r"-> return (stdin,ReadMode)
_ -> fail ("Usage: <app> [-r|-w] <xmlfile>") ) >>= \(std,mode)->
( if arg2=="-" then return std
else openFile arg2 mode ) >>= \f->
( case arg0 of
"1" -> checkValue f mode value1
"2" -> checkValue f mode value2
"3" -> checkValue f mode value3
_ -> fail ("Usage: <app> [-r|-w] <xmlfile>") )
checkValue f mode value =
case mode of
WriteMode-> hPutXml f value
ReadMode -> do ivalue <- hGetXml f
putStrLn (if ivalue==value then "success" else "failure")
-- WriteMode-> (hPutStrLn f . render . document . toXml) value1
-- ReadMode -> hGetContents f >>= \content ->
-- let ivalue = (fromXml . xmlParse) content in
-- (putStrLn . render . document . toXml) (ivalue `asTypeOf` value1) >>
-- putStrLn (if ivalue == value1 then "success" else "failure")
-- Machine generated stuff
{-* Generated by DrIFT-v1.0 : Look, but Don't Touch. *-}
instance (Haskell2Xml a) => Haskell2Xml (MyType a) where
toHType v =
Defined "MyType" [a]
[Constr "ConsA" [a] [toHType aa,toHType ab],
Constr "ConsB" [] [toHType ac]]
where
(ConsA aa ab) = v
(ConsB ac) = v
(a) = toHType ab
fromContents (CElem (Elem constr [] cs):etc)
| "ConsA" `isPrefixOf` constr =
(\(aa,cs00)-> (\(ab,_)-> (ConsA aa ab, etc)) (fromContents cs00))
(fromContents cs)
| "ConsB" `isPrefixOf` constr =
(\(ac,_)-> (ConsB ac, etc)) (fromContents cs)
fromContents (CElem (Elem constr _ _):etc) =
error ("expected ConsA or ConsB, got "++constr)
toContents v@(ConsA aa ab) =
[mkElemC (showConstr 0 (toHType v)) (concat [toContents aa,
toContents ab])]
toContents v@(ConsB ac) =
[mkElemC (showConstr 1 (toHType v)) (toContents ac)]
|