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
|
-- Connects to an XML-RPC server that supports introspection
-- and prints a Haskell module to standard output that contains
-- stubs for all the methods available at the server.
import Network.XmlRpc.Internals
import Network.XmlRpc.Client
import Network.XmlRpc.Introspect
import Data.List
import System.Exit (exitFailure)
import System.Environment (getArgs)
import System.IO
import Text.PrettyPrint.HughesPJ
showHaskellType :: Type -> String
showHaskellType TInt = "Int"
showHaskellType TBool = "Bool"
showHaskellType TString = "String"
showHaskellType TDouble = "Double"
showHaskellType TDateTime = "CalendarTime"
showHaskellType TBase64 = "String"
showHaskellType TStruct = "[(String,Value)]"
showHaskellType TArray = "[Value]"
showHaskellType TUnknown = error "unknown type"
showHdr :: String -> String -> Doc
showHdr mod url = text "module" <+> text mod <+> text "where"
$$ text "import Network.XmlRpc.Client"
$$ text "import Network.XmlRpc.Internals (Value)"
$$ text "import System.Time (CalendarTime)"
$$ text ""
$$ text "server :: String"
$$ text "server =" <+> doubleQuotes (text url)
showStub :: MethodInfo -> Doc
showStub (name,[(as,ret)],help) =
text "" $$ text "{-" <+> text help <+> text "-}"
$$ text hsname <+> text "::" <+> hsep (intersperse (text "->") ft)
$$ text hsname <+> text "= remote server" <+> doubleQuotes (text name)
where
hsname = mkname name
ft = map (text . showHaskellType) as
++ [text "IO" <+> text (showHaskellType ret)]
mkname [] = []
mkname ('.':xs) = '_':mkname xs
mkname (x:xs) = x:mkname xs
showStub (name, _, _) = error (name ++ " is overloaded")
printStub :: String -> String -> IO ()
printStub url method = methodInfo url method >>= putStrLn . show . showStub
printModule :: String -> String -> IO ()
printModule mod url = do
ms <- listMethods url
putStrLn $ show $ showHdr mod url
mapM_ (printStub url) ms
parseArgs :: IO (String,String)
parseArgs = do
args <- getArgs
case args of
[mod,url] -> return (mod,url)
_ -> do
hPutStrLn stderr "Usage: make-stubs module-name url"
exitFailure
main :: IO ()
main = do
hSetBuffering stdout NoBuffering
(mod,url) <- parseArgs
printModule mod url
|
