module Text.Atom.Pub.Export
( mkQName
, mkElem
, mkLeaf
, mkAttr
, xmlns_app
, appNS
, xmlService
, xmlWorkspace
, xmlCollection
, xmlCategories
, xmlAccept
) where
import Prelude.Compat
import Data.Text (Text)
import Data.XML.Compat
import Data.XML.Types
import Text.Atom.Feed.Export (mb, xmlCategory, xmlTitle, xmlns_atom)
import Text.Atom.Pub
mkQName :: Maybe Text -> Text -> Name
mkQName :: Maybe Text -> Text -> Name
mkQName a :: Maybe Text
a b :: Text
b = Text -> Maybe Text -> Maybe Text -> Name
Name Text
b Maybe Text
a Maybe Text
forall a. Maybe a
Nothing
mkElem :: Name -> [Attr] -> [Element] -> Element
mkElem :: Name -> [Attr] -> [Element] -> Element
mkElem a :: Name
a b :: [Attr]
b c :: [Element]
c = Name -> [Attr] -> [Node] -> Element
Element Name
a [Attr]
b ([Node] -> Element) -> [Node] -> Element
forall a b. (a -> b) -> a -> b
$ (Element -> Node) -> [Element] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
NodeElement [Element]
c
mkLeaf :: Name -> [Attr] -> Text -> Element
mkLeaf :: Name -> [Attr] -> Text -> Element
mkLeaf a :: Name
a b :: [Attr]
b c :: Text
c = Name -> [Attr] -> [Node] -> Element
Element Name
a [Attr]
b [Content -> Node
NodeContent (Content -> Node) -> Content -> Node
forall a b. (a -> b) -> a -> b
$ Text -> Content
ContentText Text
c]
xmlns_app :: Attr
xmlns_app :: Attr
xmlns_app = (Maybe Text -> Text -> Name
mkQName (Text -> Maybe Text
forall a. a -> Maybe a
Just "xmlns") "app", [Text -> Content
ContentText Text
appNS])
appNS :: Text
appNS :: Text
appNS = "http://purl.org/atom/app#"
appName :: Text -> Name
appName :: Text -> Name
appName nc :: Text
nc = (Maybe Text -> Text -> Name
mkQName (Text -> Maybe Text
forall a. a -> Maybe a
Just "app") Text
nc) {nameNamespace :: Maybe Text
nameNamespace = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
appNS}
xmlService :: Service -> Element
xmlService :: Service -> Element
xmlService s :: Service
s =
Name -> [Attr] -> [Element] -> Element
mkElem
(Text -> Name
appName "service")
[Attr
xmlns_app, Attr
xmlns_atom]
((Workspace -> Element) -> [Workspace] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Workspace -> Element
xmlWorkspace (Service -> [Workspace]
serviceWorkspaces Service
s) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ Service -> [Element]
serviceOther Service
s)
xmlWorkspace :: Workspace -> Element
xmlWorkspace :: Workspace -> Element
xmlWorkspace w :: Workspace
w =
Name -> [Attr] -> [Element] -> Element
mkElem
(Text -> Name
appName "workspace")
[Text -> Text -> Attr
mkAttr "xml:lang" "en"]
([[Element]] -> [Element]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[TextContent -> Element
xmlTitle (Workspace -> TextContent
workspaceTitle Workspace
w)], (Collection -> Element) -> [Collection] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Collection -> Element
xmlCollection (Workspace -> [Collection]
workspaceCols Workspace
w), Workspace -> [Element]
workspaceOther Workspace
w])
xmlCollection :: Collection -> Element
xmlCollection :: Collection -> Element
xmlCollection c :: Collection
c =
Name -> [Attr] -> [Element] -> Element
mkElem
(Text -> Name
appName "collection")
[Text -> Text -> Attr
mkAttr "href" (Collection -> Text
collectionURI Collection
c)]
([[Element]] -> [Element]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [TextContent -> Element
xmlTitle (Collection -> TextContent
collectionTitle Collection
c)]
, (Accept -> Element) -> [Accept] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Accept -> Element
xmlAccept (Collection -> [Accept]
collectionAccept Collection
c)
, (Categories -> Element) -> [Categories] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Categories -> Element
xmlCategories (Collection -> [Categories]
collectionCats Collection
c)
, Collection -> [Element]
collectionOther Collection
c
])
xmlCategories :: Categories -> Element
xmlCategories :: Categories -> Element
xmlCategories (CategoriesExternal u :: Text
u) = Name -> [Attr] -> [Element] -> Element
mkElem (Text -> Name
appName "categories") [Text -> Text -> Attr
mkAttr "href" Text
u] []
xmlCategories (Categories mbFixed :: Maybe Bool
mbFixed mbScheme :: Maybe Text
mbScheme cs :: [Category]
cs) =
Name -> [Attr] -> [Element] -> Element
mkElem
(Text -> Name
appName "categories")
((Bool -> Attr) -> Maybe Bool -> [Attr]
forall a b. (a -> b) -> Maybe a -> [b]
mb
(\f :: Bool
f ->
Text -> Text -> Attr
mkAttr
"fixed"
(if Bool
f
then "yes"
else "no"))
Maybe Bool
mbFixed [Attr] -> [Attr] -> [Attr]
forall a. [a] -> [a] -> [a]
++
(Text -> Attr) -> Maybe Text -> [Attr]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Attr
mkAttr "scheme") Maybe Text
mbScheme)
((Category -> Element) -> [Category] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Category -> Element
xmlCategory [Category]
cs)
xmlAccept :: Accept -> Element
xmlAccept :: Accept -> Element
xmlAccept a :: Accept
a = Name -> [Attr] -> Text -> Element
mkLeaf (Text -> Name
appName "accept") [] (Accept -> Text
acceptType Accept
a)