dublincore-xml-conduit (empty) → 0.1.0.0

raw patch · 7 files changed

+351/−0 lines, 7 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, conduit, conduit-combinators, data-default, dublincore-xml-conduit, hlint, quickcheck-instances, resourcet, safe-exceptions, tasty, tasty-hunit, tasty-quickcheck, text, time, timerep, uri-bytestring, xml-conduit, xml-types

Files

• README.md +8/−0
• Setup.hs +2/−0
• dublincore-xml-conduit.cabal +31/−0
• src/Text/XML/DublinCore.hs +21/−0
• src/Text/XML/DublinCore/Conduit/Parse.hs +126/−0
• src/Text/XML/DublinCore/Conduit/Render.hs +101/−0
• test/Main.hs +62/−0

@@ -0,0 +1,8 @@+# dublincore-xml-conduit++This [Haskell][hsk] library implements an XML streaming parser/renderer for the **Dublin Core Metadata Element Set** Version 1.1 ([RFC 5013][dc]), based on [conduit][cdt]s.+++[dc]: https://tools.ietf.org/html/rfc5013+[cdt]: https://hackage.haskell.org/package/conduit+[hsk]: https://haskell.org

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

@@ -0,0 +1,31 @@+name:                dublincore-xml-conduit+version:             0.1.0.0+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+category:            Data+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  exposed-modules:+    Text.XML.DublinCore+    Text.XML.DublinCore.Conduit.Parse+    Text.XML.DublinCore.Conduit.Render+  -- other-modules:+  -- other-extensions:+  build-depends:       base >= 4.8 && < 5, conduit, conduit-combinators, safe-exceptions, time >= 1.5, text, timerep >= 2.0, uri-bytestring, xml-conduit, xml-types+  hs-source-dirs:      src+  default-language:    Haskell2010++test-suite Tests+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Main.hs+  -- other-modules:+  build-depends: dublincore-xml-conduit, base >= 4.8 && < 5, bytestring, conduit, conduit-combinators, data-default, safe-exceptions, hlint, QuickCheck, quickcheck-instances, resourcet, tasty, tasty-hunit, tasty-quickcheck, time >= 1.5, text, uri-bytestring >= 0.2, xml-conduit >= 1.3, xml-types+  default-language: Haskell2010

@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Common XML definitions for the __Dublin Core Metadata Element Set__.+--+-- This module is meant to be imported qualified, like this:+--+-- > import qualified Text.XML.DublinCore as DC+module Text.XML.DublinCore where++-- {{{ Imports+import           Data.Text+import           URI.ByteString+-- }}}+++-- | Standard XML prefix is @dc@.+namespacePrefix :: Text+namespacePrefix = "dc"++-- | Standard XML namespace is @http://purl.org/dc/elements/1.1/@.+namespaceURI :: URIRef Absolute+namespaceURI = uri where Right uri = parseURI laxURIParserOptions "http://purl.org/dc/elements/1.1/"

@@ -0,0 +1,126 @@+{-# 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++-- {{{ Imports+import           Text.XML.DublinCore++import           Conduit                hiding (throwM)+import           Control.Applicative+import           Control.Exception.Safe as Exception+import           Data.Text+import           Data.Time.Clock+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++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)++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)+elementContributor = dcTagIgnoreAttrs "contributor" content++-- | Parse a @\<dc:coverage\>@ element.+elementCoverage :: MonadThrow m => ConduitM Event o m (Maybe Text)+elementCoverage = dcTagIgnoreAttrs "coverage" content++-- | Parse a @\<dc:creator\>@ element.+elementCreator :: MonadThrow m => ConduitM Event o m (Maybe Text)+elementCreator = dcTagIgnoreAttrs "creator" content++-- | Parse a @\<dc:date\>@ element.+--+-- Throws 'InvalidTime' in case date is malformatted.+elementDate :: MonadThrow m => ConduitM Event o m (Maybe UTCTime)+elementDate = dcTagIgnoreAttrs "date" $ content >>= asDate++-- | Parse a @\<dc:description\>@ element.+elementDescription :: MonadThrow m => ConduitM Event o m (Maybe Text)+elementDescription = dcTagIgnoreAttrs "description" content++-- | Parse a @\<dc:format\>@ element.+elementFormat :: MonadThrow m => ConduitM Event o m (Maybe Text)+elementFormat = dcTagIgnoreAttrs "format" content++-- | Parse a @\<dc:identifier\>@ element.+elementIdentifier :: MonadThrow m => ConduitM Event o m (Maybe Text)+elementIdentifier = dcTagIgnoreAttrs "identifier" content++-- | Parse a @\<dc:language\>@ element.+elementLanguage :: MonadThrow m => ConduitM Event o m (Maybe Text)+elementLanguage = dcTagIgnoreAttrs "language" content++-- | Parse a @\<dc:publisher\>@ element.+elementPublisher :: MonadThrow m => ConduitM Event o m (Maybe Text)+elementPublisher = dcTagIgnoreAttrs "publisher" content++-- | Parse a @\<dc:relation\>@ element.+elementRelation :: MonadThrow m => ConduitM Event o m (Maybe Text)+elementRelation = dcTagIgnoreAttrs "relation" content++-- | Parse a @\<dc:rights\>@ element.+elementRights :: MonadThrow m => ConduitM Event o m (Maybe Text)+elementRights = dcTagIgnoreAttrs "rights" content++-- | Parse a @\<dc:source\>@ element.+elementSource :: MonadThrow m => ConduitM Event o m (Maybe Text)+elementSource = dcTagIgnoreAttrs "source" content++-- | Parse a @\<dc:subject\>@ element.+elementSubject :: MonadThrow m => ConduitM Event o m (Maybe Text)+elementSubject = dcTagIgnoreAttrs "subject" content++-- | Parse a @\<dc:title\>@ element.+elementTitle :: MonadThrow m => ConduitM Event o m (Maybe Text)+elementTitle = dcTagIgnoreAttrs "title" content++-- | Parse a @\<dc:type\>@ element.+elementType :: MonadThrow m => ConduitM Event o m (Maybe Text)+elementType = dcTagIgnoreAttrs "type" content

@@ -0,0 +1,101 @@+{-# 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++-- {{{ Imports+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+-- }}}+++-- {{{ 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 = tag (dcName "contributor") mempty . content++-- | Render a @\<dc:coverage\>@ element.+renderElementCoverage :: Monad m => Text -> Source m Event+renderElementCoverage = tag (dcName "coverage") mempty . content++-- | Render a @\<dc:creator\>@ element.+renderElementCreator :: Monad m => Text -> Source m Event+renderElementCreator = tag (dcName "creator") mempty . content++-- | Render a @\<dc:date\>@ element.+renderElementDate :: Monad m => UTCTime -> Source m Event+renderElementDate = tag (dcName "date") mempty . content . formatTimeRFC3339 . utcToZonedTime utc++-- | Render a @\<dc:description\>@ element.+renderElementDescription :: Monad m => Text -> Source m Event+renderElementDescription = tag (dcName "description") mempty . content++-- | Render a @\<dc:format\>@ element.+renderElementFormat :: Monad m => Text -> Source m Event+renderElementFormat = tag (dcName "format") mempty . content++-- | Render a @\<dc:identifier\>@ element.+renderElementIdentifier :: Monad m => Text -> Source m Event+renderElementIdentifier = tag (dcName "identifier") mempty . content++-- | Render a @\<dc:language\>@ element.+renderElementLanguage :: Monad m => Text -> Source m Event+renderElementLanguage = tag (dcName "language") mempty . content++-- | Render a @\<dc:publisher\>@ element.+renderElementPublisher :: Monad m => Text -> Source m Event+renderElementPublisher = tag (dcName "publisher") mempty . content++-- | Render a @\<dc:relation\>@ element.+renderElementRelation :: Monad m => Text -> Source m Event+renderElementRelation = tag (dcName "relation") mempty . content++-- | Render a @\<dc:rights\>@ element.+renderElementRights :: Monad m => Text -> Source m Event+renderElementRights = tag (dcName "rights") mempty . content++-- | Render a @\<dc:source\>@ element.+renderElementSource :: Monad m => Text -> Source m Event+renderElementSource = tag (dcName "source") mempty . content++-- | Render a @\<dc:subject\>@ element.+renderElementSubject :: Monad m => Text -> Source m Event+renderElementSubject = tag (dcName "subject") mempty . content++-- | Render a @\<dc:title\>@ element.+renderElementTitle :: Monad m => Text -> Source m Event+renderElementTitle = tag (dcName "title") mempty . content++-- | Render a @\<dc:type\>@ element.+renderElementType :: Monad m => Text -> Source m Event+renderElementType = tag (dcName "type") mempty . content

@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes        #-}+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 qualified Language.Haskell.HLint             as HLint (hlint)+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+  , hlint+  ]++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+  ]++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+              => TestName -> (a -> Source (Either e) Event) -> Consumer Event (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)++hlint :: TestTree+hlint = testCase "HLint check" $ do+  result <- HLint.hlint [ "test/", "src/" ]+  Prelude.null result @?= True++-- | Generate 'UTCTime' with rounded seconds.+genTime :: Gen UTCTime+genTime = do+  (UTCTime d s) <- arbitrary+  return $ UTCTime d $ fromIntegral (round s :: Int)