--------------------------------------------------------------------
-- |
-- Module    : Text.RSS1.Syntax
-- Copyright : (c) Galois, Inc. 2008,
--             (c) Sigbjorn Finne 2009-
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
-- Stability : provisional
-- Portability: portable
--
--------------------------------------------------------------------
module Text.RSS1.Syntax
  ( URIString
  , TitleString
  , TimeString
  , TextString
  , Feed(..)
  , Channel(..)
  , Image(..)
  , Item(..)
  , TextInputInfo(..)
  , TaxonomyTopic(..)
  , UpdatePeriod(..)
  , ContentInfo(..)
  , nullFeed
  , nullChannel
  , nullImage
  , nullItem
  , nullTextInputInfo
  , nullTaxonomyTopic
  , nullContentInfo
  ) where

import Prelude.Compat

import Data.Text
import Data.XML.Compat
import Data.XML.Types as XML
import Text.DublinCore.Types

type URIString = Text

type TitleString = Text

type TimeString = Text

type TextString = Text

data Feed =
  Feed
    { Feed -> Text
feedVersion :: Text
    , Feed -> Channel
feedChannel :: Channel
    , Feed -> Maybe Image
feedImage :: Maybe Image
    , Feed -> [Item]
feedItems :: [Item]
    , Feed -> Maybe TextInputInfo
feedTextInput :: Maybe TextInputInfo
    , Feed -> [TaxonomyTopic]
feedTopics :: [TaxonomyTopic]
    , Feed -> [Element]
feedOther :: [XML.Element]
    , Feed -> [Attr]
feedAttrs :: [Attr]
    }
  deriving (Int -> Feed -> ShowS
[Feed] -> ShowS
Feed -> String
(Int -> Feed -> ShowS)
-> (Feed -> String) -> ([Feed] -> ShowS) -> Show Feed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Feed] -> ShowS
$cshowList :: [Feed] -> ShowS
show :: Feed -> String
$cshow :: Feed -> String
showsPrec :: Int -> Feed -> ShowS
$cshowsPrec :: Int -> Feed -> ShowS
Show)

data Channel =
  Channel
    { Channel -> Text
channelURI :: URIString
    , Channel -> Text
channelTitle :: TitleString
    , Channel -> Text
channelLink :: URIString
    , Channel -> Text
channelDesc :: TextString
           -- these are indirect RDF associations to elements declared
           -- outside the channel element in the RDF \/ feed document.
    , Channel -> Maybe Text
channelImageURI :: Maybe URIString
    , Channel -> [Text]
channelItemURIs :: [URIString]
    , Channel -> Maybe Text
channelTextInputURI :: Maybe URIString
    , Channel -> [DCItem]
channelDC :: [DCItem]
    , Channel -> Maybe UpdatePeriod
channelUpdatePeriod :: Maybe UpdatePeriod
    , Channel -> Maybe Integer
channelUpdateFreq :: Maybe Integer
    , Channel -> Maybe Text
channelUpdateBase :: Maybe TimeString -- format is yyyy-mm-ddThh:mm
    , Channel -> [ContentInfo]
channelContent :: [ContentInfo]
    , Channel -> [Text]
channelTopics :: [URIString]
    , Channel -> [Element]
channelOther :: [XML.Element]
    , Channel -> [Attr]
channelAttrs :: [Attr]
    }
  deriving (Int -> Channel -> ShowS
[Channel] -> ShowS
Channel -> String
(Int -> Channel -> ShowS)
-> (Channel -> String) -> ([Channel] -> ShowS) -> Show Channel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Channel] -> ShowS
$cshowList :: [Channel] -> ShowS
show :: Channel -> String
$cshow :: Channel -> String
showsPrec :: Int -> Channel -> ShowS
$cshowsPrec :: Int -> Channel -> ShowS
Show)

data Image =
  Image
    { Image -> Text
imageURI :: URIString -- the image resource, most likely.
    , Image -> Text
imageTitle :: TextString -- the "alt"ernative text.
    , Image -> Text
imageURL :: URIString
    , Image -> Text
imageLink :: URIString -- the href of the rendered img resource.
    , Image -> [DCItem]
imageDC :: [DCItem]
    , Image -> [Element]
imageOther :: [XML.Element]
    , Image -> [Attr]
imageAttrs :: [Attr]
    }
  deriving (Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
(Int -> Image -> ShowS)
-> (Image -> String) -> ([Image] -> ShowS) -> Show Image
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Image] -> ShowS
$cshowList :: [Image] -> ShowS
show :: Image -> String
$cshow :: Image -> String
showsPrec :: Int -> Image -> ShowS
$cshowsPrec :: Int -> Image -> ShowS
Show)

data Item =
  Item
    { Item -> Text
itemURI :: URIString
    , Item -> Text
itemTitle :: TextString
    , Item -> Text
itemLink :: URIString
    , Item -> Maybe Text
itemDesc :: Maybe TextString
    , Item -> [DCItem]
itemDC :: [DCItem]
    , Item -> [Text]
itemTopics :: [URIString]
    , Item -> [ContentInfo]
itemContent :: [ContentInfo]
    , Item -> [Element]
itemOther :: [XML.Element]
    , Item -> [Attr]
itemAttrs :: [Attr]
    }
  deriving (Int -> Item -> ShowS
[Item] -> ShowS
Item -> String
(Int -> Item -> ShowS)
-> (Item -> String) -> ([Item] -> ShowS) -> Show Item
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Item] -> ShowS
$cshowList :: [Item] -> ShowS
show :: Item -> String
$cshow :: Item -> String
showsPrec :: Int -> Item -> ShowS
$cshowsPrec :: Int -> Item -> ShowS
Show)

data TextInputInfo =
  TextInputInfo
    { TextInputInfo -> Text
textInputURI :: URIString
    , TextInputInfo -> Text
textInputTitle :: TextString
    , TextInputInfo -> Text
textInputDesc :: TextString
    , TextInputInfo -> Text
textInputName :: TextString
    , TextInputInfo -> Text
textInputLink :: URIString
    , TextInputInfo -> [DCItem]
textInputDC :: [DCItem]
    , TextInputInfo -> [Element]
textInputOther :: [XML.Element]
    , TextInputInfo -> [Attr]
textInputAttrs :: [Attr]
    }
  deriving (Int -> TextInputInfo -> ShowS
[TextInputInfo] -> ShowS
TextInputInfo -> String
(Int -> TextInputInfo -> ShowS)
-> (TextInputInfo -> String)
-> ([TextInputInfo] -> ShowS)
-> Show TextInputInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextInputInfo] -> ShowS
$cshowList :: [TextInputInfo] -> ShowS
show :: TextInputInfo -> String
$cshow :: TextInputInfo -> String
showsPrec :: Int -> TextInputInfo -> ShowS
$cshowsPrec :: Int -> TextInputInfo -> ShowS
Show)

data TaxonomyTopic =
  TaxonomyTopic
    { TaxonomyTopic -> Text
taxonomyURI :: URIString
    , TaxonomyTopic -> Text
taxonomyLink :: URIString
    , TaxonomyTopic -> Maybe Text
taxonomyTitle :: Maybe Text
    , TaxonomyTopic -> Maybe Text
taxonomyDesc :: Maybe Text
    , TaxonomyTopic -> [Text]
taxonomyTopics :: [URIString]
    , TaxonomyTopic -> [DCItem]
taxonomyDC :: [DCItem]
    , TaxonomyTopic -> [Element]
taxonomyOther :: [XML.Element]
    }
  deriving (Int -> TaxonomyTopic -> ShowS
[TaxonomyTopic] -> ShowS
TaxonomyTopic -> String
(Int -> TaxonomyTopic -> ShowS)
-> (TaxonomyTopic -> String)
-> ([TaxonomyTopic] -> ShowS)
-> Show TaxonomyTopic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TaxonomyTopic] -> ShowS
$cshowList :: [TaxonomyTopic] -> ShowS
show :: TaxonomyTopic -> String
$cshow :: TaxonomyTopic -> String
showsPrec :: Int -> TaxonomyTopic -> ShowS
$cshowsPrec :: Int -> TaxonomyTopic -> ShowS
Show)

data UpdatePeriod
  = Update_Hourly
  | Update_Daily
  | Update_Weekly
  | Update_Monthly
  | Update_Yearly
  deriving (UpdatePeriod -> UpdatePeriod -> Bool
(UpdatePeriod -> UpdatePeriod -> Bool)
-> (UpdatePeriod -> UpdatePeriod -> Bool) -> Eq UpdatePeriod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePeriod -> UpdatePeriod -> Bool
$c/= :: UpdatePeriod -> UpdatePeriod -> Bool
== :: UpdatePeriod -> UpdatePeriod -> Bool
$c== :: UpdatePeriod -> UpdatePeriod -> Bool
Eq, Int -> UpdatePeriod -> ShowS
[UpdatePeriod] -> ShowS
UpdatePeriod -> String
(Int -> UpdatePeriod -> ShowS)
-> (UpdatePeriod -> String)
-> ([UpdatePeriod] -> ShowS)
-> Show UpdatePeriod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePeriod] -> ShowS
$cshowList :: [UpdatePeriod] -> ShowS
show :: UpdatePeriod -> String
$cshow :: UpdatePeriod -> String
showsPrec :: Int -> UpdatePeriod -> ShowS
$cshowsPrec :: Int -> UpdatePeriod -> ShowS
Show)

data ContentInfo =
  ContentInfo
    { ContentInfo -> Maybe Text
contentURI :: Maybe URIString
    , ContentInfo -> Maybe Text
contentFormat :: Maybe URIString
    , ContentInfo -> Maybe Text
contentEncoding :: Maybe URIString
    , ContentInfo -> Maybe Text
contentValue :: Maybe Text -- should be: RDFValue
    }
  deriving (ContentInfo -> ContentInfo -> Bool
(ContentInfo -> ContentInfo -> Bool)
-> (ContentInfo -> ContentInfo -> Bool) -> Eq ContentInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentInfo -> ContentInfo -> Bool
$c/= :: ContentInfo -> ContentInfo -> Bool
== :: ContentInfo -> ContentInfo -> Bool
$c== :: ContentInfo -> ContentInfo -> Bool
Eq, Int -> ContentInfo -> ShowS
[ContentInfo] -> ShowS
ContentInfo -> String
(Int -> ContentInfo -> ShowS)
-> (ContentInfo -> String)
-> ([ContentInfo] -> ShowS)
-> Show ContentInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentInfo] -> ShowS
$cshowList :: [ContentInfo] -> ShowS
show :: ContentInfo -> String
$cshow :: ContentInfo -> String
showsPrec :: Int -> ContentInfo -> ShowS
$cshowsPrec :: Int -> ContentInfo -> ShowS
Show)

--default constructors:
nullFeed :: URIString -> TitleString -> Feed
nullFeed :: Text -> Text -> Feed
nullFeed Text
uri Text
title =
  Feed :: Text
-> Channel
-> Maybe Image
-> [Item]
-> Maybe TextInputInfo
-> [TaxonomyTopic]
-> [Element]
-> [Attr]
-> Feed
Feed
    { feedVersion :: Text
feedVersion = Text
"1.0"
    , feedChannel :: Channel
feedChannel = Text -> Text -> Channel
nullChannel Text
uri Text
title
    , feedImage :: Maybe Image
feedImage = Maybe Image
forall a. Maybe a
Nothing
    , feedItems :: [Item]
feedItems = []
    , feedTextInput :: Maybe TextInputInfo
feedTextInput = Maybe TextInputInfo
forall a. Maybe a
Nothing
    , feedTopics :: [TaxonomyTopic]
feedTopics = []
    , feedOther :: [Element]
feedOther = []
    , feedAttrs :: [Attr]
feedAttrs = []
    }

nullChannel :: URIString -> TitleString -> Channel
nullChannel :: Text -> Text -> Channel
nullChannel Text
uri Text
title =
  Channel :: Text
-> Text
-> Text
-> Text
-> Maybe Text
-> [Text]
-> Maybe Text
-> [DCItem]
-> Maybe UpdatePeriod
-> Maybe Integer
-> Maybe Text
-> [ContentInfo]
-> [Text]
-> [Element]
-> [Attr]
-> Channel
Channel
    { channelURI :: Text
channelURI = Text
uri
    , channelTitle :: Text
channelTitle = Text
title
    , channelLink :: Text
channelLink = Text
uri
    , channelDesc :: Text
channelDesc = Text
title
    , channelImageURI :: Maybe Text
channelImageURI = Maybe Text
forall a. Maybe a
Nothing
    , channelItemURIs :: [Text]
channelItemURIs = []
    , channelTextInputURI :: Maybe Text
channelTextInputURI = Maybe Text
forall a. Maybe a
Nothing
    , channelDC :: [DCItem]
channelDC = []
    , channelUpdatePeriod :: Maybe UpdatePeriod
channelUpdatePeriod = Maybe UpdatePeriod
forall a. Maybe a
Nothing
    , channelUpdateFreq :: Maybe Integer
channelUpdateFreq = Maybe Integer
forall a. Maybe a
Nothing
    , channelUpdateBase :: Maybe Text
channelUpdateBase = Maybe Text
forall a. Maybe a
Nothing
    , channelContent :: [ContentInfo]
channelContent = []
    , channelTopics :: [Text]
channelTopics = []
    , channelOther :: [Element]
channelOther = []
    , channelAttrs :: [Attr]
channelAttrs = []
    }

nullImage :: URIString -> Text -> URIString -> Image
nullImage :: Text -> Text -> Text -> Image
nullImage Text
imguri Text
title Text
link =
  Image :: Text
-> Text -> Text -> Text -> [DCItem] -> [Element] -> [Attr] -> Image
Image
    { imageURI :: Text
imageURI = Text
imguri
    , imageTitle :: Text
imageTitle = Text
title
    , imageURL :: Text
imageURL = Text
imguri
    , imageLink :: Text
imageLink = Text
link
    , imageDC :: [DCItem]
imageDC = []
    , imageOther :: [Element]
imageOther = []
    , imageAttrs :: [Attr]
imageAttrs = []
    }

nullItem :: URIString -> TextString -> URIString -> Item
nullItem :: Text -> Text -> Text -> Item
nullItem Text
uri Text
title Text
link =
  Item :: Text
-> Text
-> Text
-> Maybe Text
-> [DCItem]
-> [Text]
-> [ContentInfo]
-> [Element]
-> [Attr]
-> Item
Item
    { itemURI :: Text
itemURI = Text
uri
    , itemTitle :: Text
itemTitle = Text
title
    , itemLink :: Text
itemLink = Text
link
    , itemDesc :: Maybe Text
itemDesc = Maybe Text
forall a. Maybe a
Nothing
    , itemDC :: [DCItem]
itemDC = []
    , itemTopics :: [Text]
itemTopics = []
    , itemContent :: [ContentInfo]
itemContent = []
    , itemOther :: [Element]
itemOther = []
    , itemAttrs :: [Attr]
itemAttrs = []
    }

nullTextInputInfo :: URIString -> TextString -> TextString -> URIString -> TextInputInfo
nullTextInputInfo :: Text -> Text -> Text -> Text -> TextInputInfo
nullTextInputInfo Text
uri Text
title Text
nm Text
link =
  TextInputInfo :: Text
-> Text
-> Text
-> Text
-> Text
-> [DCItem]
-> [Element]
-> [Attr]
-> TextInputInfo
TextInputInfo
    { textInputURI :: Text
textInputURI = Text
uri
    , textInputTitle :: Text
textInputTitle = Text
title
    , textInputDesc :: Text
textInputDesc = Text
title
    , textInputName :: Text
textInputName = Text
nm
    , textInputLink :: Text
textInputLink = Text
link
    , textInputDC :: [DCItem]
textInputDC = []
    , textInputOther :: [Element]
textInputOther = []
    , textInputAttrs :: [Attr]
textInputAttrs = []
    }

nullTaxonomyTopic :: URIString -> URIString -> TaxonomyTopic
nullTaxonomyTopic :: Text -> Text -> TaxonomyTopic
nullTaxonomyTopic Text
uri Text
link =
  TaxonomyTopic :: Text
-> Text
-> Maybe Text
-> Maybe Text
-> [Text]
-> [DCItem]
-> [Element]
-> TaxonomyTopic
TaxonomyTopic
    { taxonomyURI :: Text
taxonomyURI = Text
uri
    , taxonomyLink :: Text
taxonomyLink = Text
link
    , taxonomyTitle :: Maybe Text
taxonomyTitle = Maybe Text
forall a. Maybe a
Nothing
    , taxonomyDesc :: Maybe Text
taxonomyDesc = Maybe Text
forall a. Maybe a
Nothing
    , taxonomyTopics :: [Text]
taxonomyTopics = []
    , taxonomyDC :: [DCItem]
taxonomyDC = []
    , taxonomyOther :: [Element]
taxonomyOther = []
    }

nullContentInfo :: ContentInfo
nullContentInfo :: ContentInfo
nullContentInfo =
  ContentInfo :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> ContentInfo
ContentInfo
    { contentURI :: Maybe Text
contentURI = Maybe Text
forall a. Maybe a
Nothing
    , contentFormat :: Maybe Text
contentFormat = Maybe Text
forall a. Maybe a
Nothing
    , contentEncoding :: Maybe Text
contentEncoding = Maybe Text
forall a. Maybe a
Nothing
    , contentValue :: Maybe Text
contentValue = Maybe Text
forall a. Maybe a
Nothing
    }