--------------------------------------------------------------------
-- |
-- Module    : Text.Atom.Pub
-- Copyright : (c) Galois, Inc. 2008,
--             (c) Sigbjorn Finne 2009-
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
-- Stability : provisional
-- Portability: portable
--
-- Types for the Atom Publishing Protocol (APP)
--
--------------------------------------------------------------------
module Text.Atom.Pub
  ( Service(..)
  , Workspace(..)
  , Collection(..)
  , Categories(..)
  , Accept(..)
  ) where

import Prelude.Compat

import Data.Text (Text)
import Data.XML.Types as XML
import Text.Atom.Feed (Category, TextContent, URI)

data Service =
  Service
    { Service -> [Workspace]
serviceWorkspaces :: [Workspace]
    , Service -> [Element]
serviceOther :: [XML.Element]
    }

data Workspace =
  Workspace
    { Workspace -> TextContent
workspaceTitle :: TextContent
    , Workspace -> [Collection]
workspaceCols :: [Collection]
    , Workspace -> [Element]
workspaceOther :: [XML.Element]
    }

data Collection =
  Collection
    { Collection -> URI
collectionURI :: URI
    , Collection -> TextContent
collectionTitle :: TextContent
    , Collection -> [Accept]
collectionAccept :: [Accept]
    , Collection -> [Categories]
collectionCats :: [Categories]
    , Collection -> [Element]
collectionOther :: [XML.Element]
    }

data Categories
  = CategoriesExternal URI
  | Categories (Maybe Bool) (Maybe URI) [Category]
  deriving (Int -> Categories -> ShowS
[Categories] -> ShowS
Categories -> String
(Int -> Categories -> ShowS)
-> (Categories -> String)
-> ([Categories] -> ShowS)
-> Show Categories
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Categories] -> ShowS
$cshowList :: [Categories] -> ShowS
show :: Categories -> String
$cshow :: Categories -> String
showsPrec :: Int -> Categories -> ShowS
$cshowsPrec :: Int -> Categories -> ShowS
Show)

newtype Accept =
  Accept
    { Accept -> URI
acceptType :: Text
    }