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
|
--------------------------------------------------------------------
-- |
-- Module : Text.Atom.Pub.Export
-- Copyright : (c) Galois, Inc. 2008
-- License : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@galois.com>
-- Stability : provisional
-- Description: Serializing APP types (as XML.)
--
--------------------------------------------------------------------
module Text.Atom.Pub.Export where
import Text.XML.Light
import Text.Atom.Pub
import Text.Atom.Feed.Export
( mb, xmlCategory, xmlTitle
, xmlns_atom
)
import Data.Maybe
showServiceDoc :: Service -> String
showServiceDoc s = showElement (xmlService s)
-- ToDo: old crud; inline away.
mkQName :: Maybe String -> String -> QName
mkQName a b = blank_name{qPrefix=a,qName=b}
mkElem :: QName -> [Attr] -> [Element] -> Element
mkElem a b c = node a ((b::[Attr]),(c::[Element]))
mkLeaf :: QName -> [Attr] -> String -> Element
mkLeaf a b c = node (a::QName) ((b::[Attr]),[Text blank_cdata{cdData=c}])
mkAttr :: String -> String -> Attr
mkAttr a b = Attr blank_name{qName=a} b
xmlns_app :: Attr
xmlns_app = Attr (mkQName (Just "xmlns") "app") appNS
appNS :: String
appNS = "http://purl.org/atom/app#"
appName :: String -> QName
appName nc = (mkQName (Just "app") nc){qURI=Just appNS}
xmlService :: Service -> Element
xmlService s =
mkElem (appName "service") [xmlns_app,xmlns_atom]
(concat [ map xmlWorkspace (serviceWorkspaces s)
, serviceOther s
])
xmlWorkspace :: Workspace -> Element
xmlWorkspace w =
mkElem (appName "workspace")
[mkAttr "xml:lang" "en"]
(concat [ [xmlTitle (workspaceTitle w)]
, map xmlCollection (workspaceCols w)
, workspaceOther w
])
xmlCollection :: Collection -> Element
xmlCollection c =
mkElem (appName "collection")
[mkAttr "href" (collectionURI c)]
(concat [ [xmlTitle (collectionTitle c)]
, map xmlAccept (collectionAccept c)
, map xmlCategories (collectionCats c)
, collectionOther c
])
xmlCategories :: Categories -> Element
xmlCategories (CategoriesExternal u) =
mkElem (appName "categories") [mkAttr "href" u] []
xmlCategories (Categories mbFixed mbScheme cs) =
mkElem (appName "categories")
(concat [ mb (\ f -> mkAttr "fixed" (if f then "yes" else "no")) mbFixed
, mb (mkAttr "scheme") mbScheme
])
(map xmlCategory cs)
xmlAccept :: Accept -> Element
xmlAccept a = mkLeaf (appName "accept") [] (acceptType a)
|
