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
|
-- Implements the validation suite from http://validator.xmlrpc.com/
-- This has not been tested as the XML-RPC validator does not seem to
-- be working at the moment.
import System.Time
import Network.XmlRpc.Internals
import Network.XmlRpc.Server
get :: String -> [(String,a)] -> IO a
get f xs = maybeToM ("No such field: '" ++ f ++ "'") (lookup f xs)
arrayOfStructsTest :: [[(String,Int)]] -> IO Int
arrayOfStructsTest xs = return $ sum [ i | Just i <- map (lookup "curly") xs]
countTheEntities :: String -> IO [(String,Int)]
countTheEntities xs = return [
("ctLeftAngleBrackets", count '<'),
("ctRightAngleBrackets", count '>'),
("ctAmpersands", count '&'),
("ctApostrophes", count '\''),
("ctQuotes", count '"')
]
where count c = length (filter (==c) xs)
easyStructTest :: [(String,Int)] -> IO Int
easyStructTest xs = do
m <- get "moe" xs
l <- get "larry" xs
c <- get "curly" xs
return (m+l+c)
-- FIXME: should be able to get it as a struct
echoStructTest :: Value -> IO Value
echoStructTest xs = return xs
manyTypesTest :: Int -> Bool -> String -> Double -> CalendarTime -> String
-> IO [Value]
manyTypesTest i b s d t b64 = return [toValue i, toValue b, toValue s,
toValue d, toValue t, toValue b64]
moderateSizeArrayCheck :: [String] -> IO String
moderateSizeArrayCheck [] = fail "empty array"
moderateSizeArrayCheck xs = return (head xs ++ last xs)
nestedStructTest :: [(String,[(String,[(String,[(String,Int)])])])] -> IO Int
nestedStructTest c = do
y <- get "2000" c
m <- get "04" y
d <- get "01" m
easyStructTest d
simpleStructReturnTest :: Int -> IO [(String, Int)]
simpleStructReturnTest x = return [
("times10",10*x),
("times100",100*x),
("times1000",1000*x)
]
main = cgiXmlRpcServer
[
("validator1.arrayOfStructsTest", fun arrayOfStructsTest),
("validator1.countTheEntities", fun countTheEntities),
("validator1.easyStructTest", fun easyStructTest),
("validator1.echoStructTest", fun echoStructTest),
("validator1.manyTypesTest", fun manyTypesTest),
("validator1.moderateSizeArrayCheck", fun moderateSizeArrayCheck),
("validator1.nestedStructTest", fun nestedStructTest),
("validator1.simpleStructReturnTest", fun simpleStructReturnTest)
]
|
