File: SimpleTest.hs

package info (click to toggle)
hugs98 98.200609.21-5.3
  • links: PTS
  • area: main
  • in suites: jessie, jessie-kfreebsd, wheezy
  • size: 41,872 kB
  • ctags: 8,927
  • sloc: haskell: 118,978; xml: 61,802; ansic: 46,695; sh: 8,750; cpp: 6,033; makefile: 2,661; yacc: 1,111; cs: 883; sed: 10
file content (43 lines) | stat: -rw-r--r-- 1,481 bytes parent folder | download | duplicates (6)
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
module Main where

import List (isPrefixOf)
import Text.XML.HaXml.XmlContent
import Text.XML.HaXml.Types
import Text.PrettyPrint.HughesPJ (render)
import Text.XML.HaXml.Pretty     (document)

-- Test stuff
value1 :: ([(Bool,Int)],(String,Maybe Char))
value1 = ([(True,42),(False,0)],("Hello World",Just 'x'))

data MyType a = ConsA Int a
              | ConsB String deriving Eq
              {-! derive : Haskell2Xml !-}


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)


value2 :: (MyType [Int], MyType ())
value2  = (ConsA 2 [42,0], ConsB "hello world")

--main = do (putStrLn . render . document . toXml) value2

main = putStrLn
         (if value2 == (fst . fromContents . toContents) value2 then "success"
          else "failure")