--------------------------------------------------------------------
-- |
-- Module    : Text.Atom.Pub.Export
-- Copyright : (c) Galois, Inc. 2008,
--             (c) Sigbjorn Finne 2009-
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
-- Stability : provisional
-- Portability:: portable
-- Description: Serializing APP types (as XML.)
--
-- Serializing Atom Publishing Protocol types as XML.
--
--------------------------------------------------------------------
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

-- ToDo: old crud; inline away.
mkQName :: Maybe Text -> Text -> Name
mkQName :: Maybe Text -> Text -> Name
mkQName Maybe Text
a 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 Name
a [Attr]
b [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 Name
a [Attr]
b 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 Text
"xmlns") Text
"app", [Text -> Content
ContentText Text
appNS])

appNS :: Text
appNS :: Text
appNS = Text
"http://purl.org/atom/app#"

appName :: Text -> Name
appName :: Text -> Name
appName Text
nc = (Maybe Text -> Text -> Name
mkQName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"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 Service
s =
  Name -> [Attr] -> [Element] -> Element
mkElem
    (Text -> Name
appName Text
"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 Workspace
w =
  Name -> [Attr] -> [Element] -> Element
mkElem
    (Text -> Name
appName Text
"workspace")
    [Text -> Text -> Attr
mkAttr Text
"xml:lang" Text
"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 Collection
c =
  Name -> [Attr] -> [Element] -> Element
mkElem
    (Text -> Name
appName Text
"collection")
    [Text -> Text -> Attr
mkAttr Text
"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 Text
u) = Name -> [Attr] -> [Element] -> Element
mkElem (Text -> Name
appName Text
"categories") [Text -> Text -> Attr
mkAttr Text
"href" Text
u] []
xmlCategories (Categories Maybe Bool
mbFixed Maybe Text
mbScheme [Category]
cs) =
  Name -> [Attr] -> [Element] -> Element
mkElem
    (Text -> Name
appName Text
"categories")
    ((Bool -> Attr) -> Maybe Bool -> [Attr]
forall a b. (a -> b) -> Maybe a -> [b]
mb
       (\Bool
f ->
          Text -> Text -> Attr
mkAttr
            Text
"fixed"
            (if Bool
f
               then Text
"yes"
               else Text
"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 Text
"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 Accept
a = Name -> [Attr] -> Text -> Element
mkLeaf (Text -> Name
appName Text
"accept") [] (Accept -> Text
acceptType Accept
a)