{-# 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
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 :: forall (m :: * -> *). MonadThrow m => Text -> m UTCTime
asDate Text
text =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw forall a b. (a -> b) -> a -> b
$ Text -> ParsingException
InvalidTime Text
text) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> UTCTime
zonedTimeToUTC) forall a b. (a -> b) -> a -> b
$
    forall t. TextualMonoid t => t -> Maybe ZonedTime
parseTimeRFC3339 Text
text forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall t. TextualMonoid t => t -> Maybe ZonedTime
parseTimeRFC2822 Text
text forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall t. TextualMonoid t => t -> Maybe ZonedTime
parseTimeRFC822 Text
text forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe ZonedTime
parseDateISO8601 Text
text
 where
  parseDateISO8601 :: Text -> Maybe ZonedTime
parseDateISO8601 = forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
iso8601ParseM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack

dcName :: Text -> Name
dcName :: Text -> Name
dcName Text
string = Text -> Maybe Text -> Maybe Text -> Name
Name Text
string (forall a. a -> Maybe a
Just Text
"http://purl.org/dc/elements/1.1/") (forall a. a -> Maybe a
Just Text
namespacePrefix)

dcTagIgnoreAttrs :: MonadThrow m => Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a)
dcTagIgnoreAttrs :: forall (m :: * -> *) o a.
MonadThrow m =>
Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a)
dcTagIgnoreAttrs Text
name = forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagIgnoreAttrs ((Name -> Bool) -> NameMatcher Name
matching (forall a. Eq a => a -> a -> Bool
== Text -> Name
dcName Text
name))

-- }}}

newtype ParsingException = InvalidTime Text deriving (ParsingException -> ParsingException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParsingException -> ParsingException -> Bool
$c/= :: ParsingException -> ParsingException -> Bool
== :: ParsingException -> ParsingException -> Bool
$c== :: ParsingException -> ParsingException -> Bool
Eq, forall x. Rep ParsingException x -> ParsingException
forall x. ParsingException -> Rep ParsingException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParsingException x -> ParsingException
$cfrom :: forall x. ParsingException -> Rep ParsingException x
Generic, Eq ParsingException
ParsingException -> ParsingException -> Bool
ParsingException -> ParsingException -> Ordering
ParsingException -> ParsingException -> ParsingException
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ParsingException -> ParsingException -> ParsingException
$cmin :: ParsingException -> ParsingException -> ParsingException
max :: ParsingException -> ParsingException -> ParsingException
$cmax :: ParsingException -> ParsingException -> ParsingException
>= :: ParsingException -> ParsingException -> Bool
$c>= :: ParsingException -> ParsingException -> Bool
> :: ParsingException -> ParsingException -> Bool
$c> :: ParsingException -> ParsingException -> Bool
<= :: ParsingException -> ParsingException -> Bool
$c<= :: ParsingException -> ParsingException -> Bool
< :: ParsingException -> ParsingException -> Bool
$c< :: ParsingException -> ParsingException -> Bool
compare :: ParsingException -> ParsingException -> Ordering
$ccompare :: ParsingException -> ParsingException -> Ordering
Ord, Int -> ParsingException -> ShowS
[ParsingException] -> ShowS
ParsingException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParsingException] -> ShowS
$cshowList :: [ParsingException] -> ShowS
show :: ParsingException -> String
$cshow :: ParsingException -> String
showsPrec :: Int -> ParsingException -> ShowS
$cshowsPrec :: Int -> ParsingException -> ShowS
Show)

instance Exception ParsingException where
  displayException :: ParsingException -> String
displayException (InvalidTime Text
t) = String
"Invalid time: " forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
t

-- | Parse a @\<dc:contributor\>@ element.
elementContributor :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementContributor :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitM Event o m (Maybe Text)
elementContributor = forall (m :: * -> *) o a.
MonadThrow m =>
Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a)
dcTagIgnoreAttrs Text
"contributor" forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content

-- | Parse a @\<dc:coverage\>@ element.
elementCoverage :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementCoverage :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitM Event o m (Maybe Text)
elementCoverage = forall (m :: * -> *) o a.
MonadThrow m =>
Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a)
dcTagIgnoreAttrs Text
"coverage" forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content

-- | Parse a @\<dc:creator\>@ element.
elementCreator :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementCreator :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitM Event o m (Maybe Text)
elementCreator = forall (m :: * -> *) o a.
MonadThrow m =>
Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a)
dcTagIgnoreAttrs Text
"creator" forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content

-- | Parse a @\<dc:date\>@ element.
--
-- Throws 'InvalidTime' in case date is malformatted.
elementDate :: MonadThrow m => ConduitM Event o m (Maybe UTCTime)
elementDate :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitM Event o m (Maybe UTCTime)
elementDate = forall (m :: * -> *) o a.
MonadThrow m =>
Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a)
dcTagIgnoreAttrs Text
"date" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadThrow m => Text -> m UTCTime
asDate

-- | Parse a @\<dc:description\>@ element.
elementDescription :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementDescription :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitM Event o m (Maybe Text)
elementDescription = forall (m :: * -> *) o a.
MonadThrow m =>
Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a)
dcTagIgnoreAttrs Text
"description" forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content

-- | Parse a @\<dc:format\>@ element.
elementFormat :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementFormat :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitM Event o m (Maybe Text)
elementFormat = forall (m :: * -> *) o a.
MonadThrow m =>
Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a)
dcTagIgnoreAttrs Text
"format" forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content

-- | Parse a @\<dc:identifier\>@ element.
elementIdentifier :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementIdentifier :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitM Event o m (Maybe Text)
elementIdentifier = forall (m :: * -> *) o a.
MonadThrow m =>
Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a)
dcTagIgnoreAttrs Text
"identifier" forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content

-- | Parse a @\<dc:language\>@ element.
elementLanguage :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementLanguage :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitM Event o m (Maybe Text)
elementLanguage = forall (m :: * -> *) o a.
MonadThrow m =>
Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a)
dcTagIgnoreAttrs Text
"language" forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content

-- | Parse a @\<dc:publisher\>@ element.
elementPublisher :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementPublisher :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitM Event o m (Maybe Text)
elementPublisher = forall (m :: * -> *) o a.
MonadThrow m =>
Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a)
dcTagIgnoreAttrs Text
"publisher" forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content

-- | Parse a @\<dc:relation\>@ element.
elementRelation :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementRelation :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitM Event o m (Maybe Text)
elementRelation = forall (m :: * -> *) o a.
MonadThrow m =>
Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a)
dcTagIgnoreAttrs Text
"relation" forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content

-- | Parse a @\<dc:rights\>@ element.
elementRights :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementRights :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitM Event o m (Maybe Text)
elementRights = forall (m :: * -> *) o a.
MonadThrow m =>
Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a)
dcTagIgnoreAttrs Text
"rights" forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content

-- | Parse a @\<dc:source\>@ element.
elementSource :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementSource :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitM Event o m (Maybe Text)
elementSource = forall (m :: * -> *) o a.
MonadThrow m =>
Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a)
dcTagIgnoreAttrs Text
"source" forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content

-- | Parse a @\<dc:subject\>@ element.
elementSubject :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementSubject :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitM Event o m (Maybe Text)
elementSubject = forall (m :: * -> *) o a.
MonadThrow m =>
Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a)
dcTagIgnoreAttrs Text
"subject" forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content

-- | Parse a @\<dc:title\>@ element.
elementTitle :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementTitle :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitM Event o m (Maybe Text)
elementTitle = forall (m :: * -> *) o a.
MonadThrow m =>
Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a)
dcTagIgnoreAttrs Text
"title" forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content

-- | Parse a @\<dc:type\>@ element.
elementType :: MonadThrow m => ConduitM Event o m (Maybe Text)
elementType :: forall (m :: * -> *) o.
MonadThrow m =>
ConduitM Event o m (Maybe Text)
elementType = forall (m :: * -> *) o a.
MonadThrow m =>
Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a)
dcTagIgnoreAttrs Text
"type" forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content