opml-conduit 0.7.0.0 → 0.8.0.0

raw patch · 6 files changed

+78/−74 lines, 6 filesdep +microlensdep +microlens-thdep −lens-simplePVP ok

version bump matches the API change (PVP)

Dependencies added: microlens, microlens-th

Dependencies removed: lens-simple

API changes (from Hackage documentation)

Files

• Text/OPML/Conduit/Parse.hs +43/−42
• Text/OPML/Conduit/Render.hs +4/−4
• Text/OPML/Lens.hs +9/−8
• Text/OPML/Types.hs +3/−3
• opml-conduit.cabal +7/−5
• test/Main.hs +12/−12

@@ -30,8 +30,7 @@ import           Data.Maybe import           Data.Monoid import           Data.Monoid.Textual          hiding (map)-import           Data.Text                    as Text (Text, null, strip,-                                                       unpack)+import           Data.Text                    as Text (Text, null, strip, unpack) import           Data.Text.Encoding import           Data.Time.Clock import           Data.Time.LocalTime@@ -39,7 +38,8 @@ import           Data.Tree import           Data.Version import           Data.XML.Types-import           Lens.Simple+import           Lens.Micro+import           Lens.Micro.TH import           Numeric import           Prelude                      hiding (last) import           Refined                      hiding (NonEmpty)@@ -61,11 +61,11 @@ deriving instance Show OpmlException  instance Exception OpmlException where-  displayException MissingText = "An outline is missing the 'text' attribute."-  displayException (InvalidBool t) = "Invalid boolean: " ++ unpack t+  displayException MissingText        = "An outline is missing the 'text' attribute."+  displayException (InvalidBool t)    = "Invalid boolean: " ++ unpack t   displayException (InvalidDecimal t) = "Invalid decimal: " ++ unpack t-  displayException (InvalidURI e) = "Invalid URI: " ++ show e-  displayException (InvalidTime t) = "Invalid time: " ++ unpack t+  displayException (InvalidURI e)     = "Invalid URI: " ++ show e+  displayException (InvalidTime t)    = "Invalid time: " ++ unpack t   displayException (InvalidVersion t) = "Invalid version: " ++ unpack t  asURI :: (MonadThrow m) => Text -> m URI@@ -113,7 +113,7 @@ decimalTag :: (Integral i, MonadThrow m) => NameMatcher a -> ConduitM Event o m (Maybe i) decimalTag name = tagIgnoreAttrs name $ content >>= asDecimal -projectC :: Monad m => Fold a a' b b' -> ConduitT a b m ()+projectC :: Monad m => Traversal' a b -> ConduitT a b m () projectC prism = fix $ \recurse -> do   item <- await   case (item, item ^? (_Just . prism)) of@@ -122,21 +122,21 @@     _           -> return ()  -data HeadPiece = HeadCreated UTCTime-               | HeadModified UTCTime-               | HeadDocs URI-               | HeadExpansionState [Int]-               | HeadOwnerEmail Text-               | HeadOwnerId URI-               | HeadOwnerName Text-               | HeadTitle Text-               | HeadVertScrollState Int-               | HeadWindowBottom Int-               | HeadWindowLeft Int-               | HeadWindowRight Int-               | HeadWindowTop Int+data HeadPiece = HeadCreated { __headCreated :: UTCTime }+               | HeadModified { __headModified :: UTCTime }+               | HeadDocs { __headDocs :: URI }+               | HeadExpansionState { __headExpansionState :: [Int] }+               | HeadOwnerEmail { __headOwnerEmail :: Text }+               | HeadOwnerId { __headOwnerId :: URI }+               | HeadOwnerName { __headOwnerName :: Text }+               | HeadTitle { __headTitle :: Text }+               | HeadVertScrollState { __headVertScrollState :: Int }+               | HeadWindowBottom { __headWindowBottom :: Int }+               | HeadWindowLeft { __headWindowLeft :: Int }+               | HeadWindowRight { __headWindowRight :: Int }+               | HeadWindowTop { __headWindowTop :: Int } -makeTraversals ''HeadPiece+makeLenses ''HeadPiece   -- | Parse the @\<head\>@ section.@@ -147,19 +147,19 @@ parseOpmlHead :: (MonadCatch m) => ConduitM Event o m (Maybe OpmlHead) parseOpmlHead = tagIgnoreAttrs "head" $ (manyYield' (choose piece) <* many ignoreAnyTreeContent) .| zipConduit where   zipConduit = getZipConduit $ OpmlHead-    <$> ZipConduit (projectC _HeadTitle .| headDefC mempty)-    <*> ZipConduit (projectC _HeadCreated .| headC)-    <*> ZipConduit (projectC _HeadModified .| headC)-    <*> ZipConduit (projectC _HeadOwnerName .| headDefC mempty)-    <*> ZipConduit (projectC _HeadOwnerEmail .| headDefC mempty)-    <*> ZipConduit (projectC _HeadOwnerId .| headC)-    <*> ZipConduit (projectC _HeadDocs .| headC)-    <*> ZipConduit (projectC _HeadExpansionState .| concatC .| sinkList)-    <*> ZipConduit (projectC _HeadVertScrollState .| headC)-    <*> ZipConduit (projectC _HeadWindowBottom .| headC)-    <*> ZipConduit (projectC _HeadWindowLeft .| headC)-    <*> ZipConduit (projectC _HeadWindowRight .| headC)-    <*> ZipConduit (projectC _HeadWindowTop .| headC)+    <$> ZipConduit (projectC _headTitle .| headDefC mempty)+    <*> ZipConduit (projectC _headCreated .| headC)+    <*> ZipConduit (projectC _headModified .| headC)+    <*> ZipConduit (projectC _headOwnerName .| headDefC mempty)+    <*> ZipConduit (projectC _headOwnerEmail .| headDefC mempty)+    <*> ZipConduit (projectC _headOwnerId .| headC)+    <*> ZipConduit (projectC _headDocs .| headC)+    <*> ZipConduit (projectC _headExpansionState .| concatC .| sinkList)+    <*> ZipConduit (projectC _headVertScrollState .| headC)+    <*> ZipConduit (projectC _headWindowBottom .| headC)+    <*> ZipConduit (projectC _headWindowLeft .| headC)+    <*> ZipConduit (projectC _headWindowRight .| headC)+    <*> ZipConduit (projectC _headWindowTop .| headC)   piece = [ fmap HeadCreated <$> dateTag "dateCreated"           , fmap HeadModified <$> dateTag "dateModified"           , fmap HeadDocs <$> uriTag "docs"@@ -184,9 +184,9 @@     otype <- optional $ requireAttr "type"     case mk <$> otype of       Just "include" -> (,,,) otype <$> baseAttr <*> pure Nothing <*> (Just <$> linkAttr) <* ignoreAttrs-      Just "link" -> (,,,) otype <$> baseAttr <*> pure Nothing <*> (Just <$> linkAttr) <* ignoreAttrs-      Just "rss" -> (,,,) otype <$> baseAttr <*> (Just <$> subscriptionAttr) <*> pure Nothing <* ignoreAttrs-      _          -> (,,,) otype <$> baseAttr <*> pure Nothing <*> pure Nothing <* ignoreAttrs+      Just "link"    -> (,,,) otype <$> baseAttr <*> pure Nothing <*> (Just <$> linkAttr) <* ignoreAttrs+      Just "rss"     -> (,,,) otype <$> baseAttr <*> (Just <$> subscriptionAttr) <*> pure Nothing <* ignoreAttrs+      _              -> (,,,) otype <$> baseAttr <*> pure Nothing <*> pure Nothing <* ignoreAttrs   baseAttr = (,,,,) <$> (requireAttr "text" >>= refineThrow)                     <*> optional (requireAttr "isComment" >>= asBool)                     <*> optional (requireAttr "isBreakpoint" >>= asBool)@@ -207,9 +207,10 @@   subscriptionHandler (uri, html, desc, lang, title, version) = OutlineSubscription uri html (fromMaybe mempty desc) (fromMaybe mempty lang) (fromMaybe mempty title) (fromMaybe mempty version)  -data OpmlDocPiece = DocHead OpmlHead | DocBody [Tree OpmlOutline]+data OpmlDocPiece = DocHead { __docHead :: OpmlHead }+                  | DocBody { __docBody :: [Tree OpmlOutline] } -makeTraversals ''OpmlDocPiece+makeLenses ''OpmlDocPiece   -- | Parse the top-level @\<opml\>@ element.@@ -218,8 +219,8 @@   attributes = (requireAttr "version" >>= asVersion) <* ignoreAttrs   handler version = (manyYield' (choose piece) <* many ignoreAnyTreeContent) .| zipConduit version   zipConduit version = getZipConduit $ Opml version-    <$> ZipConduit (projectC _DocHead .| headDefC mkOpmlHead)-    <*> ZipConduit (projectC _DocBody .| headDefC mempty)+    <$> ZipConduit (projectC _docHead .| headDefC mkOpmlHead)+    <*> ZipConduit (projectC _docBody .| headDefC mempty)   parseOpmlBody = tagIgnoreAttrs "body" $ manyYield' parseOpmlOutline .| sinkList   piece = [ fmap DocHead <$> parseOpmlHead           , fmap DocBody <$> parseOpmlBody

@@ -25,7 +25,7 @@ import           Data.Tree import           Data.Version import           Data.XML.Types-import           Lens.Simple+import           Lens.Micro import           Prelude                hiding (foldr, lookup, show) import qualified Prelude                (show) import           Refined                hiding (NonEmpty)@@ -73,7 +73,7 @@   forM_ (input^.windowLeftL)        $ tag "windowLeft" mempty . content . show   forM_ (input^.windowRightL)       $ tag "windowRight" mempty . content . show   forM_ (input^.windowTopL)         $ tag "windowTop" mempty . content . show-  where es = input ^.. expansionStateL+  where es = input ^. expansionStateL         email = input ^. ownerEmailL         name = input ^. ownerNameL         title = input ^. opmlTitleL@@ -82,8 +82,8 @@ renderOpmlOutline :: (Monad m) => Tree OpmlOutline -> ConduitT () Event m () renderOpmlOutline (Node outline subOutlines) = tag "outline" attributes $ mapM_ renderOpmlOutline subOutlines   where attributes = case outline of-          OpmlOutlineGeneric b t -> baseAttr b <> optionalAttr "type" (toMaybe t)-          OpmlOutlineLink b uri -> baseAttr b <> attr "type" "link" <> attr "url" (formatURI uri)+          OpmlOutlineGeneric b t      -> baseAttr b <> optionalAttr "type" (toMaybe t)+          OpmlOutlineLink b uri       -> baseAttr b <> attr "type" "link" <> attr "url" (formatURI uri)           OpmlOutlineSubscription b s -> baseAttr b <> subscriptionAttr s         baseAttr b = attr "text" (unrefine $ b^.textL)                      <> optionalAttr "isComment" (formatBool <$> b^.isCommentL)

@@ -4,7 +4,7 @@ module Text.OPML.Lens (module Text.OPML.Lens) where  -- {{{ Imports-import           Lens.Simple+import           Lens.Micro.TH  import           Text.OPML.Types -- }}}@@ -25,7 +25,7 @@   , ("ownerEmail", "ownerEmailL")   , ("ownerId", "ownerIdL")   , ("docs", "docsL")-  -- , ("expansionState", "expansionStateL")+  , ("expansionState", "expansionStateL")   , ("vertScrollState", "vertScrollStateL")   , ("windowBottom", "windowBottomL")   , ("windowLeft", "windowLeftL")@@ -33,10 +33,6 @@   , ("windowTop", "windowTopL")   ] ''OpmlHead -expansionStateL :: Traversal' OpmlHead Int-expansionStateL inj a@OpmlHead { expansionState = es } = (\x -> a { expansionState = x }) <$> traverse inj es-{-# INLINE expansionStateL #-}- -- * 'OutlineSubscription' lenses makeLensesFor   [ ("xmlUri", "xmlUriL")@@ -57,5 +53,10 @@   ] ''OutlineBase  --- * 'OpmlOutline' traversals-makeTraversals ''OpmlOutline+-- * 'OpmlOutline' lenses+makeLensesFor+  [ ("opmlOutlineBase", "opmlOutlineBaseL")+  , ("opmlOutlineContent", "opmlOutlineContentL")+  , ("opmlOutlineUri", "opmlOutlineUriL")+  , ("opmlOutlineSubscription", "opmlOutlineSubscriptionL")+  ] ''OpmlOutline

@@ -118,9 +118,9 @@   -- | Outlines are the main payload of an OPML document.-data OpmlOutline = OpmlOutlineGeneric OutlineBase Text-                 | OpmlOutlineLink OutlineBase URI-                 | OpmlOutlineSubscription OutlineBase OutlineSubscription+data OpmlOutline = OpmlOutlineGeneric { opmlOutlineBase :: OutlineBase, opmlOutlineContent :: Text }+                 | OpmlOutlineLink { opmlOutlineBase :: OutlineBase, opmlOutlineUri :: URI }+                 | OpmlOutlineSubscription { opmlOutlineBase :: OutlineBase, opmlOutlineSubscription :: OutlineSubscription }  deriving instance Eq OpmlOutline deriving instance Generic OpmlOutline

@@ -1,16 +1,17 @@ name:                opml-conduit-version:             0.7.0.0+version:             0.8.0.0 synopsis:            Streaming parser/renderer for the OPML 2.0 format. description:     This library implements the OPML 2.0 standard (<http://dev.opml.org/spec2.html>) as a 'conduit' parser/renderer. homepage:            https://github.com/k0ral/opml-conduit license:             PublicDomain license-file:        LICENSE-author:              koral <koral@mailoo.org>-maintainer:          koral <koral@mailoo.org>+author:              koral+maintainer:          mail@cmoreau.info category:            Conduit, Text, XML build-type:          Simple cabal-version:       >=1.10+tested-with:         GHC <8.10 && >=8.4.2 data-files:   data/category.opml   data/directory.opml@@ -42,7 +43,8 @@     , conduit-combinators     , containers     , safe-exceptions-    , lens-simple+    , microlens+    , microlens-th     , monoid-subclasses     , refined >= 0.2     , semigroups@@ -69,7 +71,7 @@     , conduit-combinators     , containers     , data-default-    , lens-simple+    , microlens     , mtl     , opml-conduit     , parsers

@@ -14,7 +14,7 @@ import           Data.Text.Encoding import           Data.Tree import           Data.Version-import           Lens.Simple+import           Lens.Micro import           Paths_opml_conduit import           Test.Tasty import           Test.Tasty.HUnit@@ -54,7 +54,7 @@   (result ^. opmlVersionL) @?= Version [2,0] []   (result ^. opmlHeadL . opmlTitleL) @?= "Illustrating the category attribute"   show (result ^. opmlHeadL . opmlCreatedL) @?= "Just 2005-10-31 19:23:00 UTC"-  length (result ^.. opmlOutlinesL . traverse . traverse . _OpmlOutlineGeneric) @?= 1+  length (result ^.. opmlOutlinesL . traverse . traverse . opmlOutlineContentL) @?= 1   map (map length .levels) (result ^. opmlOutlinesL) @?= [[1]]  @@ -69,13 +69,13 @@   show (result ^. opmlHeadL . modifiedL) @?= "Just 2005-10-25 21:33:57 UTC"   (result ^. opmlHeadL . ownerNameL) @?= "Dave Winer"   (result ^. opmlHeadL . ownerEmailL) @?= "dwiner@yahoo.com"-  (result ^.. opmlHeadL . expansionStateL) @?= []+  (result ^. opmlHeadL . expansionStateL) @?= []   (result ^. opmlHeadL . vertScrollStateL) @?= Just 1   (result ^. opmlHeadL . windowBottomL) @?= Just 386   (result ^. opmlHeadL . windowLeftL) @?= Just 466   (result ^. opmlHeadL . windowRightL) @?= Just 964   (result ^. opmlHeadL . windowTopL) @?= Just 105-  length (result ^.. opmlOutlinesL . traverse . traverse . _OpmlOutlineLink) @?= 8+  length (result ^.. opmlOutlinesL . traverse . traverse . opmlOutlineUriL) @?= 8   map (map length .levels) (result ^. opmlOutlinesL) @?= [[1], [1], [1], [1], [1], [1], [1], [1]]  @@ -90,14 +90,14 @@   show (result ^. opmlHeadL . modifiedL) @?= "Just 2006-02-27 12:11:44 UTC"   (result ^. opmlHeadL . ownerNameL) @?= "Dave Winer"   fmap (decodeUtf8 . serializeURIRef') (result ^. opmlHeadL . ownerIdL) @?= Just "http://www.opml.org/profiles/sendMail?usernum=1"-  (result ^.. opmlHeadL . expansionStateL) @?= [1,2,5,10,13,15]+  (result ^. opmlHeadL . expansionStateL) @?= [1,2,5,10,13,15]   (result ^. opmlHeadL . vertScrollStateL) @?= Just 1   (result ^. opmlHeadL . windowBottomL) @?= Just 665   (result ^. opmlHeadL . windowLeftL) @?= Just 329   (result ^. opmlHeadL . windowRightL) @?= Just 547   (result ^. opmlHeadL . windowTopL) @?= Just 242-  length (result ^.. opmlOutlinesL . traverse . traverse . _OpmlOutlineGeneric) @?= 18-  length (result ^.. opmlOutlinesL . traverse . traverse . _OpmlOutlineLink) @?= 1+  length (result ^.. opmlOutlinesL . traverse . traverse . opmlOutlineContentL) @?= 18+  length (result ^.. opmlOutlinesL . traverse . traverse . opmlOutlineUriL) @?= 1   map (map length .levels) (result ^. opmlOutlinesL) @?= [[1,6,12]]  @@ -112,13 +112,13 @@   show (result ^. opmlHeadL . modifiedL) @?= "Just 2005-10-30 03:30:17 UTC"   (result ^. opmlHeadL . ownerNameL) @?= "Dave Winer"   (result ^. opmlHeadL . ownerEmailL) @?= "dwiner@yahoo.com"-  (result ^.. opmlHeadL . expansionStateL) @?= [1, 2, 4]+  (result ^. opmlHeadL . expansionStateL) @?= [1, 2, 4]   (result ^. opmlHeadL . vertScrollStateL) @?= Just 1   (result ^. opmlHeadL . windowBottomL) @?= Just 314   (result ^. opmlHeadL . windowLeftL) @?= Just 41   (result ^. opmlHeadL . windowRightL) @?= Just 475   (result ^. opmlHeadL . windowTopL) @?= Just 74-  length (result ^.. opmlOutlinesL . traverse . traverse . _OpmlOutlineGeneric) @?= 11+  length (result ^.. opmlOutlinesL . traverse . traverse . opmlOutlineContentL) @?= 11   map (map length .levels) (result ^. opmlOutlinesL) @?= [[1,2,2], [1,2], [1], [1,1]]  @@ -133,13 +133,13 @@   show (result ^. opmlHeadL . modifiedL) @?= "Just 2005-07-14 23:41:05 UTC"   (result ^. opmlHeadL . ownerNameL) @?= "Dave Winer"   (result ^. opmlHeadL . ownerEmailL) @?= "dave@scripting.com"-  (result ^.. opmlHeadL . expansionStateL) @?= [1, 6, 13, 16, 18, 20]+  (result ^. opmlHeadL . expansionStateL) @?= [1, 6, 13, 16, 18, 20]   (result ^. opmlHeadL . vertScrollStateL) @?= Just 1   (result ^. opmlHeadL . windowBottomL) @?= Just 558   (result ^. opmlHeadL . windowLeftL) @?= Just 106   (result ^. opmlHeadL . windowRightL) @?= Just 479   (result ^. opmlHeadL . windowTopL) @?= Just 106-  length (result ^.. opmlOutlinesL . traverse . traverse . _OpmlOutlineGeneric) @?= 63+  length (result ^.. opmlOutlinesL . traverse . traverse . opmlOutlineContentL) @?= 63   map (map length .levels) (result ^. opmlOutlinesL) @?= [[1, 8, 50, 4]]  @@ -159,7 +159,7 @@   (result ^. opmlHeadL . windowLeftL) @?= Just 304   (result ^. opmlHeadL . windowRightL) @?= Just 842   (result ^. opmlHeadL . windowTopL) @?= Just 61-  length (result ^.. opmlOutlinesL . traverse . traverse . _OpmlOutlineSubscription) @?= 13+  length (result ^.. opmlOutlinesL . traverse . traverse . opmlOutlineSubscriptionL) @?= 13  inverseHeadProperty :: TestTree inverseHeadProperty = testProperty "parse . render = id (on OpmlHead)" $ \opmlHead -> either (const False) (opmlHead ==) (runConduit $ renderOpmlHead opmlHead .| force "Invalid <head>" parseOpmlHead)