atom-conduit 0.5.0.3 → 0.6.0.0

raw patch · 5 files changed

+37/−39 lines, 5 filesdep +pretty-simpledep +refineddep −mono-traversablePVP ok

version bump matches the API change (PVP)

Dependencies added: pretty-simple, refined

Dependencies removed: mono-traversable

API changes (from Hackage documentation)

Files

• Text/Atom/Conduit/Parse.hs +5/−15
• Text/Atom/Conduit/Render.hs +4/−8
• Text/Atom/Types.hs +14/−5
• atom-conduit.cabal +4/−3
• test/Main.hs +10/−8

@@ -25,30 +25,23 @@  -- {{{ Imports import           Blaze.ByteString.Builder (toByteString)- import           Conduit                  (foldC, headC, headDefC, sinkList)- import           Control.Applicative      hiding (many) import           Control.Exception.Safe   as Exception import           Control.Monad import           Control.Monad.Fix- import           Data.Conduit import           Data.Maybe import           Data.Monoid-import           Data.MonoTraversable-import           Data.NonNull             (NonNull, fromNullable, toNullable) import           Data.Text                as Text (Text, unpack) import           Data.Text.Encoding import           Data.Time.Clock import           Data.Time.LocalTime import           Data.Time.RFC3339 import           Data.XML.Types- import           Lens.Simple- import           Prelude-+import           Refined import           Text.Atom.Types import           Text.XML.Stream.Parse import qualified Text.XML.Stream.Render   as Render@@ -79,9 +72,6 @@   where parseURI' = parseURI laxURIParserOptions . encodeUtf8         parseRelativeRef' = parseRelativeRef laxURIParserOptions . encodeUtf8 -asNonNull :: (MonoFoldable a, MonadThrow m) => a -> m (NonNull a)-asNonNull = liftMaybe NullElement . fromNullable- liftMaybe :: (MonadThrow m, Exception e) => e -> Maybe a -> m a liftMaybe e = maybe (throw e) return @@ -123,7 +113,7 @@ -- }}}  -data PersonPiece = PersonName (NonNull Text)+data PersonPiece = PersonName (Refined (Not Null) Text)                  | PersonEmail Text                  | PersonUri AtomURI @@ -143,7 +133,7 @@     <$> ZipConduit (projectC _PersonName .| headRequiredC "Missing or invalid <name> element")     <*> ZipConduit (projectC _PersonEmail .| headDefC "")     <*> ZipConduit (projectC _PersonUri .| headC)-  piece = [ fmap PersonName <$> tagIgnoreAttrs' "name" (content >>= asNonNull)+  piece = [ fmap PersonName <$> tagIgnoreAttrs' "name" (content >>= refineThrow)           , fmap PersonEmail <$> tagIgnoreAttrs' "email" content           , fmap PersonUri <$> tagIgnoreAttrs' "uri" (content >>= asURIReference)           ]@@ -155,7 +145,7 @@ -- > <category term="sports"/> atomCategory :: MonadThrow m => ConduitM Event o m (Maybe AtomCategory) atomCategory = tagName' "category" categoryAttrs $ \(t, s, l) -> do-  term <- asNonNull t+  term <- refineThrow t   return $ AtomCategory term s l   where categoryAttrs = (,,) <$> requireAttr "term"                              <*> (requireAttr "scheme" <|> pure mempty)@@ -216,7 +206,7 @@ -- >   Example Toolkit -- > </generator> atomGenerator :: MonadThrow m => ConduitM Event o m (Maybe AtomGenerator)-atomGenerator = tagName' "generator" generatorAttrs $ \(uri, version) -> AtomGenerator uri version <$> (asNonNull =<< content)+atomGenerator = tagName' "generator" generatorAttrs $ \(uri, version) -> AtomGenerator uri version <$> (refineThrow =<< content)   where generatorAttrs = (,) <$> optional (requireAttr "uri" >>= asURIReference) <*> (requireAttr "version" <|> pure mempty) <* ignoreAttrs  

@@ -21,21 +21,17 @@ import           Text.Atom.Types  import           Control.Monad- import           Data.Conduit import           Data.Monoid-import           Data.NonNull import           Data.Text              as Text import           Data.Text.Encoding import           Data.Time.Clock import           Data.Time.LocalTime import           Data.Time.RFC3339 import           Data.XML.Types- import           Lens.Simple-+import           Refined import           Text.XML.Stream.Render- import           URI.ByteString -- }}} @@ -99,7 +95,7 @@  -- | Render an @atom:generator@ element. renderAtomGenerator :: (Monad m) => AtomGenerator -> ConduitT () Event m ()-renderAtomGenerator g = atomTag "generator" attributes . content . toNullable $ g^.generatorContentL+renderAtomGenerator g = atomTag "generator" attributes . content . unrefine $ g^.generatorContentL   where attributes = optionalAttr "uri" (decodeUtf8 . withAtomURI serializeURIRef' <$> generatorUri g)                      <> nonEmptyAttr "version" (g^.generatorVersionL) @@ -116,14 +112,14 @@ -- | Render an @atom:category@ element. renderAtomCategory :: (Monad m) => AtomCategory -> ConduitT () Event m () renderAtomCategory c = atomTag "category" attributes $ return ()-  where attributes = attr "term" (toNullable $ c^.categoryTermL)+  where attributes = attr "term" (unrefine $ c^.categoryTermL)                      <> nonEmptyAttr "scheme" (c^.categorySchemeL)                      <> nonEmptyAttr "label" (c^.categoryLabelL)  -- | Render an atom person construct. renderAtomPerson :: (Monad m) => Text -> AtomPerson -> ConduitT () Event m () renderAtomPerson name p = atomTag name mempty $ do-  atomTag "name" mempty . content . toNullable $ p^.personNameL+  atomTag "name" mempty . content . unrefine $ p^.personNameL   unless (Text.null $ p^.personEmailL) $ atomTag "email" mempty . content $ p^.personEmailL   forM_ (personUri p) $ atomTag "uri" mempty . content . decodeUtf8 . withAtomURI serializeURIRef' 

@@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleInstances      #-} {-# LANGUAGE GADTs                  #-} {-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE OverloadedStrings      #-} {-# LANGUAGE RankNTypes             #-} {-# LANGUAGE StandaloneDeriving     #-} -- | Atom is an XML-based Web content and metadata syndication format.@@ -31,15 +32,22 @@ module Text.Atom.Types (module Text.Atom.Types) where  -- {{{ Imports-import           Data.NonNull-import           Data.Text           +import           Control.Monad+import           Data.Text as Text import           Data.Time.Clock import           Data.Time.LocalTime ()+import           Data.Typeable import           GHC.Generics+import           Refined import           URI.ByteString -- }}} +-- | 'Predicate' on 'Text', true iff text is null.+data Null deriving(Typeable) +instance Predicate Null Text where+  validate p value = unless (Text.null value) $ throwRefine $ RefineOtherException (typeOf p) "Text is not null"+ data AtomURI = forall a . AtomURI (URIRef a)  withAtomURI :: (forall a . URIRef a -> b) -> AtomURI -> b@@ -74,7 +82,7 @@  -- | An atom person construct. data AtomPerson = AtomPerson-  { personName  :: NonNull Text+  { personName  :: Refined (Not Null) Text   , personEmail :: Text   , personUri   :: Maybe AtomURI   }@@ -82,11 +90,12 @@ deriving instance Eq AtomPerson deriving instance Ord AtomPerson deriving instance Generic AtomPerson+-- deriving instance Read AtomPerson deriving instance Show AtomPerson  -- | The @atom:category@ element. data AtomCategory = AtomCategory-  { categoryTerm   :: NonNull Text+  { categoryTerm   :: Refined (Not Null) Text   , categoryScheme :: Text   , categoryLabel  :: Text   }@@ -115,7 +124,7 @@ data AtomGenerator = AtomGenerator   { generatorUri     :: Maybe AtomURI   , generatorVersion :: Text-  , generatorContent :: NonNull Text+  , generatorContent :: Refined (Not Null) Text   }  deriving instance Eq AtomGenerator

@@ -1,5 +1,5 @@ name: atom-conduit-version: 0.5.0.3+version: 0.6.0.0 cabal-version: >=1.10 build-type: Simple license: PublicDomain@@ -33,8 +33,8 @@         conduit >=1.3,         safe-exceptions -any,         lens-simple -any,-        mono-traversable >=1.0.0.1,         parsers -any,+        refined -any,         text -any,         time >=1.5,         timerep >=2.0,@@ -54,9 +54,10 @@         data-default -any,         filepath -any,         lens-simple -any,-        mono-traversable >=1.0.0.1,         parsers -any,+        pretty-simple -any,         quickcheck-instances -any,+        refined -any,         resourcet -any,         safe-exceptions -any,         tasty -any,

@@ -10,8 +10,6 @@ import           Data.Default import           Data.Functor.Identity import           Data.Monoid-import           Data.MonoTraversable-import           Data.NonNull import           Data.String import           Data.Text                    as Text import           Data.Text.Encoding           as Text@@ -20,6 +18,7 @@ import           Data.Void import           Data.XML.Types import           Lens.Simple+import           Refined import           System.FilePath import           Test.QuickCheck.Instances import           Test.Tasty@@ -31,6 +30,7 @@ import           Text.Atom.Lens import           Text.Atom.Types import           Text.Parser.Combinators+import           Text.Pretty.Simple import qualified Text.XML.Stream.Parse        as XML import           URI.ByteString @@ -55,7 +55,7 @@   return $ testGroup "Atom golden tests" $ do     xmlFile <- xmlFiles     let goldenFile = addExtension xmlFile ".golden"-        f file = fmap (Lazy.encodeUtf8 . fromString . show) $ runResourceT $ runConduit $ sourceFile file .| Conduit.decodeUtf8 .| XML.parseText' def .| XML.force "Invalid <feed>" atomFeed+        f file = fmap (Lazy.encodeUtf8 . pShowNoColor) $ runResourceT $ runConduit $ sourceFile file .| Conduit.decodeUtf8 .| XML.parseText' def .| XML.force "Invalid <feed>" atomFeed     return $ goldenVsString xmlFile goldenFile $ f xmlFile  properties :: TestTree@@ -81,7 +81,7 @@ personCase :: TestTree personCase = testCase "Person construct" $ do   result <- runResourceT . runConduit $ yieldMany input .| XML.parseText' def .| XML.force "Invalid <author>" (atomPerson "author")-  toNullable (result ^. personNameL) @?= "John Doe"+  unrefine (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 =@@ -97,7 +97,7 @@   result <- runResourceT . runConduit $ yieldMany input .| XML.parseText' def .| XML.force "Invalid <generator>" atomGenerator   result ^. generatorUriL @?= Just (AtomURI $ RelativeRef Nothing "/myblog.php" (Query []) Nothing)   (result ^. generatorVersionL) @?= "1.0"-  toNullable (result ^. generatorContentL) @?= "Example Toolkit"+  unrefine (result ^. generatorContentL) @?= "Example Toolkit"   where input =           [ "<generator xmlns=\"http://www.w3.org/2005/Atom\" uri=\"/myblog.php\" version=\"1.0\">"           , "Example Toolkit"@@ -151,8 +151,10 @@ digit = arbitrary `suchThat` isDigit alphaNum = oneof [letter, digit] -instance (MonoFoldable a, Arbitrary a) => Arbitrary (NonNull a) where-  arbitrary = impureNonNull <$> arbitrary `suchThat` (not . onull)+instance Arbitrary (Refined (Not Null) Text) where+  arbitrary = do+    ~(Right text) <- refine <$> arbitrary `suchThat` (not . Text.null)+    return text  instance Arbitrary Scheme where   arbitrary = do@@ -214,7 +216,7 @@  instance Arbitrary AtomGenerator where   arbitrary = do-    ~(Just content) <- fromNullable . pack <$> listOf1 alphaNum+    ~(Right content) <- refine . pack <$> listOf1 alphaNum     AtomGenerator <$> arbitrary <*> arbitrary <*> pure content   shrink = genericShrink