| Safe Haskell | Safe-Inferred |
|---|---|
| Language | Haskell2010 |
Web.Atom
Description
You use this package by specifying XMLGen generator functions,
constructing a Feed, and then using the feedXML function to generate the
XML.
For example, using the xml package to generate our XML could look like this:
{-# LANGUAGE OverloadedStrings #-}
import qualified Data.Text as T
import Data.Time (UTCTime (..), fromGregorian)
import Text.XML.Light
import qualified Web.Atom as Atom
xmlgen :: Atom.XMLGen Element Content QName Attr
xmlgen = Atom.XMLGen
{ Atom.xmlElem = \n as ns -> Element n as ns Nothing
, Atom.xmlName = \nsMay name -> QName (T.unpack name)
(fmap T.unpack nsMay) Nothing
, Atom.xmlAttr = \k v -> Attr k (T.unpack v)
, Atom.xmlTextNode = \t -> Text $ CData CDataText (T.unpack t) Nothing
, Atom.xmlElemNode = Elem
}
feed :: Atom.Feed Element
feed = Atom.makeFeed
(Atom.unsafeURI "https://haskell.org/")
(Atom.TextHTML "The <em>Title</em>")
(UTCTime (fromGregorian 2015 7 8) 0)
main = putStrLn $ showTopElement $ Atom.feedXML xmlgen feedOr you might want to use the xml-conduit package:
{-# LANGUAGE OverloadedStrings #-}
import Data.Map.Lazy (fromList)
import qualified Data.Text as T
import qualified Data.Text.Lazy.IO as TL
import Data.Time (UTCTime (..), fromGregorian)
import Text.XML
import qualified Web.Atom as Atom
xmlgen :: Atom.XMLGen Element Node Name (Name, T.Text)
xmlgen = Atom.XMLGen
{ Atom.xmlElem = \n as ns -> Element n (fromList as) ns
, Atom.xmlName = \nsMay name -> Name name nsMay Nothing
, Atom.xmlAttr = \k v -> (k, v)
, Atom.xmlTextNode = NodeContent
, Atom.xmlElemNode = NodeElement
}
feed :: Atom.Feed Element
feed = Atom.makeFeed
(Atom.unsafeURI "https://haskell.org/")
(Atom.TextHTML "The <em>Title</em>")
(UTCTime (fromGregorian 2015 7 8) 0)
main = TL.putStrLn $ renderText def (Document (Prologue [] Nothing []) xml [])
where xml = Atom.feedXML xmlgen feed- makeFeed :: URI -> Text e -> UTCTime -> Feed e
- makeEntry :: URI -> Text e -> UTCTime -> Entry e
- feedXML :: XMLGen e node name attr -> Feed e -> e
- entryXML :: XMLGen e node name attr -> Entry e -> e
- data XMLGen elem node name attr = XMLGen {
- xmlElem :: name -> [attr] -> [node] -> elem
- xmlName :: Maybe Text -> Text -> name
- xmlAttr :: name -> Text -> attr
- xmlTextNode :: Text -> node
- xmlElemNode :: elem -> node
- data Feed e = Feed {
- feedId :: URI
- feedTitle :: Text e
- feedUpdated :: UTCTime
- feedSubtitle :: Maybe (Text e)
- feedIcon :: Maybe URI
- feedLogo :: Maybe URI
- feedRights :: Maybe (Text e)
- feedGenerator :: Maybe Generator
- feedAuthors :: [Person]
- feedContributors :: [Person]
- feedCategories :: [Category]
- feedLinks :: [Link]
- feedEntries :: [Entry e]
- data Entry e = Entry {
- entryId :: URI
- entryTitle :: Text e
- entryUpdated :: UTCTime
- entryPublished :: Maybe UTCTime
- entrySummary :: Maybe (Text e)
- entryContent :: Maybe (Content e)
- entryRights :: Maybe (Text e)
- entrySource :: Maybe (Source e)
- entryAuthors :: [Person]
- entryContributors :: [Person]
- entryCategories :: [Category]
- entryLinks :: [Link]
- data Source e = Source {
- sourceId :: Maybe URI
- sourceTitle :: Maybe (Text e)
- sourceUpdated :: Maybe UTCTime
- sourceSubtitle :: Maybe (Text e)
- sourceIcon :: Maybe URI
- sourceLogo :: Maybe URI
- sourceRights :: Maybe (Text e)
- sourceGenerator :: Maybe Generator
- sourceAuthors :: [Person]
- sourceContributors :: [Person]
- sourceCategories :: [Category]
- sourceLinks :: [Link]
- data Content e
- data Category = Category {}
- data Generator = Generator {
- generatorName :: Text
- generatorURI :: Maybe URI
- version :: Maybe Text
- data Person = Person {
- personName :: Text
- personURI :: Maybe URI
- personEmail :: Maybe Email
- data Email = Email Text
- data Rel
- data Text e
- data Link = Link {}
- data LanguageTag = LanguageTag Text
- data MediaType = MediaType ByteString
- data UTCTime :: *
- unsafeURI :: String -> URI
- data URI :: * = URI {}
Documentation
Convenience constructor with defaults for all non-required fields.
Convenience constructor with defaults for all non-required fields.
data XMLGen elem node name attr Source
This record defines what kind of XML we should construct. A valid
definition of this record must be provided to the feedXML and entryXML
functions. This lets users use the XML library of their choice for the Atom
feed XML. A couple of concrete examples are provided at the top of this
page. Here's an example that uses the
xml-conduit package:
xmlgen :: Atom.XMLGen Element Node Name (Name, T.Text)
xmlgen = Atom.XMLGen
{ Atom.xmlElem = \n as ns -> Element n (fromList as) ns
, Atom.xmlName = \nsMay name -> Name name nsMay Nothing
, Atom.xmlAttr = \k v -> (k, v)
, Atom.xmlTextNode = NodeContent
, Atom.xmlElemNode = NodeElement
}Constructors
| XMLGen | |
Fields
| |
Top-level element for an Atom Feed Document as per https://tools.ietf.org/html/rfc4287#section-4.1.1.
Constructors
| Feed | |
Fields
| |
An individual Atom entry that can be used either as a child of Feed or
as the top-level element of a stand-alone Atom Entry Document as per
https://tools.ietf.org/html/rfc4287#section-4.1.2.
Constructors
| Entry | |
Fields
| |
If an Atom entry is copied into a different feed, Source can be used to
preserve the metadata of the original feed as per
https://tools.ietf.org/html/rfc4287#section-4.2.11.
Constructors
| Source | |
Fields
| |
Content or link to content of an Atom entry as per https://tools.ietf.org/html/rfc4287#section-4.1.3.
Information about a feed or entry category as per https://tools.ietf.org/html/rfc4287#section-4.2.2.
Constructors
| Category | |
Fields
| |
Identifies the agent used to generate the feed, for debugging and other purposes as per https://tools.ietf.org/html/rfc4287#section-4.2.4.
Constructors
| Generator | |
Fields
| |
Describes a person as per https://tools.ietf.org/html/rfc4287#section-3.2.
Constructors
| Person | |
Fields
| |
An email address. xsd:string { pattern = ".+.+" }@
rel attribute for link elements as per
https://tools.ietf.org/html/rfc4287#section-4.2.7.2.
Human readable text as per https://tools.ietf.org/html/rfc4287#section-3.1.
Defines a reference to a web resource as per https://tools.ietf.org/html/rfc4287#section-4.2.7.
Constructors
| Link | |
data LanguageTag Source
Langauge tag as per https://tools.ietf.org/html/rfc3066.
Constructors
| LanguageTag Text |
Instances
A media type. xsd:string { pattern = ".+/.+" }
Constructors
| MediaType ByteString |
data UTCTime :: *
This is the simplest representation of UTC. It consists of the day number, and a time offset from midnight. Note that if a day has a leap second added to it, it will have 86401 seconds.
unsafeURI :: String -> URI Source
Convenience function to create a URIs from hardcoded strings. /This function is partial so only use this if you're hardcoding the URI string and you're sure that it's valid./