gdritter repos lektor / master lektor-rss / src / Atom.hs
master

Tree @master (Download .tar.gz)

Atom.hs @masterraw · history · blame

{-# LANGUAGE RecordWildCards #-}

module Atom (atomToLektor) where

import           Data.Monoid ((<>))
import           Text.Atom.Feed
import           Text.XML.Light.Output

import qualified Lektor as L

atomToLektor :: Feed -> (L.Feed, [L.Entry])
atomToLektor Feed { .. } = (lfeed, lentries)
  where lentries = map toEntry feedEntries
        lfeed = L.Feed
          { L.feedId     = feedId
          , L.feedName   = toString feedTitle
          , L.feedDescr  = fmap toString feedSubtitle
          , L.feedLang   = Nothing
          , L.feedImage  = feedLogo
          , L.feedCopy   = fmap toString feedRights
          , L.feedAuthor = toPeople feedAuthors
          }

toEntry :: Entry -> L.Entry
toEntry Entry { .. } = L.Entry
  { L.entryId      = entryId
  , L.entryTitle   = toString entryTitle
  , L.entryContent = maybe "" entryToString entryContent
  , L.entryAuthor  = toPeople entryAuthors
  , L.entryPubdate = Just entryUpdated
  , L.entryType    = fmap entryToType entryContent
  }

toString :: TextContent -> String
toString (TextString s)  = s
toString (HTMLString s)  = s
toString (XHTMLString e) = showElement e

entryToString :: EntryContent -> String
entryToString (TextContent s)       = s
entryToString (HTMLContent s)       = s
entryToString (XHTMLContent e)      = showElement e
entryToString (MixedContent _ _)    = "[unimplemented]"
entryToString (ExternalContent _ _) = "[unimplemented]"

entryToType :: EntryContent -> String
entryToType HTMLContent {}  = "text/html"
entryToType XHTMLContent {} = "text/xhtml"
entryToType _               = "text/plain"

toPeople :: [Person] -> Maybe String
toPeople [] = Nothing
toPeople xs = Just (unlines (map toPerson xs))

toPerson :: Person -> String
toPerson p = case personEmail p of
  Just e  -> personName p <> " <" <> e <> ">"
  Nothing -> personName p