--------------------------------------------------------------------
-- |
-- Module    : Text.RSS.Syntax
-- Copyright : (c) Galois, Inc. 2008,
--             (c) Sigbjorn Finne 2009-
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
-- Stability : provisional
--
-- The basic syntax for putting together feeds.
--
-- For instance, to create a feed with a single item item:
--  (nullRSS \"rss title\" \"link\") {rssChannel=(nullChannel \"channel title\" \"link\") {rssItems=[(nullItem \"item title\")]}}
--------------------------------------------------------------------
module Text.RSS.Syntax
  ( RSS(..)
  , URLString
  , DateString
  , RSSChannel(..)
  , RSSItem(..)
  , RSSSource(..)
  , RSSEnclosure(..)
  , RSSCategory(..)
  , RSSGuid(..)
  , RSSImage(..)
  , RSSCloud(..)
  , RSSTextInput(..)
  , nullRSS
  , nullChannel
  , nullItem
  , nullSource
  , nullEnclosure
  , newCategory
  , nullGuid
  , nullPermaGuid
  , nullImage
  , nullCloud
  , nullTextInput
  ) where

import Prelude.Compat

import Data.Text (Text)
import Data.XML.Compat
import Data.XML.Types as XML

-- * Core Types
-- ^The Radio Userland version of RSS documents\/feeds.
-- (versions 0.9x, 2.x)
data RSS =
  RSS
    { RSS -> Text
rssVersion :: Text
    , RSS -> [Attr]
rssAttrs :: [Attr]
    , RSS -> RSSChannel
rssChannel :: RSSChannel
    , RSS -> [Element]
rssOther :: [XML.Element]
    }
  deriving (Int -> RSS -> ShowS
[RSS] -> ShowS
RSS -> String
(Int -> RSS -> ShowS)
-> (RSS -> String) -> ([RSS] -> ShowS) -> Show RSS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RSS] -> ShowS
$cshowList :: [RSS] -> ShowS
show :: RSS -> String
$cshow :: RSS -> String
showsPrec :: Int -> RSS -> ShowS
$cshowsPrec :: Int -> RSS -> ShowS
Show)

type URLString = Text

-- | RFC 822 conforming.
type DateString = Text

data RSSChannel =
  RSSChannel
    { RSSChannel -> Text
rssTitle :: Text
    , RSSChannel -> Text
rssLink :: URLString
    , RSSChannel -> Text
rssDescription :: Text
    , RSSChannel -> [RSSItem]
rssItems :: [RSSItem]
    , RSSChannel -> Maybe Text
rssLanguage :: Maybe Text
    , RSSChannel -> Maybe Text
rssCopyright :: Maybe Text
    , RSSChannel -> Maybe Text
rssEditor :: Maybe Text
    , RSSChannel -> Maybe Text
rssWebMaster :: Maybe Text
    , RSSChannel -> Maybe Text
rssPubDate :: Maybe DateString -- ^ rfc 822 conforming.
    , RSSChannel -> Maybe Text
rssLastUpdate :: Maybe DateString -- ^ rfc 822 conforming.
    , RSSChannel -> [RSSCategory]
rssCategories :: [RSSCategory]
    , RSSChannel -> Maybe Text
rssGenerator :: Maybe Text
    , RSSChannel -> Maybe Text
rssDocs :: Maybe URLString
    , RSSChannel -> Maybe RSSCloud
rssCloud :: Maybe RSSCloud
    , RSSChannel -> Maybe Integer
rssTTL :: Maybe Integer
    , RSSChannel -> Maybe RSSImage
rssImage :: Maybe RSSImage
    , RSSChannel -> Maybe Text
rssRating :: Maybe Text
    , RSSChannel -> Maybe RSSTextInput
rssTextInput :: Maybe RSSTextInput
    , RSSChannel -> Maybe [Integer]
rssSkipHours :: Maybe [Integer]
    , RSSChannel -> Maybe [Text]
rssSkipDays :: Maybe [Text]
    , RSSChannel -> [Element]
rssChannelOther :: [XML.Element]
    }
  deriving (Int -> RSSChannel -> ShowS
[RSSChannel] -> ShowS
RSSChannel -> String
(Int -> RSSChannel -> ShowS)
-> (RSSChannel -> String)
-> ([RSSChannel] -> ShowS)
-> Show RSSChannel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RSSChannel] -> ShowS
$cshowList :: [RSSChannel] -> ShowS
show :: RSSChannel -> String
$cshow :: RSSChannel -> String
showsPrec :: Int -> RSSChannel -> ShowS
$cshowsPrec :: Int -> RSSChannel -> ShowS
Show)

data RSSItem =
  RSSItem
    { RSSItem -> Maybe Text
rssItemTitle :: Maybe Text
    , RSSItem -> Maybe Text
rssItemLink :: Maybe URLString
    , RSSItem -> Maybe Text
rssItemDescription :: Maybe Text -- ^if not present, the title is. (per spec, at least.)
    , RSSItem -> Maybe Text
rssItemAuthor :: Maybe Text
    , RSSItem -> [RSSCategory]
rssItemCategories :: [RSSCategory]
    , RSSItem -> Maybe Text
rssItemComments :: Maybe URLString
    , RSSItem -> Maybe Text
rssItemContent :: Maybe Text
    , RSSItem -> Maybe RSSEnclosure
rssItemEnclosure :: Maybe RSSEnclosure
    , RSSItem -> Maybe RSSGuid
rssItemGuid :: Maybe RSSGuid
    , RSSItem -> Maybe Text
rssItemPubDate :: Maybe DateString
    , RSSItem -> Maybe RSSSource
rssItemSource :: Maybe RSSSource
    , RSSItem -> [Attr]
rssItemAttrs :: [Attr]
    , RSSItem -> [Element]
rssItemOther :: [XML.Element]
    }
  deriving (Int -> RSSItem -> ShowS
[RSSItem] -> ShowS
RSSItem -> String
(Int -> RSSItem -> ShowS)
-> (RSSItem -> String) -> ([RSSItem] -> ShowS) -> Show RSSItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RSSItem] -> ShowS
$cshowList :: [RSSItem] -> ShowS
show :: RSSItem -> String
$cshow :: RSSItem -> String
showsPrec :: Int -> RSSItem -> ShowS
$cshowsPrec :: Int -> RSSItem -> ShowS
Show)

data RSSSource =
  RSSSource
    { RSSSource -> Text
rssSourceURL :: URLString
    , RSSSource -> [Attr]
rssSourceAttrs :: [Attr]
    , RSSSource -> Text
rssSourceTitle :: Text
    }
  deriving (Int -> RSSSource -> ShowS
[RSSSource] -> ShowS
RSSSource -> String
(Int -> RSSSource -> ShowS)
-> (RSSSource -> String)
-> ([RSSSource] -> ShowS)
-> Show RSSSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RSSSource] -> ShowS
$cshowList :: [RSSSource] -> ShowS
show :: RSSSource -> String
$cshow :: RSSSource -> String
showsPrec :: Int -> RSSSource -> ShowS
$cshowsPrec :: Int -> RSSSource -> ShowS
Show)

data RSSEnclosure =
  RSSEnclosure
    { RSSEnclosure -> Text
rssEnclosureURL :: URLString
    , RSSEnclosure -> Maybe Integer
rssEnclosureLength :: Maybe Integer
    , RSSEnclosure -> Text
rssEnclosureType :: Text
    , RSSEnclosure -> [Attr]
rssEnclosureAttrs :: [Attr]
    }
  deriving (Int -> RSSEnclosure -> ShowS
[RSSEnclosure] -> ShowS
RSSEnclosure -> String
(Int -> RSSEnclosure -> ShowS)
-> (RSSEnclosure -> String)
-> ([RSSEnclosure] -> ShowS)
-> Show RSSEnclosure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RSSEnclosure] -> ShowS
$cshowList :: [RSSEnclosure] -> ShowS
show :: RSSEnclosure -> String
$cshow :: RSSEnclosure -> String
showsPrec :: Int -> RSSEnclosure -> ShowS
$cshowsPrec :: Int -> RSSEnclosure -> ShowS
Show)

data RSSCategory =
  RSSCategory
    { RSSCategory -> Maybe Text
rssCategoryDomain :: Maybe Text
    , RSSCategory -> [Attr]
rssCategoryAttrs :: [Attr]
    , RSSCategory -> Text
rssCategoryValue :: Text
    }
  deriving (Int -> RSSCategory -> ShowS
[RSSCategory] -> ShowS
RSSCategory -> String
(Int -> RSSCategory -> ShowS)
-> (RSSCategory -> String)
-> ([RSSCategory] -> ShowS)
-> Show RSSCategory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RSSCategory] -> ShowS
$cshowList :: [RSSCategory] -> ShowS
show :: RSSCategory -> String
$cshow :: RSSCategory -> String
showsPrec :: Int -> RSSCategory -> ShowS
$cshowsPrec :: Int -> RSSCategory -> ShowS
Show)

data RSSGuid =
  RSSGuid
    { RSSGuid -> Maybe Bool
rssGuidPermanentURL :: Maybe Bool
    , RSSGuid -> [Attr]
rssGuidAttrs :: [Attr]
    , RSSGuid -> Text
rssGuidValue :: Text
    }
  deriving (Int -> RSSGuid -> ShowS
[RSSGuid] -> ShowS
RSSGuid -> String
(Int -> RSSGuid -> ShowS)
-> (RSSGuid -> String) -> ([RSSGuid] -> ShowS) -> Show RSSGuid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RSSGuid] -> ShowS
$cshowList :: [RSSGuid] -> ShowS
show :: RSSGuid -> String
$cshow :: RSSGuid -> String
showsPrec :: Int -> RSSGuid -> ShowS
$cshowsPrec :: Int -> RSSGuid -> ShowS
Show)

data RSSImage =
  RSSImage
    { RSSImage -> Text
rssImageURL :: URLString -- the URL to the image resource.
    , RSSImage -> Text
rssImageTitle :: Text
    , RSSImage -> Text
rssImageLink :: URLString -- URL that the image resource should be an href to.
    , RSSImage -> Maybe Integer
rssImageWidth :: Maybe Integer
    , RSSImage -> Maybe Integer
rssImageHeight :: Maybe Integer
    , RSSImage -> Maybe Text
rssImageDesc :: Maybe Text
    , RSSImage -> [Element]
rssImageOther :: [XML.Element]
    }
  deriving (Int -> RSSImage -> ShowS
[RSSImage] -> ShowS
RSSImage -> String
(Int -> RSSImage -> ShowS)
-> (RSSImage -> String) -> ([RSSImage] -> ShowS) -> Show RSSImage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RSSImage] -> ShowS
$cshowList :: [RSSImage] -> ShowS
show :: RSSImage -> String
$cshow :: RSSImage -> String
showsPrec :: Int -> RSSImage -> ShowS
$cshowsPrec :: Int -> RSSImage -> ShowS
Show)

data RSSCloud =
  RSSCloud
    { RSSCloud -> Maybe Text
rssCloudDomain :: Maybe Text
    , RSSCloud -> Maybe Text
rssCloudPort :: Maybe Text -- on purpose (i.e., not an int)
    , RSSCloud -> Maybe Text
rssCloudPath :: Maybe Text
    , RSSCloud -> Maybe Text
rssCloudRegisterProcedure :: Maybe Text
    , RSSCloud -> Maybe Text
rssCloudProtocol :: Maybe Text
    , RSSCloud -> [Attr]
rssCloudAttrs :: [Attr]
    }
  deriving (Int -> RSSCloud -> ShowS
[RSSCloud] -> ShowS
RSSCloud -> String
(Int -> RSSCloud -> ShowS)
-> (RSSCloud -> String) -> ([RSSCloud] -> ShowS) -> Show RSSCloud
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RSSCloud] -> ShowS
$cshowList :: [RSSCloud] -> ShowS
show :: RSSCloud -> String
$cshow :: RSSCloud -> String
showsPrec :: Int -> RSSCloud -> ShowS
$cshowsPrec :: Int -> RSSCloud -> ShowS
Show)

data RSSTextInput =
  RSSTextInput
    { RSSTextInput -> Text
rssTextInputTitle :: Text
    , RSSTextInput -> Text
rssTextInputDesc :: Text
    , RSSTextInput -> Text
rssTextInputName :: Text
    , RSSTextInput -> Text
rssTextInputLink :: URLString
    , RSSTextInput -> [Attr]
rssTextInputAttrs :: [Attr]
    , RSSTextInput -> [Element]
rssTextInputOther :: [XML.Element]
    }
  deriving (Int -> RSSTextInput -> ShowS
[RSSTextInput] -> ShowS
RSSTextInput -> String
(Int -> RSSTextInput -> ShowS)
-> (RSSTextInput -> String)
-> ([RSSTextInput] -> ShowS)
-> Show RSSTextInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RSSTextInput] -> ShowS
$cshowList :: [RSSTextInput] -> ShowS
show :: RSSTextInput -> String
$cshow :: RSSTextInput -> String
showsPrec :: Int -> RSSTextInput -> ShowS
$cshowsPrec :: Int -> RSSTextInput -> ShowS
Show)

-- * Default Constructors:
nullRSS ::
     Text -- ^channel title
  -> URLString -- ^channel link
  -> RSS
nullRSS :: Text -> Text -> RSS
nullRSS Text
title Text
link =
  RSS :: Text -> [Attr] -> RSSChannel -> [Element] -> RSS
RSS {rssVersion :: Text
rssVersion = Text
"2.0", rssAttrs :: [Attr]
rssAttrs = [], rssChannel :: RSSChannel
rssChannel = Text -> Text -> RSSChannel
nullChannel Text
title Text
link, rssOther :: [Element]
rssOther = []}

nullChannel ::
     Text -- ^rssTitle
  -> URLString -- ^rssLink
  -> RSSChannel
nullChannel :: Text -> Text -> RSSChannel
nullChannel Text
title Text
link =
  RSSChannel :: Text
-> Text
-> Text
-> [RSSItem]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> [RSSCategory]
-> Maybe Text
-> Maybe Text
-> Maybe RSSCloud
-> Maybe Integer
-> Maybe RSSImage
-> Maybe Text
-> Maybe RSSTextInput
-> Maybe [Integer]
-> Maybe [Text]
-> [Element]
-> RSSChannel
RSSChannel
    { rssTitle :: Text
rssTitle = Text
title
    , rssLink :: Text
rssLink = Text
link
    , rssDescription :: Text
rssDescription = Text
title
    , rssItems :: [RSSItem]
rssItems = []
    , rssLanguage :: Maybe Text
rssLanguage = Maybe Text
forall a. Maybe a
Nothing
    , rssCopyright :: Maybe Text
rssCopyright = Maybe Text
forall a. Maybe a
Nothing
    , rssEditor :: Maybe Text
rssEditor = Maybe Text
forall a. Maybe a
Nothing
    , rssWebMaster :: Maybe Text
rssWebMaster = Maybe Text
forall a. Maybe a
Nothing
    , rssPubDate :: Maybe Text
rssPubDate = Maybe Text
forall a. Maybe a
Nothing
    , rssLastUpdate :: Maybe Text
rssLastUpdate = Maybe Text
forall a. Maybe a
Nothing
    , rssCategories :: [RSSCategory]
rssCategories = []
    , rssGenerator :: Maybe Text
rssGenerator = Maybe Text
forall a. Maybe a
Nothing
    , rssDocs :: Maybe Text
rssDocs = Maybe Text
forall a. Maybe a
Nothing
    , rssCloud :: Maybe RSSCloud
rssCloud = Maybe RSSCloud
forall a. Maybe a
Nothing
    , rssTTL :: Maybe Integer
rssTTL = Maybe Integer
forall a. Maybe a
Nothing
    , rssImage :: Maybe RSSImage
rssImage = Maybe RSSImage
forall a. Maybe a
Nothing
    , rssRating :: Maybe Text
rssRating = Maybe Text
forall a. Maybe a
Nothing
    , rssTextInput :: Maybe RSSTextInput
rssTextInput = Maybe RSSTextInput
forall a. Maybe a
Nothing
    , rssSkipHours :: Maybe [Integer]
rssSkipHours = Maybe [Integer]
forall a. Maybe a
Nothing
    , rssSkipDays :: Maybe [Text]
rssSkipDays = Maybe [Text]
forall a. Maybe a
Nothing
    , rssChannelOther :: [Element]
rssChannelOther = []
    }

nullItem ::
     Text -- ^title
  -> RSSItem
nullItem :: Text -> RSSItem
nullItem Text
title =
  RSSItem :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> [RSSCategory]
-> Maybe Text
-> Maybe Text
-> Maybe RSSEnclosure
-> Maybe RSSGuid
-> Maybe Text
-> Maybe RSSSource
-> [Attr]
-> [Element]
-> RSSItem
RSSItem
    { rssItemTitle :: Maybe Text
rssItemTitle = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
title
    , rssItemLink :: Maybe Text
rssItemLink = Maybe Text
forall a. Maybe a
Nothing
    , rssItemDescription :: Maybe Text
rssItemDescription = Maybe Text
forall a. Maybe a
Nothing
    , rssItemAuthor :: Maybe Text
rssItemAuthor = Maybe Text
forall a. Maybe a
Nothing
    , rssItemCategories :: [RSSCategory]
rssItemCategories = []
    , rssItemComments :: Maybe Text
rssItemComments = Maybe Text
forall a. Maybe a
Nothing
    , rssItemContent :: Maybe Text
rssItemContent = Maybe Text
forall a. Maybe a
Nothing
    , rssItemEnclosure :: Maybe RSSEnclosure
rssItemEnclosure = Maybe RSSEnclosure
forall a. Maybe a
Nothing
    , rssItemGuid :: Maybe RSSGuid
rssItemGuid = Maybe RSSGuid
forall a. Maybe a
Nothing
    , rssItemPubDate :: Maybe Text
rssItemPubDate = Maybe Text
forall a. Maybe a
Nothing
    , rssItemSource :: Maybe RSSSource
rssItemSource = Maybe RSSSource
forall a. Maybe a
Nothing
    , rssItemAttrs :: [Attr]
rssItemAttrs = []
    , rssItemOther :: [Element]
rssItemOther = []
    }

nullSource ::
     URLString -- ^source URL
  -> Text -- ^title
  -> RSSSource
nullSource :: Text -> Text -> RSSSource
nullSource Text
url Text
title = RSSSource :: Text -> [Attr] -> Text -> RSSSource
RSSSource {rssSourceURL :: Text
rssSourceURL = Text
url, rssSourceAttrs :: [Attr]
rssSourceAttrs = [], rssSourceTitle :: Text
rssSourceTitle = Text
title}

nullEnclosure ::
     URLString -- ^enclosure URL
  -> Maybe Integer -- ^enclosure length
  -> Text -- ^enclosure type
  -> RSSEnclosure
nullEnclosure :: Text -> Maybe Integer -> Text -> RSSEnclosure
nullEnclosure Text
url Maybe Integer
mb_len Text
ty =
  RSSEnclosure :: Text -> Maybe Integer -> Text -> [Attr] -> RSSEnclosure
RSSEnclosure
    { rssEnclosureURL :: Text
rssEnclosureURL = Text
url
    , rssEnclosureLength :: Maybe Integer
rssEnclosureLength = Maybe Integer
mb_len
    , rssEnclosureType :: Text
rssEnclosureType = Text
ty
    , rssEnclosureAttrs :: [Attr]
rssEnclosureAttrs = []
    }

newCategory ::
     Text -- ^category Value
  -> RSSCategory
newCategory :: Text -> RSSCategory
newCategory Text
nm =
  RSSCategory :: Maybe Text -> [Attr] -> Text -> RSSCategory
RSSCategory {rssCategoryDomain :: Maybe Text
rssCategoryDomain = Maybe Text
forall a. Maybe a
Nothing, rssCategoryAttrs :: [Attr]
rssCategoryAttrs = [], rssCategoryValue :: Text
rssCategoryValue = Text
nm}

nullGuid ::
     Text -- ^guid value
  -> RSSGuid
nullGuid :: Text -> RSSGuid
nullGuid Text
v = RSSGuid :: Maybe Bool -> [Attr] -> Text -> RSSGuid
RSSGuid {rssGuidPermanentURL :: Maybe Bool
rssGuidPermanentURL = Maybe Bool
forall a. Maybe a
Nothing, rssGuidAttrs :: [Attr]
rssGuidAttrs = [], rssGuidValue :: Text
rssGuidValue = Text
v}

nullPermaGuid ::
     Text -- ^guid value
  -> RSSGuid
nullPermaGuid :: Text -> RSSGuid
nullPermaGuid Text
v = (Text -> RSSGuid
nullGuid Text
v) {rssGuidPermanentURL :: Maybe Bool
rssGuidPermanentURL = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True}

nullImage ::
     URLString -- ^imageURL
  -> Text -- ^imageTitle
  -> URLString -- ^imageLink
  -> RSSImage
nullImage :: Text -> Text -> Text -> RSSImage
nullImage Text
url Text
title Text
link =
  RSSImage :: Text
-> Text
-> Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Text
-> [Element]
-> RSSImage
RSSImage
    { rssImageURL :: Text
rssImageURL = Text
url
    , rssImageTitle :: Text
rssImageTitle = Text
title
    , rssImageLink :: Text
rssImageLink = Text
link
    , rssImageWidth :: Maybe Integer
rssImageWidth = Maybe Integer
forall a. Maybe a
Nothing
    , rssImageHeight :: Maybe Integer
rssImageHeight = Maybe Integer
forall a. Maybe a
Nothing
    , rssImageDesc :: Maybe Text
rssImageDesc = Maybe Text
forall a. Maybe a
Nothing
    , rssImageOther :: [Element]
rssImageOther = []
    }

nullCloud :: RSSCloud
nullCloud :: RSSCloud
nullCloud =
  RSSCloud :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> [Attr]
-> RSSCloud
RSSCloud
    { rssCloudDomain :: Maybe Text
rssCloudDomain = Maybe Text
forall a. Maybe a
Nothing
    , rssCloudPort :: Maybe Text
rssCloudPort = Maybe Text
forall a. Maybe a
Nothing
    , rssCloudPath :: Maybe Text
rssCloudPath = Maybe Text
forall a. Maybe a
Nothing
    , rssCloudRegisterProcedure :: Maybe Text
rssCloudRegisterProcedure = Maybe Text
forall a. Maybe a
Nothing
    , rssCloudProtocol :: Maybe Text
rssCloudProtocol = Maybe Text
forall a. Maybe a
Nothing
    , rssCloudAttrs :: [Attr]
rssCloudAttrs = []
    }

nullTextInput ::
     Text -- ^inputTitle
  -> Text -- ^inputName
  -> URLString -- ^inputLink
  -> RSSTextInput
nullTextInput :: Text -> Text -> Text -> RSSTextInput
nullTextInput Text
title Text
nm Text
link =
  RSSTextInput :: Text -> Text -> Text -> Text -> [Attr] -> [Element] -> RSSTextInput
RSSTextInput
    { rssTextInputTitle :: Text
rssTextInputTitle = Text
title
    , rssTextInputDesc :: Text
rssTextInputDesc = Text
title
    , rssTextInputName :: Text
rssTextInputName = Text
nm
    , rssTextInputLink :: Text
rssTextInputLink = Text
link
    , rssTextInputAttrs :: [Attr]
rssTextInputAttrs = []
    , rssTextInputOther :: [Element]
rssTextInputOther = []
    }