module Text.XML.DublinCore.Conduit.Parse
(
elementContributor
, elementCoverage
, elementCreator
, elementDate
, elementDescription
, elementFormat
, elementIdentifier
, elementLanguage
, elementPublisher
, elementRelation
, elementRights
, elementSource
, elementSubject
, elementTitle
, elementType
, ParsingException(..)
) where
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
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
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
elementContributor :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementContributor = dcTagIgnoreAttrs "contributor" content
elementCoverage :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementCoverage = dcTagIgnoreAttrs "coverage" content
elementCreator :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementCreator = dcTagIgnoreAttrs "creator" content
elementDate :: MonadThrow m => ConduitM Event o m (Maybe UTCTime)
elementDate = dcTagIgnoreAttrs "date" $ content >>= asDate
elementDescription :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementDescription = dcTagIgnoreAttrs "description" content
elementFormat :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementFormat = dcTagIgnoreAttrs "format" content
elementIdentifier :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementIdentifier = dcTagIgnoreAttrs "identifier" content
elementLanguage :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementLanguage = dcTagIgnoreAttrs "language" content
elementPublisher :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementPublisher = dcTagIgnoreAttrs "publisher" content
elementRelation :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementRelation = dcTagIgnoreAttrs "relation" content
elementRights :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementRights = dcTagIgnoreAttrs "rights" content
elementSource :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementSource = dcTagIgnoreAttrs "source" content
elementSubject :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementSubject = dcTagIgnoreAttrs "subject" content
elementTitle :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementTitle = dcTagIgnoreAttrs "title" content
elementType :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementType = dcTagIgnoreAttrs "type" content