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
|
module CASS.ServerFormats(serverFormats,formatResult) where
import Analysis.ProgInfo
import FlatCurry.Types(QName,showQNameInModule)
import Sort(sortBy)
import XML
serverFormats :: [String]
serverFormats = ["XML","CurryTerm","Text"]
formatResult :: String -> String -> Maybe String -> Bool
-> (Either (ProgInfo String) String) -> String
formatResult _ outForm _ _ (Right err) =
let errMsg = "ERROR in analysis: " ++ err
in if outForm == "XML"
then showXmlDoc (xml "error" [xtxt errMsg])
else errMsg
formatResult moduleName outForm (Just name) _ (Left pinfo) =
let lookupResult = lookupProgInfo (moduleName,name) pinfo
in case lookupResult of
Nothing -> ("ERROR "++name++" not found in "++moduleName)
Just value ->
case outForm of
"CurryTerm" -> value
"Text" -> value
"XML" -> showXmlDoc (xml "result" [xtxt value])
_ -> error "Internal error ServerFormats.formatResult"
formatResult moduleName outForm Nothing public (Left pinfo) =
case outForm of
"CurryTerm" -> show entities
"Text" -> formatAsText moduleName entities
"XML" -> let (pubxml,privxml) = progInfo2XML pinfo
in showXmlDoc
(xml "results"
(pubxml ++ if public then [] else privxml))
_ -> error "Internal error ServerFormats.formatResult"
where
entities = let (pubents,privents) = progInfo2Lists pinfo
in if public then pubents
else sortBy (\ (qf1,_) (qf2,_) -> qf1<=qf2)
(pubents++privents)
formatAsText :: String -> [(QName,String)] -> String
formatAsText moduleName =
unlines . map (\ (qf,r) -> showQNameInModule moduleName qf ++ " : " ++ r)
|