dublincore-xml-conduit 0.1.0.2 → 0.1.0.3

raw patch · 7 files changed

+155/−130 lines, 7 filessetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Setup.hs +1/−0
• dublincore-xml-conduit.cabal +2/−2
• src/Text/XML/DublinCore.hs +4/−3
• src/Text/XML/DublinCore/Conduit/Parse.hs +46/−42
• src/Text/XML/DublinCore/Conduit/Render.hs +43/−41
• test/HLint.hs +2/−3
• test/Main.hs +57/−39

@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain

@@ -1,11 +1,11 @@ name:                dublincore-xml-conduit-version:             0.1.0.2+version:             0.1.0.3 synopsis:            XML streaming parser/renderer for the Dublin Core standard elements. description:         Cf README file. homepage:            https://github.com/k0ral/dublincore-xml-conduit license:             PublicDomain author:              koral-maintainer:          koral@mailoo.org+maintainer:          mail@cmoreau.info category:            Data build-type:          Simple extra-source-files:  README.md

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+ -- | Common XML definitions for the __Dublin Core Metadata Element Set__. -- -- This module is meant to be imported qualified, like this:@@ -7,10 +8,10 @@ module Text.XML.DublinCore where  -- {{{ Imports-import           Data.Text-import           URI.ByteString--- }}}+import Data.Text+import URI.ByteString +-- }}}  -- | Standard XML prefix is @dc@. namespacePrefix :: Text

@@ -1,69 +1,73 @@-{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}+ -- | XML streaming parsers for the __Dublin Core Metadata Element Set__. -- -- This module is meant to be imported qualified, like this: -- -- > import qualified Text.XML.DublinCore.Conduit.Parse as DC-module Text.XML.DublinCore.Conduit.Parse-  ( -- * Elements-    elementContributor-  , elementCoverage-  , elementCreator-  , elementDate-  , elementDescription-  , elementFormat-  , elementIdentifier-  , elementLanguage-  , elementPublisher-  , elementRelation-  , elementRights-  , elementSource-  , elementSubject-  , elementTitle-  , elementType-    -- * Misc-  , ParsingException(..)-  ) where+module Text.XML.DublinCore.Conduit.Parse (+  -- * Elements+  elementContributor,+  elementCoverage,+  elementCreator,+  elementDate,+  elementDescription,+  elementFormat,+  elementIdentifier,+  elementLanguage,+  elementPublisher,+  elementRelation,+  elementRights,+  elementSource,+  elementSubject,+  elementTitle,+  elementType, +  -- * Misc+  ParsingException (..),+) where+ -- {{{ Imports-import           Text.XML.DublinCore+import Text.XML.DublinCore -import           Conduit-import           Control.Applicative-import           Control.Exception.Safe as Exception-import           Data.Text-import           Data.Time.Clock-import           Data.Time.Format-import           Data.Time.LocalTime-import           Data.Time.RFC2822-import           Data.Time.RFC3339-import           Data.Time.RFC822-import           Data.XML.Types-import           GHC.Generics-import           Text.XML.Stream.Parse+import Conduit+import Control.Applicative+import Control.Exception.Safe as Exception+import Data.Text+import Data.Time.Clock+import Data.Time.Format (defaultTimeLocale, parseTimeM)+import Data.Time.Format.ISO8601 (iso8601ParseM)+import Data.Time.LocalTime+import Data.Time.RFC2822+import Data.Time.RFC3339+import Data.Time.RFC822+import Data.XML.Types+import GHC.Generics+import Text.XML.Stream.Parse+ -- }}}  -- {{{ Utils asDate :: MonadThrow m => Text -> m UTCTime-asDate text = maybe (throw $ InvalidTime text) (return . zonedTimeToUTC) $-  parseTimeRFC3339 text <|> parseTimeRFC2822 text <|> parseTimeRFC822 text <|> parseDateISO8601 text-  where parseDateISO8601 = parseTimeM True defaultTimeLocale (iso8601DateFormat Nothing) . unpack+asDate text =+  maybe (throw $ InvalidTime text) (return . zonedTimeToUTC) $+    parseTimeRFC3339 text <|> parseTimeRFC2822 text <|> parseTimeRFC822 text <|> parseDateISO8601 text+ where+  parseDateISO8601 = iso8601ParseM . unpack  dcName :: Text -> Name dcName string = Name string (Just "http://purl.org/dc/elements/1.1/") (Just namespacePrefix)  dcTagIgnoreAttrs :: MonadThrow m => Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a) dcTagIgnoreAttrs name = tagIgnoreAttrs (matching (== dcName name))+ -- }}} -newtype ParsingException = InvalidTime Text deriving(Eq, Generic, Ord, Show)+newtype ParsingException = InvalidTime Text deriving (Eq, Generic, Ord, Show)  instance Exception ParsingException where   displayException (InvalidTime t) = "Invalid time: " ++ unpack t---  -- | Parse a @\<dc:contributor\>@ element. elementContributor :: MonadThrow m => ConduitM Event o m (Maybe Text)

@@ -1,101 +1,103 @@ {-# LANGUAGE OverloadedStrings #-}+ -- | XML streaming renderers for the __Dublin Core Metadata Element Set__. -- -- This module is meant to be imported qualified, like this: -- -- > import qualified Text.XML.DublinCore.Conduit.Render as DC-module Text.XML.DublinCore.Conduit.Render-  ( renderElementContributor-  , renderElementCoverage-  , renderElementCreator-  , renderElementDate-  , renderElementDescription-  , renderElementFormat-  , renderElementIdentifier-  , renderElementLanguage-  , renderElementPublisher-  , renderElementRelation-  , renderElementRights-  , renderElementSource-  , renderElementSubject-  , renderElementTitle-  , renderElementType-  ) where+module Text.XML.DublinCore.Conduit.Render (+  renderElementContributor,+  renderElementCoverage,+  renderElementCreator,+  renderElementDate,+  renderElementDescription,+  renderElementFormat,+  renderElementIdentifier,+  renderElementLanguage,+  renderElementPublisher,+  renderElementRelation,+  renderElementRights,+  renderElementSource,+  renderElementSubject,+  renderElementTitle,+  renderElementType,+) where  -- {{{ Imports-import           Text.XML.DublinCore+import Text.XML.DublinCore -import           Conduit-import           Data.Text-import           Data.Time.Clock-import           Data.Time.LocalTime-import           Data.Time.RFC3339-import           Data.XML.Types-import           Text.XML.Stream.Render--- }}}+import Conduit+import Data.Text+import Data.Time.Clock+import Data.Time.LocalTime+import Data.Time.RFC3339+import Data.XML.Types+import Text.XML.Stream.Render +-- }}}  -- {{{ Utils dcName :: Text -> Name dcName string = Name string (Just "http://purl.org/dc/elements/1.1/") (Just namespacePrefix)+ -- }}}  -- | Render a @\<dc:contributor\>@ element.-renderElementContributor :: Monad m => Text -> Source m Event+renderElementContributor :: Monad m => Text -> ConduitT () Event m () renderElementContributor = tag (dcName "contributor") mempty . content  -- | Render a @\<dc:coverage\>@ element.-renderElementCoverage :: Monad m => Text -> Source m Event+renderElementCoverage :: Monad m => Text -> ConduitT () Event m () renderElementCoverage = tag (dcName "coverage") mempty . content  -- | Render a @\<dc:creator\>@ element.-renderElementCreator :: Monad m => Text -> Source m Event+renderElementCreator :: Monad m => Text -> ConduitT () Event m () renderElementCreator = tag (dcName "creator") mempty . content  -- | Render a @\<dc:date\>@ element.-renderElementDate :: Monad m => UTCTime -> Source m Event+renderElementDate :: Monad m => UTCTime -> ConduitT () Event m () renderElementDate = tag (dcName "date") mempty . content . formatTimeRFC3339 . utcToZonedTime utc  -- | Render a @\<dc:description\>@ element.-renderElementDescription :: Monad m => Text -> Source m Event+renderElementDescription :: Monad m => Text -> ConduitT () Event m () renderElementDescription = tag (dcName "description") mempty . content  -- | Render a @\<dc:format\>@ element.-renderElementFormat :: Monad m => Text -> Source m Event+renderElementFormat :: Monad m => Text -> ConduitT () Event m () renderElementFormat = tag (dcName "format") mempty . content  -- | Render a @\<dc:identifier\>@ element.-renderElementIdentifier :: Monad m => Text -> Source m Event+renderElementIdentifier :: Monad m => Text -> ConduitT () Event m () renderElementIdentifier = tag (dcName "identifier") mempty . content  -- | Render a @\<dc:language\>@ element.-renderElementLanguage :: Monad m => Text -> Source m Event+renderElementLanguage :: Monad m => Text -> ConduitT () Event m () renderElementLanguage = tag (dcName "language") mempty . content  -- | Render a @\<dc:publisher\>@ element.-renderElementPublisher :: Monad m => Text -> Source m Event+renderElementPublisher :: Monad m => Text -> ConduitT () Event m () renderElementPublisher = tag (dcName "publisher") mempty . content  -- | Render a @\<dc:relation\>@ element.-renderElementRelation :: Monad m => Text -> Source m Event+renderElementRelation :: Monad m => Text -> ConduitT () Event m () renderElementRelation = tag (dcName "relation") mempty . content  -- | Render a @\<dc:rights\>@ element.-renderElementRights :: Monad m => Text -> Source m Event+renderElementRights :: Monad m => Text -> ConduitT () Event m () renderElementRights = tag (dcName "rights") mempty . content  -- | Render a @\<dc:source\>@ element.-renderElementSource :: Monad m => Text -> Source m Event+renderElementSource :: Monad m => Text -> ConduitT () Event m () renderElementSource = tag (dcName "source") mempty . content  -- | Render a @\<dc:subject\>@ element.-renderElementSubject :: Monad m => Text -> Source m Event+renderElementSubject :: Monad m => Text -> ConduitT () Event m () renderElementSubject = tag (dcName "subject") mempty . content  -- | Render a @\<dc:title\>@ element.-renderElementTitle :: Monad m => Text -> Source m Event+renderElementTitle :: Monad m => Text -> ConduitT () Event m () renderElementTitle = tag (dcName "title") mempty . content  -- | Render a @\<dc:type\>@ element.-renderElementType :: Monad m => Text -> Source m Event+renderElementType :: Monad m => Text -> ConduitT () Event m () renderElementType = tag (dcName "type") mempty . content

@@ -1,8 +1,7 @@ import qualified Language.Haskell.HLint as HLint (hlint)-import           System.Exit-+import System.Exit  main :: IO () main = do-  result <- HLint.hlint [ "test/", "src/" ]+  result <- HLint.hlint ["test/", "src/"]   if null result then exitSuccess else exitFailure

@@ -1,52 +1,70 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes        #-}-import           Text.XML.DublinCore.Conduit.Parse-import           Text.XML.DublinCore.Conduit.Render+{-# LANGUAGE RankNTypes #-} -import           Conduit-import           Data.Monoid-import           Data.Text-import           Data.Time.Clock-import           Data.XML.Types-import           Test.QuickCheck-import           Test.QuickCheck.Instances          ()-import           Test.Tasty-import           Test.Tasty.HUnit-import           Test.Tasty.QuickCheck+import Text.XML.DublinCore.Conduit.Parse+import Text.XML.DublinCore.Conduit.Render +import Conduit+import Data.Monoid+import Data.Text+import Data.Time.Clock+import Data.XML.Types+import Test.QuickCheck+import Test.QuickCheck.Instances ()+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+ main :: IO ()-main = defaultMain $ testGroup "Tests"-  [ properties-  ]+main =+  defaultMain $+    testGroup+      "Tests"+      [ properties+      ]  properties :: TestTree-properties = testGroup "Properties"-  [ roundtripTest "contributor" renderElementContributor elementContributor-  , roundtripTest "coverage" renderElementCoverage elementCoverage-  , roundtripTest "creator" renderElementCreator elementCreator-  , roundtripTest' "date" renderElementDate elementDate genTime-  , roundtripTest "description" renderElementDescription elementDescription-  , roundtripTest "format" renderElementFormat elementFormat-  , roundtripTest "identifier" renderElementIdentifier elementIdentifier-  , roundtripTest "language" renderElementLanguage elementLanguage-  , roundtripTest "publisher" renderElementPublisher elementPublisher-  , roundtripTest "relation" renderElementRelation elementRelation-  , roundtripTest "rights" renderElementRights elementRights-  , roundtripTest "source" renderElementSource elementSource-  , roundtripTest "subject" renderElementSubject elementSubject-  , roundtripTest "title" renderElementTitle elementTitle-  , roundtripTest "type" renderElementType elementType-  ]+properties =+  testGroup+    "Properties"+    [ roundtripTest "contributor" renderElementContributor elementContributor+    , roundtripTest "coverage" renderElementCoverage elementCoverage+    , roundtripTest "creator" renderElementCreator elementCreator+    , roundtripTest' "date" renderElementDate elementDate genTime+    , roundtripTest "description" renderElementDescription elementDescription+    , roundtripTest "format" renderElementFormat elementFormat+    , roundtripTest "identifier" renderElementIdentifier elementIdentifier+    , roundtripTest "language" renderElementLanguage elementLanguage+    , roundtripTest "publisher" renderElementPublisher elementPublisher+    , roundtripTest "relation" renderElementRelation elementRelation+    , roundtripTest "rights" renderElementRights elementRights+    , roundtripTest "source" renderElementSource elementSource+    , roundtripTest "subject" renderElementSubject elementSubject+    , roundtripTest "title" renderElementTitle elementTitle+    , roundtripTest "type" renderElementType elementType+    ] -roundtripTest :: Eq a => Show a => Arbitrary a-              => TestName -> (a -> Source (Either e) Event) -> Consumer Event (Either e) (Maybe a) -> TestTree-roundtripTest name render parse = testProperty ("parse . render = id (" <> name <> ")") $ \t -> either (const False) (Just t ==) (runConduit $ render t =$= parse)+roundtripTest+  :: Eq a+  => Show a+  => Arbitrary a+  => TestName+  -> (a -> ConduitT () Event (Either e) ())+  -> ConduitT Event Void (Either e) (Maybe a)+  -> TestTree+roundtripTest name render parse = testProperty ("parse . render = id (" <> name <> ")") $ \t -> either (const False) (Just t ==) (runConduit $ render t .| parse) -roundtripTest' :: Eq a => Show a-              => TestName -> (a -> Source (Either e) Event) -> Consumer Event (Either e) (Maybe a) -> Gen a -> TestTree+roundtripTest'+  :: Eq a+  => Show a+  => TestName+  -> (a -> ConduitT () Event (Either e) ())+  -> ConduitT Event Void (Either e) (Maybe a)+  -> Gen a+  -> TestTree roundtripTest' name render parse gen = testProperty ("parse . render = id (" <> name <> ")") $ do   a <- gen-  return $ either (const False) (Just a ==) $ runConduit (render a =$= parse)+  return $ either (const False) (Just a ==) $ runConduit (render a .| parse)  -- | Generate 'UTCTime' with rounded seconds. genTime :: Gen UTCTime