module Text.Atom
( Text(..), EntryContent(..), stringContent, xhtmlContent, binaryContent, srcContent
, Person, mkPerson
, Feed, mkFeed, Entry, mkEntry
, Category, mkCategory, Generator, mkGenerator, defaultGenerator
, Link, LinkRelation(..), mkLink, selfLink
, Attr, get, set, update, has, add, howMany, set', get', delete
, AName(..), AUri(..), AEmail(..), AAuthor(..), ACategory(..)
, AContributor(..), AGenerator(..), AIcon(..), AId(..), ALink(..)
, ALogo(..), ARights(..), ASubtitle(..), ATitle(..), AUpdated(..)
, AEntries(..), AContent(..), APublished(..), ASource(..), ASummary(..)
, ATerm(..), AScheme(..), ALabel(..), AVersion(..), AHref(..), ARel(..)
, AMediatype(..), AHreflang(..), ALength(..)
, PERSON(..), CATEGORY(..), GENERATOR(..), LINK(..), FEED(..), ENTRY(..)
)
where
import Data.Record
import Data.List (genericLength, nubBy, isPrefixOf)
import Data.Char (isSpace)
import Data.Maybe
import Control.Applicative hiding (many)
import Data.Foldable
import Data.Map (findWithDefault, insert, Map)
import qualified Data.Map as M
import Data.Monoid (Sum(..))
import Data.Time (formatTime)
import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..), ZonedTime(..), TimeZone(..), minutesToTimeZone, utc)
import System.Locale (defaultTimeLocale)
import Data.Time.Calendar
import Text.XML.HaXml hiding (version)
import Text.XML.HaXml.Escape (xmlEscape, xmlUnEscape, mkXmlEscaper)
import qualified Text.XML.HaXml.Html.Pretty as P (content)
import Text.XML.HaXml.Xml2Haskell
import Text.PrettyPrint.HughesPJ (hcat)
import qualified Codec.Binary.Base64.String as B64 (encode, decode)
import Prelude hiding (foldr1, foldr, or, any, all, concatMap, concat, elem)
e2e :: (Enum a, Enum b) => a -> b
e2e = toEnum . fromEnum
b64Encode :: String -> String
b64Encode = map e2e . B64.encode . map e2e
b64Decode :: String -> String
b64Decode = map e2e . B64.decode . map e2e
atomEscaper = mkXmlEscaper [('<', "lt"), ('>', "gt"), ('&', "amp"), ('"', "quot")] (`elem` "<>\"")
xEscape :: [Content] -> [Content]
xEscape cs = let Elem _ _ cs' = xmlEscape atomEscaper (Elem "" [] cs) in cs'
xUnEscape :: [Content] -> [Content]
xUnEscape cs = let Elem _ _ cs' = xmlUnEscape atomEscaper (Elem "" [] cs) in cs'
escapeString :: String -> String
escapeString s = fromText' $ xEscape [CString False s]
unEscapeString :: String -> String
unEscapeString s = fromText' $ xUnEscape [CString False s]
data Text = Text String
| HTML String
| XHtml [Content]
instance Show Text where
show (Text s) = "Text "++show s
show (HTML s) = "HTML "++show s
show (XHtml cont) = "XHtml \""++show (hcat (map P.content cont))++"\""
data EntryContent = TextCont Text
| BinaryData String String
| OtherSrc String String
deriving Show
stringContent = TextCont . Text
xhtmlContent = TextCont . XHtml
binaryContent t d | typeChecker t = error "binary data must not text, html, or xhtml"
| otherwise = BinaryData t d
srcContent t url | typeChecker t = error "other src must not text, html, or xhtml"
| otherwise = OtherSrc t url
typeChecker t = any (flip isPrefixOf t) ["text", "html", "xhtml"]
data Person = Person { personName :: !Text
, personUri :: Maybe String
, personEmail :: Maybe String
} deriving Show
mkPerson :: String -> Person
mkPerson s = Person (Text s) Nothing Nothing
data Feed = Feed { feedAuthor :: [Person]
, feedCategory :: [Category]
, feedContributor :: [Person]
, feedGenerator :: [Generator]
, feedIcon :: Maybe String
, feedId :: !String
, feedLink :: [Link]
, feedLogo :: Maybe String
, feedRights :: Maybe Text
, feedSubtitle :: Maybe Text
, feedTitle :: !Text
, feedUpdated :: !ZonedTime
, feedEntries :: [Entry]
} deriving Show
mkFeed :: Person
-> String
-> String
-> String
-> ZonedTime -> Feed
mkFeed a id l t ut = Feed [a] [] [] [defaultGenerator] Nothing id [selfLink l] Nothing Nothing Nothing (Text t) ut []
data Entry = Entry { entryAuthor :: [Person]
, entryCategory :: [Category]
, entryContent :: Maybe EntryContent
, entryContributor :: [Person]
, entryId :: !String
, entryLink :: [Link]
, entryPublished :: Maybe ZonedTime
, entryRights :: Maybe Text
, entrySource :: Maybe Feed
, entrySummary :: Maybe String
, entryTitle :: !Text
, entryUpdated :: !ZonedTime
} deriving Show
mkEntry :: String
-> String
-> EntryContent
-> ZonedTime -> Entry
mkEntry id title content updated = Entry [] [] (Just content) [] id [] Nothing Nothing Nothing Nothing (Text title) updated
data Category = Category { categoryTerm :: !String
, categoryScheme :: Maybe String
, categoryLabel :: Maybe String
} deriving Show
mkCategory :: String -> Category
mkCategory s = Category s Nothing Nothing
data Generator = Generator { generatorName :: !String
, generatorUri :: Maybe String
, generatorVersion :: Maybe String
} deriving Show
mkGenerator :: String -> Generator
mkGenerator s = Generator s Nothing Nothing
defaultGenerator :: Generator
defaultGenerator = Generator "HaskellNet" (Just "http://darcs.haskell.org/SoC/haskellnet/") (Just "0.1")
data Link = Link { linkHref :: !String
, linkRel :: !LinkRelation
, linkMediatype :: Maybe String
, linkHreflang :: Maybe String
, linkTitle :: Maybe String
, linkLength :: Maybe Integer
} deriving Show
data LinkRelation = Alternate | Related | Self | Enclosure | Via deriving Eq
instance Show LinkRelation where
show Alternate = "alternate"
show Related = "related"
show Self = "self"
show Enclosure = "enclosure"
show Via = "via"
instance Read LinkRelation where
readsPrec d s = readParen (d > app_prec) (\s -> concatMap (f s) labels) s
where app_prec = 10
f s (s', l) | s' `isPrefixOf` s = [(l, drop (length s') s)]
| otherwise = []
labels = [ ("alternate", Alternate), ("related", Related)
, ("self", Self), ("enclosure", Enclosure)
, ("via", Via) ]
mkLink :: String -> Link
mkLink s = Link s Alternate Nothing Nothing Nothing Nothing
selfLink :: String -> Link
selfLink s = Link s Self Nothing Nothing Nothing Nothing
class AName r v | r -> v where name :: Attr r v
class AUri r v | r -> v where uri :: Attr r v
class AEmail r v | r -> v where email :: Attr r v
class AAuthor r v | r -> v where author :: Attr r v
class ACategory r v | r -> v where category :: Attr r v
class AContributor r v | r -> v where contributor :: Attr r v
class AGenerator r v | r -> v where generator :: Attr r v
class AIcon r v | r -> v where icon :: Attr r v
class AId r v | r -> v where identifier :: Attr r v
class ALink r v | r -> v where link :: Attr r v
class ALogo r v | r -> v where logo :: Attr r v
class ARights r v | r -> v where rights :: Attr r v
class ASubtitle r v | r -> v where subtitle :: Attr r v
class ATitle r v | r -> v where title :: Attr r v
class AUpdated r v | r -> v where updated :: Attr r v
class AEntries r v | r -> v where entries :: Attr r v
class AContent r v | r -> v where content :: Attr r v
class APublished r v | r -> v where published :: Attr r v
class ASource r v | r -> v where source :: Attr r v
class ASummary r v | r -> v where summary :: Attr r v
class ATerm r v | r -> v where term :: Attr r v
class AScheme r v | r -> v where scheme :: Attr r v
class ALabel r v | r -> v where label :: Attr r v
class AVersion r v | r -> v where version :: Attr r v
class AHref r v | r -> v where href :: Attr r v
class ARel r v | r -> v where rel :: Attr r v
class AMediatype r v | r -> v where mediatype :: Attr r v
class AHreflang r v | r -> v where hreflang :: Attr r v
class ALength r v | r -> v where len :: Attr r v
instance AName Person Text where
name = Attr personName setter
where setter r v = r { personName = v }
instance AUri Person (Maybe String) where
uri = Attr personUri setter
where setter r v = r { personUri = v }
instance AEmail Person (Maybe String) where
email = Attr personEmail setter
where setter r v = r { personEmail = v }
instance AAuthor Feed [Person] where
author = Attr feedAuthor setter
where setter r v | check r v = r { feedAuthor = v }
| otherwise = error "Feed must have at least one author"
check r [] = not $ any (null . get author) $ feedEntries r
check r vs = True
instance ACategory Feed [Category] where
category = Attr feedCategory setter
where setter r v = r { feedCategory = v }
instance AContributor Feed [Person] where
contributor = Attr feedContributor setter
where setter r v = r { feedContributor = v }
instance AGenerator Feed [Generator] where
generator = Attr feedGenerator setter
where setter r v = r { feedGenerator = v }
instance AIcon Feed (Maybe String) where
icon = Attr feedIcon setter
where setter r v = r { feedIcon = v }
instance AId Feed String where
identifier = Attr feedId setter
where setter r v = r { feedId = v }
instance ALink Feed [Link] where
link = Attr feedLink setter
where setter r v | check v = r { feedLink = v }
| otherwise = error "links do not satisfy the specs of atom"
check ls = let ls' = filter ((==Alternate) . get rel) ls
ls'' = filter ((==Self) . get rel) ls
in length (nubBy f1 ls') == length ls' &&
not (null ls'')
f1 a b = get mediatype a == get mediatype b &&
get hreflang a == get hreflang b
instance ALogo Feed (Maybe String) where
logo = Attr feedLogo setter
where setter r v = r { feedLogo = v }
instance ARights Feed (Maybe Text) where
rights = Attr feedRights setter
where setter r v = r { feedRights = v }
instance ASubtitle Feed (Maybe Text) where
subtitle = Attr feedSubtitle setter
where setter r v = r { feedSubtitle = v }
instance ATitle Feed Text where
title = Attr feedTitle setter
where setter r v = r { feedTitle = v }
instance AUpdated Feed ZonedTime where
updated = Attr feedUpdated setter
where setter r v = r { feedUpdated = v }
instance AEntries Feed [Entry] where
entries = Attr feedEntries setter
where setter r v = r { feedEntries = v }
instance AAuthor Entry [Person] where
author = Attr entryAuthor setter
where setter r v = r { entryAuthor = v }
instance ACategory Entry [Category] where
category = Attr entryCategory setter
where setter r v = r { entryCategory = v }
instance AContent Entry (Maybe EntryContent) where
content = Attr entryContent setter
where setter r v = r { entryContent = v }
instance AContributor Entry [Person] where
contributor = Attr entryContributor setter
where setter r v = r { entryContributor = v }
instance AId Entry String where
identifier = Attr entryId setter
where setter r v = r { entryId = v }
instance ALink Entry [Link] where
link = Attr entryLink setter
where setter r v | check r v = r { entryLink = v }
| otherwise = error "links do not satisfy the specs of atom"
check r ls =
let ls' = filter ((==Alternate) . get rel) ls
in length (nubBy f1 ls') == length ls' &&
(isJust (entryContent r) || not (null ls'))
f1 a b = get mediatype a == get mediatype b &&
get hreflang a == get hreflang b
instance APublished Entry (Maybe ZonedTime) where
published = Attr entryPublished setter
where setter r v = r { entryPublished = v }
instance ARights Entry (Maybe Text) where
rights = Attr entryRights setter
where setter r v = r { entryRights = v }
instance ASource Entry (Maybe Feed) where
source = Attr entrySource setter
where setter r v = r { entrySource = fmap (delete entries) v }
instance ASummary Entry (Maybe String) where
summary = Attr entrySummary setter
where setter r Nothing | check (get content r) = error "summary is required to this entry"
setter r v = r { entrySummary = v }
check (Just (BinaryData _ _)) = True
check (Just (OtherSrc _ _)) = True
check _ = False
instance ATitle Entry Text where
title = Attr entryTitle setter
where setter r v = r { entryTitle = v }
instance AUpdated Entry ZonedTime where
updated = Attr entryUpdated setter
where setter r v = r { entryUpdated = v }
instance ATerm Category String where
term = Attr categoryTerm setter
where setter r v = r { categoryTerm = v }
instance AScheme Category (Maybe String) where
scheme = Attr categoryScheme setter
where setter r v = r { categoryScheme = v }
instance ALabel Category (Maybe String) where
label = Attr categoryLabel setter
where setter r v = r { categoryLabel = v }
instance AName Generator String where
name = Attr generatorName setter
where setter r v = r { generatorName = v }
instance AUri Generator (Maybe String) where
uri = Attr generatorUri setter
where setter r v = r { generatorUri = v }
instance AVersion Generator (Maybe String) where
version = Attr generatorVersion setter
where setter r v = r { generatorVersion = v }
instance AHref Link String where
href = Attr linkHref setter
where setter r v = r { linkHref = v }
instance ARel Link LinkRelation where
rel = Attr linkRel setter
where setter r v = r { linkRel = v }
instance AMediatype Link (Maybe String) where
mediatype = Attr linkMediatype setter
where setter r v = r { linkMediatype = v }
instance AHreflang Link (Maybe String) where
hreflang = Attr linkHreflang setter
where setter r v = r { linkHreflang = v }
instance ATitle Link (Maybe String) where
title = Attr linkTitle setter
where setter r v = r { linkTitle = v }
instance ALength Link (Maybe Integer) where
len = Attr linkLength setter
where setter r v = r { linkLength = v }
class (AName r Text, AUri r (Maybe String), AEmail r (Maybe String))
=> PERSON r
instance PERSON Person
class (ATerm r String, AScheme r (Maybe String), ALabel r (Maybe String))
=> CATEGORY r
instance CATEGORY Category
class (AName r String, AUri r (Maybe String), AVersion r (Maybe String))
=> GENERATOR r
instance GENERATOR Generator
class ( AHref r String, ARel r LinkRelation, AMediatype r (Maybe String)
, AHreflang r (Maybe String), ATitle r (Maybe String)
, ALength r (Maybe Integer))
=> LINK r
instance LINK Link
class ( AAuthor r [Person], ACategory r [Category], AContributor r [Person]
, AGenerator r [Generator], AIcon r (Maybe String), AId r String
, ALink r [Link], ALogo r (Maybe String), ARights r (Maybe Text)
, ASubtitle r (Maybe Text), ATitle r Text, AUpdated r ZonedTime)
=> FEED r
instance FEED Feed
class ( AAuthor r [Person], ACategory r [Category]
, AContent r (Maybe EntryContent), AContributor r [Person], AId r String
, ALink r [Link], APublished r (Maybe ZonedTime), ARights r (Maybe Text)
, ASource r (Maybe Feed), ASummary r (Maybe String)
, ATitle r Text, AUpdated r ZonedTime)
=> ENTRY r
instance ENTRY Entry
s2cont :: String -> Content
s2cont s = CString False (escapeString s)
simpleCont :: String -> [Content] -> Content
simpleCont t cs = CElem $ Elem t [] cs
p2cont :: String -> Person -> Content
p2cont t p = simpleCont t (n:(u++m))
where n = t2cont "name" $ get name p
u = toList $ fmap (\u -> simpleCont "uri" [s2cont u]) $ get uri p
m = toList $ fmap (\m -> simpleCont "email" [s2cont m]) $ get email p
cont2p :: Content -> Person
cont2p (CElem (Elem _ _ cs)) = Person n u m
where n = cont2t $ head $ getTags "name" cs
u = fmap fromText' $ listToMaybe $ getChildren "uri" cs
m = fmap fromText' $ listToMaybe $ getChildren "email" cs
t2cont :: String -> Text -> Content
t2cont t (Text s) = CElem $ Elem t [("type", str2attr "text")] [s2cont s]
t2cont t (HTML s) = CElem $ Elem t [("type", str2attr "html")] [s2cont s]
t2cont t (XHtml cont) = CElem $ Elem t [("type", str2attr "xhtml")] [CElem $ Elem "div" [("xmlns", str2attr "http://www.w3.org/1999/xhtml")] cont]
cont2t :: Content -> Text
cont2t (CElem (Elem _ ats cs)) =
case typ of
Just t | t == "html" || t == "text/html" -> HTML contText
| t == "xhtml" || t == "text/xhtml" -> XHtml cont
_ -> Text contText
where typ = possibleA fromAttrToStr "type" ats
contText = fromText' $ xUnEscape cs
cont = stripSpaces `o` children $ head cs
zt2cont :: String -> ZonedTime -> Content
zt2cont t (ZonedTime d (TimeZone diffs _ _))
= simpleCont t [s2cont $ formatTime defaultTimeLocale "%FT%T" d ++ zs ]
where zs = if diffs == 0 then "Z"
else let (zh,zm) = diffs `divMod` 60
(zh',zm') = if diffs < 0 && zm /= 0
then (zh+1,60zm) else (zh,zm)
sig = if zh' < 0 then '-' else '+'
in sig : show2 zh' ++ ":" ++ show2 zm'
show2 n | abs n < 10 = '0':show (abs n)
| otherwise = show n
breaks :: Char -> String -> [String]
breaks c s = case rest of
[] -> [s1]
(_:s') -> s1:breaks c s'
where (s1, rest) = break (==c) s
s2zt :: String -> ZonedTime
s2zt s = let (d, _:h') = break (=='T') s
(h, z) = break (`elem` "+-Z") h'
(year:mon:day:_) = breaks '-' d
(hour:min:sec:_) = breaks ':' h
zone = case z of
"Z" -> utc
zs@(_:_) ->
let (zh:zm:_) = map read $ breaks ':' zs
in minutesToTimeZone ((abs zh * 60 + zm) * signum zh)
_ -> utc
in ZonedTime (LocalTime (fromGregorian (read year) (read mon) (read day))
(TimeOfDay (read hour) (read min) (fromRational $ toRational (read sec::Double))))
zone
fromMany :: (XmlContent a) => [Content] -> [a]
fromMany = fst . many fromElem
fromText' :: [Content] -> String
fromText' = concat . fst . many fromText
getTags :: String -> [Content] -> [Content]
getTags s = concatMap (tag s)
getChildren :: String -> [Content] -> [[Content]]
getChildren s = dropWhile null . map (tag s /> keep)
stripSpaces :: CFilter
stripSpaces = foldXml (ifTxt (\s -> if all isSpace s then none else keep) keep)
instance XmlContent Category where
fromElem css@(CElem (Elem "category" ats cs):rest) =
case lookup "term" ats of
Just v -> (Just (Category (attr2str v) s l), rest)
Nothing -> (Nothing, css)
where s = possibleA fromAttrToStr "scheme" ats
l = possibleA fromAttrToStr "label" ats
fromElem css = (Nothing, css)
toElem c = [CElem (Elem "category" (catMaybes [t, s, l]) [])]
where t = Just ("term", str2attr $ get term c)
s = get scheme c >>= return . (,) "scheme" . str2attr
l = get label c >>= return . (,) "label" . str2attr
instance XmlContent Generator where
fromElem (CElem (Elem "generator" ats cs):rest) =
(Just (Generator n u v), rest)
where n = fromText' cs
u = possibleA fromAttrToStr "uri" ats
v = possibleA fromAttrToStr "version" ats
fromElem cs = (Nothing, cs)
toElem g = [CElem $ Elem "generator" (catMaybes [u, v])
[s2cont $ get name g]]
where u = get uri g >>= Just . (,) "uri" . str2attr
v = get version g >>= Just . (,) "version" . str2attr
instance XmlContent Link where
fromElem (CElem (Elem "link" ats cs):rest) =
(Just (Link hr r t hl ti len), rest)
where hr = case possibleA fromAttrToStr "href" ats of
Nothing -> error "link requires href attribute"
Just v -> v
r = maybe Alternate read $ possibleA fromAttrToStr "rel" ats
t = possibleA fromAttrToStr "type" ats
hl = possibleA fromAttrToStr "hreflang" ats
ti = possibleA fromAttrToStr "title" ats
len = fmap read $ possibleA fromAttrToStr "length" ats
fromElem cs = (Nothing, cs)
toElem l = [CElem $ Elem "link" (hr:r:catMaybes [t,hl,ti,len']) []]
where hr = ("href", str2attr $ get href l)
r = ("rel", str2attr $ show $ get rel l)
t = get mediatype l >>= return . (,) "type" . str2attr
hl = get hreflang l >>= return . (,) "hreflang" . str2attr
ti = get title l >>= return . (,) "title" . str2attr
len' = get len l >>= return . (,) "length" . str2attr . show
instance XmlContent EntryContent where
fromElem (CElem (Elem "content" ats cs):rest) =
case possibleA fromAttrToStr "type" ats of
Just "text" -> (Just $ TextCont $ Text inText, rest)
Just "html" -> (Just $ TextCont $ HTML inText, rest)
Just "xhtml" -> (Just $ TextCont $ XHtml inHtml, rest)
Just "text/html" -> (Just $ TextCont $ HTML inText, rest)
Just "text/xhtml" -> (Just $ TextCont $ XHtml inHtml, rest)
Just s | "text" `isPrefixOf` s ->
(Just $ TextCont $ Text inText, rest)
| otherwise -> case src of
Just d -> (Just $ OtherSrc s d, rest)
Nothing -> (Just $ BinaryData s $ b64Decode inText, rest)
where inText = fromText' cs
inHtml = concatMap stripSpaces $ head $ getChildren "div" $ cs
src = possibleA fromAttrToStr "src" ats
fromElem cs = (Nothing, cs)
toElem (TextCont (Text s)) = [CElem $ Elem "content" [("type", str2attr "text")] [s2cont s]]
toElem (TextCont (HTML s)) = [CElem $ Elem "content" [("type", str2attr "html")] [s2cont s]]
toElem (TextCont (XHtml cont)) = [CElem $ Elem "content" [("type", str2attr "xhtml")] [CElem $ Elem "div" [("xmlns", str2attr "http://www.w3.org/1999/xhtml")] cont]]
toElem (BinaryData t d) = [CElem $ Elem "content" [("type", str2attr t)] [CString False (b64Encode d)]]
toElem (OtherSrc t d) = [CElem $ Elem "content" [ ("type", str2attr t), ("src", str2attr t)] []]
instance XmlContent Entry where
fromElem (CElem (Elem "entry" _ cs):rest) =
(Just $ Entry authors cats content conts ident links pubd rts src summ tit upd, rest)
where authors = map cont2p $ getTags "author" cs
cats = fromMany $ getTags "category" cs
content = listToMaybe $ fromMany $ getTags "content" cs
conts = map cont2p $ getTags "contributor" cs
ident = fromText' $ head $ getChildren "id" cs
links = fromMany $ getTags "link" cs
pubd = fmap (s2zt . fromText') $ listToMaybe $ getChildren "published" cs
rts = fmap cont2t $ listToMaybe $ getTags "rights" cs
src = (listToMaybe $ getChildren "source" cs) >>= fst . fromElem
summ = fmap fromText' $ listToMaybe $ getChildren "summary" cs
tit = cont2t $ head $ getTags "title" cs
upd = s2zt $ fromText' $ head $ getChildren "updated" cs
fromElem rest = (Nothing, rest)
toElem e = [CElem $ Elem "entry" [] (concat [authors, cats, contents, conts, ident, links, pubd, rts, src, summ, tit, upd])]
where authors = map (p2cont "author") $ get author e
cats = toElem $ get category e
contents = toElem $ get content e
conts = map (p2cont "contributor") $ get contributor e
ident = [simpleCont "id" [s2cont $ get identifier e]]
links = toElem $ get link e
pubd = toList $ fmap (zt2cont "published") $ get published e
rts = toList $ fmap (t2cont "rights") $ get rights e
src = toList $ fmap (\s -> CElem (Elem "source" [] (toElem s))) $ get source e
summ = toList $ fmap (\s -> simpleCont "summary" [s2cont s]) $ get summary e
tit = [t2cont "title" $ get title e]
upd = [zt2cont "updated" $ get updated e]
instance XmlContent Feed where
fromElem (CElem (Elem "feed" _ cs):rest) =
(Just $ Feed authors cats conts gens ic ident links lg rts subtit tit upd ents, rest)
where authors = map cont2p $ getTags "author" cs
cats = fromMany $ getTags "category" cs
conts = map cont2p $ getTags "contributor" cs
gens = fromMany $ getTags "generator" cs
ic = fmap fromText' $ listToMaybe $ getChildren "icon" cs
ident = fromText' $ head $ getChildren "id" cs
links = fromMany $ getTags "link" cs
lg = fmap fromText' $ listToMaybe $ getChildren "logo" cs
rts = fmap cont2t $ listToMaybe $ getTags "rights" cs
subtit = fmap cont2t $ listToMaybe $ getTags "subtitle" cs
tit = cont2t $ head $ getTags "title" cs
upd = s2zt $ fromText' $ head $ getChildren "updated" cs
ents = fromMany $ getTags "entry" cs
fromElem rest = (Nothing, rest)
toElem f = [CElem $ Elem "feed" [("xmlns", str2attr "http://www.w3.org/2005/Atom")] (concat [authors, cats, conts, gens, ic, ident, links, lg, rts, subtit, tit, upd, ents])]
where authors = map (p2cont "author") $ get author f
cats = toElem $ get category f
conts = map (p2cont "contributor") $ get contributor f
gens = toElem $ get generator f
ic = toList $ fmap (\i -> simpleCont "icon" [s2cont i]) $ get icon f
ident = [simpleCont "id" [s2cont $ get identifier f]]
links = toElem $ get link f
lg = toList $ fmap (\l -> simpleCont "logo" [s2cont l]) $ get logo f
rts = toList $ fmap (t2cont "rights") $ get rights f
subtit = toList $ fmap (t2cont "subtitle") $ get subtitle f
tit = [t2cont "title" $ get title f]
upd = [zt2cont "updated" $ get updated f]
ents = toElem $ feedEntries f