Export.hs

--------------------------------------------------------------------
-- |
-- 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 a b = Name b a Nothing

mkElem :: Name -> [Attr] -> [Element] -> Element
mkElem a b c = Element a b $ map NodeElement c

mkLeaf :: Name -> [Attr] -> Text -> Element
mkLeaf a b c = Element a b [NodeContent $ ContentText c]

xmlns_app :: Attr
xmlns_app = (mkQName (Just "xmlns") "app", [ContentText appNS])

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

appName :: Text -> Name
appName nc = (mkQName (Just "app") nc) {nameNamespace = Just appNS}

xmlService :: Service -> Element
xmlService s =
  mkElem
    (appName "service")
    [xmlns_app, xmlns_atom]
    (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")
    (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)