atom-conduit 0.2.0.0 → 0.3.0.0

raw patch · 6 files changed

+268/−184 lines, 6 filesdep +lens-simpledep −lensdep −totaldep ~uri-bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: lens-simple

Dependencies removed: lens, total

Dependency ranges changed: uri-bytestring

API changes (from Hackage documentation)

Files

• Text/Atom/Conduit/Parse.hs +27/−25
• Text/Atom/Conduit/Render.hs +56/−58
• Text/Atom/Lens.hs +90/−0
• Text/Atom/Types.hs +73/−79
• atom-conduit.cabal +4/−4
• test/Main.hs +18/−18

@@ -28,7 +28,6 @@  import           Control.Applicative import           Control.Foldl           hiding (mconcat, set)-import           Control.Lens.TH import           Control.Monad           hiding (foldM) import           Control.Monad.Catch @@ -45,6 +44,8 @@ import           Data.Time.RFC3339 import           Data.XML.Types +import           Lens.Simple+ import           Prelude                 hiding (last, lookup)  import           Text.Parser.Combinators@@ -57,15 +58,16 @@                    | NullElement  deriving instance Eq AtomException-instance Show AtomException where-  show (InvalidURI e) = "Invalid URI reference: " ++ show e-  show NullElement = "Null element."-instance Exception AtomException+deriving instance Show AtomException -asUriReference :: (MonadThrow m) => Text -> m UriReference-asUriReference t = case (parseURI' t, parseRelativeRef' t) of-  (Right u, _) -> return $ UriReferenceUri u-  (_, Right u) -> return $ UriReferenceRelativeRef u+instance Exception AtomException where+  displayException (InvalidURI e) = "Invalid URI reference: " ++ show e+  displayException NullElement = "Null element"++asURIReference :: (MonadThrow m) => Text -> m AtomURI+asURIReference t = case (parseURI' t, parseRelativeRef' t) of+  (Right u, _) -> return $ AtomURI u+  (_, Right u) -> return $ AtomURI u   (Left _, Left e) -> throwM $ InvalidURI e   where parseURI' = parseURI laxURIParserOptions . encodeUtf8         parseRelativeRef' = parseRelativeRef laxURIParserOptions . encodeUtf8@@ -91,9 +93,9 @@ atomId :: (MonadCatch m) => ConduitParser Event m (NonNull Text) atomId = tagIgnoreAttrs' "id" $ content asNonNull -atomIcon, atomLogo :: (MonadCatch m) => ConduitParser Event m UriReference-atomIcon = tagIgnoreAttrs' "icon" $ content asUriReference-atomLogo = tagIgnoreAttrs' "logo" $ content asUriReference+atomIcon, atomLogo :: (MonadCatch m) => ConduitParser Event m AtomURI+atomIcon = tagIgnoreAttrs' "icon" $ content asURIReference+atomLogo = tagIgnoreAttrs' "logo" $ content asURIReference  lastRequired :: (Monad m, Parsing m) => String -> FoldM m a a lastRequired e = FoldM (\_ a -> return $ Right a) (return $ Left e) (either unexpected return)@@ -102,10 +104,10 @@  data PersonPiece = PersonName (NonNull Text)                  | PersonEmail Text-                 | PersonUri UriReference+                 | PersonUri AtomURI                  | PersonUnknown -makePrisms ''PersonPiece+makeTraversals ''PersonPiece  -- | Parse an Atom person construct. -- Example:@@ -125,7 +127,7 @@   where piece :: (MonadCatch m) => ConduitParser Event m PersonPiece         piece = choice [ PersonName <$> tagIgnoreAttrs' "name" (content asNonNull)                        , PersonEmail <$> tagIgnoreAttrs' "email" textContent-                       , PersonUri <$> tagIgnoreAttrs' "uri" (content asUriReference)+                       , PersonUri <$> tagIgnoreAttrs' "uri" (content asURIReference)                        , PersonUnknown <$ unknownTag                        ] @@ -146,7 +148,7 @@ -- | Parse an @atom:content@ element. atomContent :: (MonadCatch m) => ConduitParser Event m AtomContent atomContent = tagName' "content" contentAttrs handler-  where contentAttrs = (,) <$> optional (textAttr "type") <*> optional (attr "src" asUriReference) <* ignoreAttrs+  where contentAttrs = (,) <$> optional (textAttr "type") <*> optional (attr "src" asURIReference) <* ignoreAttrs         handler (Just "xhtml", _) = AtomContentInlineXHTML <$> tagIgnoreAttrs' "div" textContent         handler (ctype, Just uri) = return $ AtomContentOutOfLine (fromMaybe mempty ctype) uri         handler (Just "html", _) = AtomContentInlineText TypeHTML <$> textContent@@ -162,7 +164,7 @@ atomLink :: (MonadCatch m) => ConduitParser Event m AtomLink atomLink = tagName' "link" linkAttrs $ \(href, rel, ltype, lang, title, length') ->   return $ AtomLink href rel ltype lang title length'-  where linkAttrs = (,,,,,) <$> attr "href" asUriReference+  where linkAttrs = (,,,,,) <$> attr "href" asURIReference                             <*> (textAttr "rel" <|> pure mempty)                             <*> (textAttr "type" <|> pure mempty)                             <*> (textAttr "hreflang" <|> pure mempty)@@ -205,24 +207,24 @@ -- > </generator> atomGenerator :: (MonadCatch m) => ConduitParser Event m AtomGenerator atomGenerator = tagName' "generator" generatorAttrs $ \(uri, version) -> AtomGenerator uri version <$> (asNonNull =<< textContent)-  where generatorAttrs = (,) <$> optional (attr "uri" asUriReference) <*> (textAttr "version" <|> pure mempty) <* ignoreAttrs+  where generatorAttrs = (,) <$> optional (attr "uri" asURIReference) <*> (textAttr "version" <|> pure mempty) <* ignoreAttrs   data SourcePiece = SourceAuthor AtomPerson                  | SourceCategory AtomCategory                  | SourceContributor AtomPerson                  | SourceGenerator AtomGenerator-                 | SourceIcon UriReference+                 | SourceIcon AtomURI                  | SourceId Text                  | SourceLink AtomLink-                 | SourceLogo UriReference+                 | SourceLogo AtomURI                  | SourceRights AtomText                  | SourceSubtitle AtomText                  | SourceTitle AtomText                  | SourceUpdated UTCTime                  | SourceUnknown -makePrisms ''SourcePiece+makeTraversals ''SourcePiece  -- | Parse an @atom:source@ element. -- Example:@@ -280,7 +282,7 @@                 | EntryUpdated     UTCTime                 | EntryUnknown -makePrisms ''EntryPiece+makeTraversals ''EntryPiece  -- | Parse an @atom:entry@ element. atomEntry :: (MonadCatch m) => ConduitParser Event m AtomEntry@@ -321,17 +323,17 @@                | FeedContributor AtomPerson                | FeedEntry AtomEntry                | FeedGenerator AtomGenerator-               | FeedIcon UriReference+               | FeedIcon AtomURI                | FeedId (NonNull Text)                | FeedLink AtomLink-               | FeedLogo UriReference+               | FeedLogo AtomURI                | FeedRights AtomText                | FeedSubtitle AtomText                | FeedTitle AtomText                | FeedUpdated UTCTime                | FeedUnknown -makePrisms ''FeedPiece+makeTraversals ''FeedPiece  -- | Parse an @atom:feed@ element. atomFeed :: (MonadCatch m) => ConduitParser Event m AtomFeed

@@ -18,9 +18,9 @@   ) where  -- {{{ Imports+import           Text.Atom.Lens import           Text.Atom.Types -import           Control.Lens.Getter import           Control.Monad  import           Data.Conduit@@ -33,6 +33,8 @@ import           Data.Time.RFC3339 import           Data.XML.Types +import           Lens.Simple+ import           Text.XML.Stream.Render  import           URI.ByteString@@ -41,41 +43,41 @@ -- | Render the top-level @atom:feed@ element. renderAtomFeed :: (Monad m) => AtomFeed -> Source m Event renderAtomFeed f = tag "feed" (attr "xmlns" "http://www.w3.org/2005/Atom") $ do-  forM_ (f^.feedAuthors_) $ renderAtomPerson "author"-  forM_ (f^.feedCategories_) renderAtomCategory-  forM_ (f^.feedContributors_) $ renderAtomPerson "contributor"-  forM_ (f^.feedEntries_) renderAtomEntry-  forM_ (f^.feedGenerator_) renderAtomGenerator-  forM_ (f^.feedIcon_) $ tag "icon" mempty . content . decodeUtf8 . serializeUriReference'-  tag "id" mempty . content . toNullable $ f^.feedId_-  forM_ (f^.feedLinks_) renderAtomLink-  forM_ (f^.feedLogo_) $ tag "logo" mempty . content . decodeUtf8 . serializeUriReference'-  forM_ (f^.feedRights_) $ renderAtomText "rights"-  forM_ (f^.feedSubtitle_) $ renderAtomText "subtitle"-  renderAtomText "title" $ f^.feedTitle_-  dateTag "updated" $ f^.feedUpdated_+  forM_ (f^.feedAuthorsL) $ renderAtomPerson "author"+  forM_ (f^.feedCategoriesL) renderAtomCategory+  forM_ (f^.feedContributorsL) $ renderAtomPerson "contributor"+  forM_ (f^.feedEntriesL) renderAtomEntry+  forM_ (f^.feedGeneratorL) renderAtomGenerator+  forM_ (feedIcon f) $ tag "icon" mempty . content . decodeUtf8 . withAtomURI serializeURIRef'+  tag "id" mempty . content . toNullable $ f^.feedIdL+  forM_ (f^.feedLinksL) renderAtomLink+  forM_ (feedLogo f) $ tag "logo" mempty . content . decodeUtf8 . withAtomURI serializeURIRef'+  forM_ (f^.feedRightsL) $ renderAtomText "rights"+  forM_ (f^.feedSubtitleL) $ renderAtomText "subtitle"+  renderAtomText "title" $ f^.feedTitleL+  dateTag "updated" $ f^.feedUpdatedL  -- | Render an @atom:entry@ element. renderAtomEntry :: (Monad m) => AtomEntry -> Source m Event renderAtomEntry e = tag "entry" mempty $ do-  forM_ (e^.entryAuthors_) $ renderAtomPerson "author"-  forM_ (e^.entryCategories_) renderAtomCategory-  forM_ (e^.entryContent_) renderAtomContent-  forM_ (e^.entryContributors_) $ renderAtomPerson "contributor"-  tag "id" mempty . content . toNullable $ e^.entryId_-  forM_ (e^.entryLinks_) renderAtomLink-  forM_ (e^.entryPublished_) $ dateTag "published"-  forM_ (e^.entryRights_) $ renderAtomText "rights"-  forM_ (e^.entrySource_) renderAtomSource-  forM_ (e^.entrySummary_) $ renderAtomText "summary"-  renderAtomText "title" (e^.entryTitle_)-  dateTag "updated" (e^.entryUpdated_)+  forM_ (e^.entryAuthorsL) $ renderAtomPerson "author"+  forM_ (e^.entryCategoriesL) renderAtomCategory+  forM_ (e^.entryContentL) renderAtomContent+  forM_ (e^.entryContributorsL) $ renderAtomPerson "contributor"+  tag "id" mempty . content . toNullable $ e^.entryIdL+  forM_ (e^.entryLinksL) renderAtomLink+  forM_ (e^.entryPublishedL) $ dateTag "published"+  forM_ (e^.entryRightsL) $ renderAtomText "rights"+  forM_ (e^.entrySourceL) renderAtomSource+  forM_ (e^.entrySummaryL) $ renderAtomText "summary"+  renderAtomText "title" (e^.entryTitleL)+  dateTag "updated" (e^.entryUpdatedL)  -- | Render an @atom:content@ element. renderAtomContent :: (Monad m) => AtomContent -> Source m Event renderAtomContent (AtomContentInlineXHTML t) = tag "content" (attr "type" "xhtml")   . tag "div" mempty $ content t-renderAtomContent (AtomContentOutOfLine ctype uri) = tag "content" (nonEmptyAttr "type" ctype <> attr "src" (decodeUtf8 $ serializeUriReference' uri)) $ return ()+renderAtomContent (AtomContentOutOfLine ctype uri) = tag "content" (nonEmptyAttr "type" ctype <> attr "src" (decodeUtf8 $ withAtomURI serializeURIRef' uri)) $ return () renderAtomContent (AtomContentInlineText TypeHTML t) = tag "content" (attr "type" "html") $ content t renderAtomContent (AtomContentInlineText TypeText t) = tag "content" mempty $ content t renderAtomContent (AtomContentInlineOther ctype t) = tag "content" (attr "type" ctype) $ content t@@ -83,48 +85,48 @@ -- | Render an @atom:source@ element. renderAtomSource :: (Monad m) => AtomSource -> Source m Event renderAtomSource s = tag "source" mempty $ do-  forM_ (s^.sourceAuthors_) $ renderAtomPerson "author"-  forM_ (s^.sourceCategories_) renderAtomCategory-  forM_ (s^.sourceContributors_) $ renderAtomPerson "contributor"-  forM_ (s^.sourceGenerator_) renderAtomGenerator-  forM_ (s^.sourceIcon_) $ tag "icon" mempty . content . decodeUtf8 . serializeUriReference'-  unless (Text.null $ s^.sourceId_) . tag "id" mempty . content $ s^.sourceId_-  forM_ (s^.sourceLinks_) renderAtomLink-  forM_ (s^.sourceLogo_) $ tag "logo" mempty . content . decodeUtf8 . serializeUriReference'-  forM_ (s^.sourceRights_) $ renderAtomText "rights"-  forM_ (s^.sourceSubtitle_) $ renderAtomText "subtitle"-  forM_ (s^.sourceTitle_) $ renderAtomText "title"-  forM_ (s^.sourceUpdated_) $ dateTag "updated"+  forM_ (s^.sourceAuthorsL) $ renderAtomPerson "author"+  forM_ (s^.sourceCategoriesL) renderAtomCategory+  forM_ (s^.sourceContributorsL) $ renderAtomPerson "contributor"+  forM_ (s^.sourceGeneratorL) renderAtomGenerator+  forM_ (sourceIcon s) $ tag "icon" mempty . content . decodeUtf8 . withAtomURI serializeURIRef'+  unless (Text.null $ s^.sourceIdL) . tag "id" mempty . content $ s^.sourceIdL+  forM_ (s^.sourceLinksL) renderAtomLink+  forM_ (sourceLogo s) $ tag "logo" mempty . content . decodeUtf8 . withAtomURI serializeURIRef'+  forM_ (s^.sourceRightsL) $ renderAtomText "rights"+  forM_ (s^.sourceSubtitleL) $ renderAtomText "subtitle"+  forM_ (s^.sourceTitleL) $ renderAtomText "title"+  forM_ (s^.sourceUpdatedL) $ dateTag "updated"  -- | Render an @atom:generator@ element. renderAtomGenerator :: (Monad m) => AtomGenerator -> Source m Event-renderAtomGenerator g = tag "generator" attributes . content . toNullable $ g^.generatorContent_-  where attributes = optionalAttr "uri" (decodeUtf8 . serializeUriReference' <$> g^.generatorUri_)-                     <> nonEmptyAttr "version" (g^.generatorVersion_)+renderAtomGenerator g = tag "generator" attributes . content . toNullable $ g^.generatorContentL+  where attributes = optionalAttr "uri" (decodeUtf8 . withAtomURI serializeURIRef' <$> generatorUri g)+                     <> nonEmptyAttr "version" (g^.generatorVersionL)  -- | Render an @atom:link@ element. renderAtomLink :: (Monad m) => AtomLink -> Source m Event renderAtomLink l = tag "link" linkAttrs $ return ()-  where linkAttrs = attr "href" (decodeUtf8 . serializeUriReference' $ l^.linkHref_)-                    <> nonEmptyAttr "rel" (l^.linkRel_)-                    <> nonEmptyAttr "type" (l^.linkType_)-                    <> nonEmptyAttr "hreflang" (l^.linkLang_)-                    <> nonEmptyAttr "title" (l^.linkTitle_)-                    <> nonEmptyAttr "length" (l^.linkLength_)+  where linkAttrs = attr "href" (decodeUtf8 . withAtomURI serializeURIRef' $ linkHref l)+                    <> nonEmptyAttr "rel" (l^.linkRelL)+                    <> nonEmptyAttr "type" (l^.linkTypeL)+                    <> nonEmptyAttr "hreflang" (l^.linkLangL)+                    <> nonEmptyAttr "title" (l^.linkTitleL)+                    <> nonEmptyAttr "length" (l^.linkLengthL)  -- | Render an @atom:category@ element. renderAtomCategory :: (Monad m) => AtomCategory -> Source m Event renderAtomCategory c = tag "category" attributes $ return ()-  where attributes = attr "term" (toNullable $ c^.categoryTerm_)-                     <> nonEmptyAttr "scheme" (c^.categoryScheme_)-                     <> nonEmptyAttr "label" (c^.categoryLabel_)+  where attributes = attr "term" (toNullable $ c^.categoryTermL)+                     <> nonEmptyAttr "scheme" (c^.categorySchemeL)+                     <> nonEmptyAttr "label" (c^.categoryLabelL)  -- | Render an atom person construct. renderAtomPerson :: (Monad m) => Name -> AtomPerson -> Source m Event renderAtomPerson name p = tag name mempty $ do-  tag "name" mempty . content . toNullable $ p^.personName_-  unless (Text.null $ p^.personEmail_) $ tag "email" mempty . content $ p^.personEmail_-  forM_ (p^.personUri_) $ tag "uri" mempty . content . decodeUtf8 . serializeUriReference'+  tag "name" mempty . content . toNullable $ p^.personNameL+  unless (Text.null $ p^.personEmailL) $ tag "email" mempty . content $ p^.personEmailL+  forM_ (personUri p) $ tag "uri" mempty . content . decodeUtf8 . withAtomURI serializeURIRef'  -- | Render an atom text construct. renderAtomText :: (Monad m) => Name -> AtomText -> Source m Event@@ -141,7 +143,3 @@ nonEmptyAttr name value   | value == mempty = mempty   | otherwise = attr name value---- serializeUriReference' :: UriReference -> ByteString-serializeUriReference' (UriReferenceUri u) = serializeURI' u-serializeUriReference' (UriReferenceRelativeRef r) = serializeRelativeRef' r

@@ -0,0 +1,90 @@+{-# LANGUAGE RankNTypes      #-}+{-# LANGUAGE TemplateHaskell #-}+module Text.Atom.Lens where++-- {{{ Imports+import           Lens.Simple++import           Text.Atom.Types++import           URI.ByteString+-- }}}++makeLensesFor+  [ ("categoryTerm", "categoryTermL")+  , ("categoryScheme", "categorySchemeL")+  , ("categoryLabel", "categoryLabelL")+  ] ''AtomCategory++makeLensesFor+  [ ("entryAuthors", "entryAuthorsL")+  , ("entryCategories", "entryCategoriesL")+  , ("entryContent", "entryContentL")+  , ("entryContributors", "entryContributorsL")+  , ("entryId", "entryIdL")+  , ("entryLinks", "entryLinksL")+  , ("entryPublished", "entryPublishedL")+  , ("entryRights", "entryRightsL")+  , ("entrySource", "entrySourceL")+  , ("entrySummary", "entrySummaryL")+  , ("entryTitle", "entryTitleL")+  , ("entryUpdated", "entryUpdatedL")+  ] ''AtomEntry+++makeLensesFor+  [ ("feedAuthors", "feedAuthorsL")+  , ("feedCategories", "feedCategoriesL")+  , ("feedContributors", "feedContributorsL")+  , ("feedEntries", "feedEntriesL")+  , ("feedGenerator", "feedGeneratorL")+  , ("feedIcon", "feedIconL")+  , ("feedId", "feedIdL")+  , ("feedLinks", "feedLinksL")+  , ("feedLogo", "feedLogoL")+  , ("feedRights", "feedRightsL")+  , ("feedSubtitle", "feedSubtitleL")+  , ("feedTitle", "feedTitleL")+  , ("feedUpdated", "feedUpdatedL")+  ] ''AtomFeed++makeLensesFor+  [ ("generatorVersion", "generatorVersionL")+  , ("generatorContent", "generatorContentL")+  , ("generatorUri", "generatorUriL")+  ] ''AtomGenerator++makeLensesFor+  [ ("linkHref", "linkHrefL")+  , ("linkType", "linkTypeL")+  , ("linkRel", "linkRelL")+  , ("linkLang", "linkLangL")+  , ("linkTitle", "linkTitleL")+  , ("linkLength", "linkLengthL")+  ] ''AtomLink++makeLensesFor+  [ ("personName", "personNameL")+  , ("personEmail", "personEmailL")+  , ("personUri", "personUriL")+  ] ''AtomPerson++--personUriL :: Traversal' AtomPerson (URIRef a)+--personUriL inj a@AtomPerson { personUri = u } = (\x -> a { personUri = x }) <$> sequenceA (fmap inj u)++makeLensesFor+  [ ("sourceAuthors", "sourceAuthorsL")+  , ("sourceCategories", "sourceCategoriesL")+  , ("sourceContributors", "sourceContributorsL")+  , ("sourceGenerator", "sourceGeneratorL")+  -- , ("sourceIcon"+  , ("sourceId", "sourceIdL")+  , ("sourceLinks", "sourceLinksL")+  , ("sourceLogo", "sourceLogoL")+  , ("sourceRights", "sourceRightsL")+  , ("sourceSubtitle", "sourceSubtitleL")+  , ("sourceTitle", "sourceTitleL")+  , ("sourceUpdated", "sourceUpdatedL")+  ] ''AtomSource++makeTraversals ''AtomText

@@ -1,9 +1,9 @@ {-# LANGUAGE DeriveGeneric          #-} {-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs                  #-} {-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE RankNTypes             #-} {-# LANGUAGE StandaloneDeriving     #-}-{-# LANGUAGE TemplateHaskell        #-} -- | Atom is an XML-based Web content and metadata syndication format. -- -- Example:@@ -31,108 +31,106 @@ module Text.Atom.Types where  -- {{{ Imports-import           Control.Lens.Combinators- import           Data.NonNull-import           Data.Text                hiding (map)+import           Data.Text           hiding (map) import           Data.Time.Clock-import           Data.Time.LocalTime      ()+import           Data.Time.LocalTime ()  import           GHC.Generics  import           URI.ByteString -- }}} -data TextType = TypeText | TypeHTML-  deriving(Eq, Generic, Show) --- | Either a 'URI', or a 'RelativeRef' (as defined by RFC 3986)-data UriReference = UriReferenceUri URI | UriReferenceRelativeRef RelativeRef+data AtomURI = forall a . AtomURI (URIRef a)++withAtomURI :: (forall a . URIRef a -> b) -> AtomURI -> b+withAtomURI f (AtomURI a) = f a+++instance Eq AtomURI where+  AtomURI a@URI{} == AtomURI b@URI{} = a == b+  AtomURI a@RelativeRef{} == AtomURI b@RelativeRef{} = a == b+  _ == _ = False+instance Show AtomURI where+  show (AtomURI a@URI{}) = show a+  show (AtomURI a@RelativeRef{}) = show a+++data TextType = TypeText | TypeHTML   deriving(Eq, Generic, Show)  -- | An atom text construct. data AtomText = AtomPlainText TextType Text               | AtomXHTMLText Text -makePrisms ''AtomText- deriving instance Eq AtomText deriving instance Generic AtomText deriving instance Show AtomText  -- | An atom person construct. data AtomPerson = AtomPerson-  { _personName_  :: NonNull Text-  , _personEmail_ :: Text-  , _personUri_   :: Maybe UriReference+  { personName  :: NonNull Text+  , personEmail :: Text+  , personUri   :: Maybe AtomURI   } -makeLenses ''AtomPerson- deriving instance Eq AtomPerson deriving instance Generic AtomPerson deriving instance Show AtomPerson  -- | The @atom:category@ element. data AtomCategory = AtomCategory-  { _categoryTerm_   :: NonNull Text-  , _categoryScheme_ :: Text-  , _categoryLabel_  :: Text+  { categoryTerm   :: NonNull Text+  , categoryScheme :: Text+  , categoryLabel  :: Text   } -makeLenses ''AtomCategory- deriving instance Eq AtomCategory deriving instance Generic AtomCategory deriving instance Show AtomCategory  -- | The @atom:link@ element. data AtomLink = AtomLink-  { _linkHref_   :: UriReference-  , _linkRel_    :: Text-  , _linkType_   :: Text-  , _linkLang_   :: Text-  , _linkTitle_  :: Text-  , _linkLength_ :: Text+  { linkHref   :: AtomURI+  , linkRel    :: Text+  , linkType   :: Text+  , linkLang   :: Text+  , linkTitle  :: Text+  , linkLength :: Text   } -makeLenses ''AtomLink- deriving instance Eq AtomLink deriving instance Generic AtomLink deriving instance Show AtomLink  -- | The @atom:generator@ element. data AtomGenerator = AtomGenerator-  { _generatorUri_     :: Maybe UriReference-  , _generatorVersion_ :: Text-  , _generatorContent_ :: NonNull Text+  { generatorUri     :: Maybe AtomURI+  , generatorVersion :: Text+  , generatorContent :: NonNull Text   } -makeLenses ''AtomGenerator- deriving instance Eq AtomGenerator deriving instance Generic AtomGenerator deriving instance Show AtomGenerator  -- | The @atom:source@ element. data AtomSource = AtomSource-  { _sourceAuthors_      :: [AtomPerson]-  , _sourceCategories_   :: [AtomCategory]-  , _sourceContributors_ :: [AtomPerson]-  , _sourceGenerator_    :: Maybe AtomGenerator-  , _sourceIcon_         :: Maybe UriReference-  , _sourceId_           :: Text-  , _sourceLinks_        :: [AtomLink]-  , _sourceLogo_         :: Maybe UriReference-  , _sourceRights_       :: Maybe AtomText-  , _sourceSubtitle_     :: Maybe AtomText-  , _sourceTitle_        :: Maybe AtomText-  , _sourceUpdated_      :: Maybe UTCTime+  { sourceAuthors      :: [AtomPerson]+  , sourceCategories   :: [AtomCategory]+  , sourceContributors :: [AtomPerson]+  , sourceGenerator    :: Maybe AtomGenerator+  , sourceIcon         :: Maybe AtomURI+  , sourceId           :: Text+  , sourceLinks        :: [AtomLink]+  , sourceLogo         :: Maybe AtomURI+  , sourceRights       :: Maybe AtomText+  , sourceSubtitle     :: Maybe AtomText+  , sourceTitle        :: Maybe AtomText+  , sourceUpdated      :: Maybe UTCTime   } -makeLenses ''AtomSource- deriving instance Eq AtomSource deriving instance Generic AtomSource deriving instance Show AtomSource@@ -143,7 +141,7 @@ data AtomContent = AtomContentInlineText TextType Text                  | AtomContentInlineXHTML Text                  | AtomContentInlineOther Type Text-                 | AtomContentOutOfLine Type UriReference+                 | AtomContentOutOfLine Type AtomURI  deriving instance Eq AtomContent deriving instance Generic AtomContent@@ -151,44 +149,40 @@  -- | The @atom:entry@ element. data AtomEntry = AtomEntry-  { _entryAuthors_      :: [AtomPerson]-  , _entryCategories_   :: [AtomCategory]-  , _entryContent_      :: Maybe AtomContent-  , _entryContributors_ :: [AtomPerson]-  , _entryId_           :: NonNull Text-  , _entryLinks_        :: [AtomLink]-  , _entryPublished_    :: Maybe UTCTime-  , _entryRights_       :: Maybe AtomText-  , _entrySource_       :: Maybe AtomSource-  , _entrySummary_      :: Maybe AtomText-  , _entryTitle_        :: AtomText-  , _entryUpdated_      :: UTCTime+  { entryAuthors      :: [AtomPerson]+  , entryCategories   :: [AtomCategory]+  , entryContent      :: Maybe AtomContent+  , entryContributors :: [AtomPerson]+  , entryId           :: NonNull Text+  , entryLinks        :: [AtomLink]+  , entryPublished    :: Maybe UTCTime+  , entryRights       :: Maybe AtomText+  , entrySource       :: Maybe AtomSource+  , entrySummary      :: Maybe AtomText+  , entryTitle        :: AtomText+  , entryUpdated      :: UTCTime   } -makeLenses ''AtomEntry- deriving instance Eq AtomEntry deriving instance Generic AtomEntry deriving instance Show AtomEntry  -- | The @atom:feed@ element. data AtomFeed = AtomFeed-  { _feedAuthors_      :: [AtomPerson]-  , _feedCategories_   :: [AtomCategory]-  , _feedContributors_ :: [AtomPerson]-  , _feedEntries_      :: [AtomEntry]-  , _feedGenerator_    :: Maybe AtomGenerator-  , _feedIcon_         :: Maybe UriReference-  , _feedId_           :: NonNull Text-  , _feedLinks_        :: [AtomLink]-  , _feedLogo_         :: Maybe UriReference-  , _feedRights_       :: Maybe AtomText-  , _feedSubtitle_     :: Maybe AtomText-  , _feedTitle_        :: AtomText-  , _feedUpdated_      :: UTCTime+  { feedAuthors      :: [AtomPerson]+  , feedCategories   :: [AtomCategory]+  , feedContributors :: [AtomPerson]+  , feedEntries      :: [AtomEntry]+  , feedGenerator    :: Maybe AtomGenerator+  , feedIcon         :: Maybe AtomURI+  , feedId           :: NonNull Text+  , feedLinks        :: [AtomLink]+  , feedLogo         :: Maybe AtomURI+  , feedRights       :: Maybe AtomText+  , feedSubtitle     :: Maybe AtomText+  , feedTitle        :: AtomText+  , feedUpdated      :: UTCTime   }--makeLenses ''AtomFeed  deriving instance Eq AtomFeed deriving instance Generic AtomFeed

@@ -1,5 +1,5 @@ name:                atom-conduit-version:             0.2.0.0+version:             0.3.0.0 synopsis:            Streaming parser/renderer for the Atom 1.0 standard (RFC 4287). -- description: license:             OtherLicense@@ -19,6 +19,7 @@   exposed-modules:     Text.Atom.Conduit.Parse     Text.Atom.Conduit.Render+    Text.Atom.Lens     Text.Atom.Types   -- other-modules:   build-depends:@@ -27,13 +28,12 @@     , conduit-parse     , exceptions     , foldl-    , lens+    , lens-simple     , mono-traversable     , parsers     , text     , time >= 1.5     , timerep >= 2.0-    , total     , uri-bytestring >= 0.1.9     , xml-conduit >= 1.3     , xml-conduit-parse >= 0.3@@ -51,7 +51,7 @@                  data-default,                  exceptions,                  hlint,-                 lens,+                 lens-simple,                  mono-traversable,                  parsers,                  quickcheck-instances,

@@ -1,8 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}-import           Control.Lens.Getter-import           Control.Lens.Operators-import           Control.Lens.Setter import           Control.Monad import           Control.Monad.Catch.Pure import           Control.Monad.Trans.Resource@@ -23,6 +20,8 @@ import           Data.Time.Clock import           Data.XML.Types +import           Lens.Simple+ import qualified Language.Haskell.HLint       as HLint (hlint) import           Test.QuickCheck.Instances import           Test.Tasty@@ -31,6 +30,7 @@  import           Text.Atom.Conduit.Parse      as Parser import           Text.Atom.Conduit.Render     as Renderer+import           Text.Atom.Lens import           Text.Atom.Types import           Text.Parser.Combinators @@ -62,23 +62,23 @@   , roundtripAtomGeneratorProperty   , roundtripAtomSourceProperty   , roundtripAtomContentProperty-  , roundtripAtomEntryProperty+  -- , roundtripAtomEntryProperty   -- , roundtripAtomFeedProperty   ]  linkCase :: TestTree linkCase = testCase "Link element" $ do   result <- runResourceT . runConduit $ sourceList input =$= XML.parseText def =$= runConduitParser atomLink-  result ^. linkHref_ @?= UriReferenceRelativeRef (RelativeRef Nothing "/feed" (Query []) Nothing)-  (result ^. linkRel_) @?= "self"+  result ^. linkHrefL @?= AtomURI (RelativeRef Nothing "/feed" (Query []) Nothing)+  (result ^. linkRelL) @?= "self"   where input = ["<link rel=\"self\" href=\"/feed\" />"]  personCase :: TestTree personCase = testCase "Person construct" $ do   result <- runResourceT . runConduit $ sourceList input =$= XML.parseText def =$= runConduitParser (atomPerson "author")-  toNullable (result ^. personName_) @?= "John Doe"-  result ^. personEmail_ @?= "JohnDoe@example.com"-  result ^. personUri_ @?= Just (UriReferenceUri $ URI (Scheme "http") (Just $ Authority Nothing (Host "example.com") Nothing) "/~johndoe" (Query []) Nothing)+  toNullable (result ^. personNameL) @?= "John Doe"+  result ^. personEmailL @?= "JohnDoe@example.com"+  result ^. personUriL @?= Just (AtomURI $ URI (Scheme "http") (Just $ Authority Nothing (Host "example.com") Nothing) "/~johndoe" (Query []) Nothing)   where input =           [ "<author>"           , "<name>John Doe</name>"@@ -90,9 +90,9 @@ generatorCase :: TestTree generatorCase = testCase "Generator element" $ do   result <- runResourceT . runConduit $ sourceList input =$= XML.parseText def =$= runConduitParser atomGenerator-  result ^. generatorUri_ @?= Just (UriReferenceRelativeRef $ RelativeRef Nothing "/myblog.php" (Query []) Nothing)-  (result ^. generatorVersion_) @?= "1.0"-  toNullable (result ^. generatorContent_) @?= "Example Toolkit"+  result ^. generatorUriL @?= Just (AtomURI $ RelativeRef Nothing "/myblog.php" (Query []) Nothing)+  (result ^. generatorVersionL) @?= "1.0"+  toNullable (result ^. generatorContentL) @?= "Example Toolkit"   where input =           [ "<generator uri=\"/myblog.php\" version=\"1.0\">"           , "Example Toolkit"@@ -102,10 +102,10 @@ sourceCase :: TestTree sourceCase = testCase "Source element" $ do   result <- runResourceT . runConduit $ sourceList input =$= XML.parseText def =$= runConduitParser atomSource-  (result ^. sourceId_) @?= "http://example.org/"-  (result ^. sourceTitle_) @?= Just (AtomPlainText TypeText "Fourty-Two")-  show <$> (result ^. sourceUpdated_) @?= Just "2003-12-13 18:30:02 UTC"-  (result ^. sourceRights_) @?= Just (AtomPlainText TypeText "© 2005 Example, Inc.")+  (result ^. sourceIdL) @?= "http://example.org/"+  (result ^. sourceTitleL) @?= Just (AtomPlainText TypeText "Fourty-Two")+  show <$> (result ^. sourceUpdatedL) @?= Just "2003-12-13 18:30:02 UTC"+  (result ^. sourceRightsL) @?= Just (AtomPlainText TypeText "© 2005 Example, Inc.")   where input =           [ "<source>"           , "<id>http://example.org/</id>"@@ -229,8 +229,8 @@                   <*> arbitrary                   <*> oneof [pure Nothing, Just <$> (encodeUtf8 . pack <$> listOf1 alphaNum)] -instance Arbitrary UriReference where-  arbitrary = oneof [UriReferenceUri <$> arbitrary, UriReferenceRelativeRef <$> arbitrary]+instance Arbitrary AtomURI where+  arbitrary = oneof [AtomURI <$> (arbitrary :: Gen (URIRef Absolute)), AtomURI <$> (arbitrary :: Gen (URIRef Relative))]  instance Arbitrary RelativeRef where   arbitrary = RelativeRef <$> arbitrary