--------------------------------------------------------------------
-- |
-- Module    : Text.OPML.Syntax
-- Copyright : (c) Galois, Inc. 2007
-- License   : BSD3
--
-- Stability : provisional
-- Portability:
--
--------------------------------------------------------------------
--
-- OPML syntax definition
--

module Text.OPML.Syntax where

import qualified Text.XML.Light as XML

type DateString = String
type URIString  = String

-- | An OPML structure
data OPML
 = OPML
    { opmlVersion :: String
    , opmlAttrs   :: [XML.Attr]
    , opmlHead    :: OPMLHead
    , opmlBody    :: [Outline]
    , opmlOther   :: [XML.Element]
    }

data Outline
 = Outline
      { opmlText            :: String
      , opmlType            :: Maybe String
      , opmlCategories      :: Maybe [String]
      , opmlIsComment       :: Maybe Bool
      , opmlIsBreakpoint    :: Maybe Bool
      , opmlOutlineAttrs    :: [XML.Attr]
      , opmlOutlineChildren :: [Outline]
      , opmlOutlineOther    :: [XML.Element]
      }

data OPMLHead
 = OPMLHead
       { opmlTitle          :: String
       , opmlHeadAttrs      :: [XML.Attr]
       , opmlCreated        :: Maybe DateString
       , opmlModified       :: Maybe DateString
       , opmlOwner          :: Maybe OPMLOwner
       , opmlDocs           :: Maybe URIString
       , opmlExpansionState :: Maybe [Int]
       , opmlVertScrollState:: Maybe Int
       , opmlWindowTop      :: Maybe Int
       , opmlWindowLeft     :: Maybe Int
       , opmlWindowBottom   :: Maybe Int
       , opmlWindowRight    :: Maybe Int
       , opmlHeadOther      :: [XML.Element]
       }

data OPMLOwner
 = OPMLOwner
       { opmlOwnerId        :: Maybe String
       , opmlOwnerEmail     :: Maybe String
       , opmlOwnerName      :: Maybe String
       }

nullOPML :: OPML
nullOPML =
  OPML { opmlVersion = "2.0"
       , opmlAttrs   = []
       , opmlHead    = nullHead
       , opmlBody    = []
       , opmlOther   = []
       }

nullOutline :: String-> Outline
nullOutline t =
  Outline
      { opmlText            = t
      , opmlType            = Nothing
      , opmlCategories      = Nothing
      , opmlIsComment       = Nothing
      , opmlIsBreakpoint    = Nothing
      , opmlOutlineAttrs    = []
      , opmlOutlineChildren = []
      , opmlOutlineOther    = []
      }

nullHead :: OPMLHead
nullHead
 = OPMLHead
       { opmlTitle           = ""
       , opmlHeadAttrs       = []
       , opmlCreated         = Nothing
       , opmlModified        = Nothing
       , opmlOwner           = Nothing
       , opmlDocs            = Nothing
       , opmlExpansionState  = Nothing
       , opmlVertScrollState = Nothing
       , opmlWindowTop       = Nothing
       , opmlWindowLeft      = Nothing
       , opmlWindowBottom    = Nothing
       , opmlWindowRight     = Nothing
       , opmlHeadOther       = []
       }

nullOwner :: OPMLOwner
nullOwner
 = OPMLOwner
       { opmlOwnerId    = Nothing
       , opmlOwnerEmail = Nothing
       , opmlOwnerName  = Nothing
       }