{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}

module Network.Protocol.MusicBrainz.XML2.WebService (
    getRecordingById
  , getReleaseById
  , searchReleasesByArtistAndRelease
) where

import Network.Protocol.MusicBrainz.Types

import Control.Applicative (liftA2, (<|>))
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.IO.Unlift (MonadUnliftIO)
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Trans.Resource (MonadThrow)
import qualified Data.ByteString.Lazy as BL
import Data.Conduit (ConduitM, (.|), runConduitRes)
import Data.Conduit.Binary (sourceLbs)
import Data.List (intercalate)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Read as TR
import Data.Time.Format (parseTimeM)
import qualified Data.Vector as V
import Data.Void (Void)
import Data.XML.Types (Event)
import Network.HTTP.Base (urlEncode)
import Network.HTTP.Conduit (simpleHttp)
import Data.Time.Locale.Compat (defaultTimeLocale)
import Text.XML.Stream.Parse (parseBytes, def, content, tagNoAttr, tag', requireAttr, attr, force, many, AttrParser)
import Text.XML (Name(..))

musicBrainzWSLookup :: MonadIO m => Text -> Text -> [Text] -> m BL.ByteString
musicBrainzWSLookup :: forall (m :: * -> *).
MonadIO m =>
Text -> Text -> [Text] -> m ByteString
musicBrainzWSLookup Text
reqtype Text
param [Text]
incparams = do
    let url :: [Char]
url = [Char]
"https://musicbrainz.org/ws/2/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
reqtype [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
param [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Text] -> [Char]
incs [Text]
incparams
    [Char] -> m ByteString
forall (m :: * -> *). MonadIO m => [Char] -> m ByteString
simpleHttp [Char]
url
    where
        incs :: [Text] -> [Char]
incs [] = [Char]
""
        incs [Text]
xs = ([Char]
"?inc="[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> ([Text] -> [Char]) -> [Text] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"+" ([[Char]] -> [Char]) -> ([Text] -> [[Char]]) -> [Text] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack ([Text] -> [Char]) -> [Text] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Text]
xs

musicBrainzWSSearch :: MonadIO m => Text -> Text -> Maybe Int -> Maybe Int -> m BL.ByteString
musicBrainzWSSearch :: forall (m :: * -> *).
MonadIO m =>
Text -> Text -> Maybe Int -> Maybe Int -> m ByteString
musicBrainzWSSearch Text
reqtype Text
query Maybe Int
mlimit Maybe Int
moffset = do
    let url :: [Char]
url = [Char]
"https://musicbrainz.org/ws/2/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
reqtype [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/?query=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
urlEncode (Text -> [Char]
T.unpack Text
query) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe Int -> [Char]
forall {a}. Show a => Maybe a -> [Char]
limit Maybe Int
mlimit [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe Int -> [Char]
forall {a}. Show a => Maybe a -> [Char]
offset Maybe Int
moffset
    [Char] -> m ByteString
forall (m :: * -> *). MonadIO m => [Char] -> m ByteString
simpleHttp [Char]
url
    where
        limit :: Maybe a -> [Char]
limit Maybe a
Nothing = [Char]
""
        limit (Just a
l) = [Char]
"&limit=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
l
        offset :: Maybe a -> [Char]
offset Maybe a
Nothing = [Char]
""
        offset (Just a
o) = [Char]
"&offset=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
o

getRecordingById :: (MonadBaseControl IO m, MonadIO m, MonadThrow m, MonadUnliftIO m) => MBID -> m Recording
getRecordingById :: forall (m :: * -> *).
(MonadBaseControl IO m, MonadIO m, MonadThrow m,
 MonadUnliftIO m) =>
MBID -> m Recording
getRecordingById MBID
mbid = do
    lbs <- Text -> Text -> [Text] -> m ByteString
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> [Text] -> m ByteString
musicBrainzWSLookup Text
"recording" (MBID -> Text
unMBID MBID
mbid) [Text
"artist-credits"]
    rs <- runConduitRes $ sourceLbs lbs .| parseBytes def .| sinkRecordings
    return $ head rs

getReleaseById :: (MonadBaseControl IO m, MonadIO m, MonadThrow m, MonadUnliftIO m) => MBID -> m Release
getReleaseById :: forall (m :: * -> *).
(MonadBaseControl IO m, MonadIO m, MonadThrow m,
 MonadUnliftIO m) =>
MBID -> m Release
getReleaseById MBID
mbid = do
    lbs <- Text -> Text -> [Text] -> m ByteString
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> [Text] -> m ByteString
musicBrainzWSLookup Text
"release" (MBID -> Text
unMBID MBID
mbid) [Text
"recordings", Text
"artist-credits"]
    rs <- runConduitRes $ sourceLbs lbs .| parseBytes def .| sinkReleases
    return $ head rs

sinkRecordings :: MonadThrow m => ConduitM Event Void m [Recording]
sinkRecordings :: forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m [Recording]
sinkRecordings = [Char]
-> ConduitT Event Void m (Maybe [Recording])
-> ConduitT Event Void m [Recording]
forall (m :: * -> *) a.
MonadThrow m =>
[Char] -> m (Maybe a) -> m a
force [Char]
"metadata required" (NameMatcher Name
-> ConduitT Event Void m [Recording]
-> ConduitT Event Void m (Maybe [Recording])
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}metadata" (ConduitT Event Void m [Recording]
 -> ConduitT Event Void m (Maybe [Recording]))
-> ConduitT Event Void m [Recording]
-> ConduitT Event Void m (Maybe [Recording])
forall a b. (a -> b) -> a -> b
$ ConduitT Event Void m (Maybe Recording)
-> ConduitT Event Void m [Recording]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ConduitT Event Void m (Maybe Recording)
forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m (Maybe Recording)
parseRecording)

sinkReleases :: MonadThrow m => ConduitM Event Void m [Release]
sinkReleases :: forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m [Release]
sinkReleases = [Char]
-> ConduitT Event Void m (Maybe [Release])
-> ConduitT Event Void m [Release]
forall (m :: * -> *) a.
MonadThrow m =>
[Char] -> m (Maybe a) -> m a
force [Char]
"metadata required" (NameMatcher Name
-> ConduitT Event Void m [Release]
-> ConduitT Event Void m (Maybe [Release])
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}metadata" (ConduitT Event Void m [Release]
 -> ConduitT Event Void m (Maybe [Release]))
-> ConduitT Event Void m [Release]
-> ConduitT Event Void m (Maybe [Release])
forall a b. (a -> b) -> a -> b
$ ConduitT Event Void m (Maybe Release)
-> ConduitT Event Void m [Release]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ((Maybe (Int, Release) -> Maybe Release)
-> ConduitT Event Void m (Maybe (Int, Release))
-> ConduitT Event Void m (Maybe Release)
forall a b.
(a -> b) -> ConduitT Event Void m a -> ConduitT Event Void m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Int, Release) -> Release)
-> Maybe (Int, Release) -> Maybe Release
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Release) -> Release
forall a b. (a, b) -> b
snd) ConduitT Event Void m (Maybe (Int, Release))
forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m (Maybe (Int, Release))
parseRelease))

sinkReleaseList :: MonadThrow m => ConduitM Event Void m [(Int, Release)]
sinkReleaseList :: forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m [(Int, Release)]
sinkReleaseList = [Char]
-> ConduitT Event Void m (Maybe [(Int, Release)])
-> ConduitT Event Void m [(Int, Release)]
forall (m :: * -> *) a.
MonadThrow m =>
[Char] -> m (Maybe a) -> m a
force [Char]
"metadata required" (NameMatcher Name
-> AttrParser (Maybe Text)
-> (Maybe Text -> ConduitT Event Void m [(Int, Release)])
-> ConduitT Event Void m (Maybe [(Int, Release)])
forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag' NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}metadata" (Name -> AttrParser (Maybe Text)
attr Name
"created") ((Maybe Text -> ConduitT Event Void m [(Int, Release)])
 -> ConduitT Event Void m (Maybe [(Int, Release)]))
-> (Maybe Text -> ConduitT Event Void m [(Int, Release)])
-> ConduitT Event Void m (Maybe [(Int, Release)])
forall a b. (a -> b) -> a -> b
$ \Maybe Text
_ ->
    [Char]
-> ConduitT Event Void m (Maybe [(Int, Release)])
-> ConduitT Event Void m [(Int, Release)]
forall (m :: * -> *) a.
MonadThrow m =>
[Char] -> m (Maybe a) -> m a
force [Char]
"release-list required" (NameMatcher Name
-> AttrParser (Text, Text)
-> ((Text, Text) -> ConduitT Event Void m [(Int, Release)])
-> ConduitT Event Void m (Maybe [(Int, Release)])
forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag' NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}release-list" ((Text -> Text -> (Text, Text))
-> AttrParser Text -> AttrParser Text -> AttrParser (Text, Text)
forall a b c.
(a -> b -> c) -> AttrParser a -> AttrParser b -> AttrParser c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Name -> AttrParser Text
requireAttr Name
"count") (Name -> AttrParser Text
requireAttr Name
"offset")) (((Text, Text) -> ConduitT Event Void m [(Int, Release)])
 -> ConduitT Event Void m (Maybe [(Int, Release)]))
-> ((Text, Text) -> ConduitT Event Void m [(Int, Release)])
-> ConduitT Event Void m (Maybe [(Int, Release)])
forall a b. (a -> b) -> a -> b
$ \(Text, Text)
_ -> ConduitT Event Void m (Maybe (Int, Release))
-> ConduitT Event Void m [(Int, Release)]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ConduitT Event Void m (Maybe (Int, Release))
forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m (Maybe (Int, Release))
parseRelease))

parseRecording :: MonadThrow m => ConduitM Event Void m (Maybe Recording)
parseRecording :: forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m (Maybe Recording)
parseRecording = NameMatcher Name
-> AttrParser Text
-> (Text -> ConduitT Event Void m Recording)
-> ConduitT Event Void m (Maybe Recording)
forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag' NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}recording" (Name -> AttrParser Text
requireAttr Name
"id") ((Text -> ConduitT Event Void m Recording)
 -> ConduitT Event Void m (Maybe Recording))
-> (Text -> ConduitT Event Void m Recording)
-> ConduitT Event Void m (Maybe Recording)
forall a b. (a -> b) -> a -> b
$ \Text
rid -> do
    title <- NameMatcher Name
-> ConduitT Event Void m Text -> ConduitT Event Void m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}title" ConduitT Event Void m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content
    len <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}length" content
    ncs <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}artist-credit" $ many parseArtistCredit
    return Recording { _recordingId = MBID rid, _recordingTitle = title, _recordingLength = fmap forceReadDec len, _recordingArtistCredit = fromMaybe [] ncs }

parseArtistCredit :: MonadThrow m => ConduitM Event Void m (Maybe ArtistCredit)
parseArtistCredit :: forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m (Maybe ArtistCredit)
parseArtistCredit = NameMatcher Name
-> AttrParser (Maybe Text)
-> (Maybe Text -> ConduitT Event Void m ArtistCredit)
-> ConduitT Event Void m (Maybe ArtistCredit)
forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag' NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}name-credit" (AttrParser (Maybe Text)
buggyJoinPhrase) ((Maybe Text -> ConduitT Event Void m ArtistCredit)
 -> ConduitT Event Void m (Maybe ArtistCredit))
-> (Maybe Text -> ConduitT Event Void m ArtistCredit)
-> ConduitT Event Void m (Maybe ArtistCredit)
forall a b. (a -> b) -> a -> b
$ \Maybe Text
mjp -> [Char]
-> ConduitT Event Void m (Maybe ArtistCredit)
-> ConduitT Event Void m ArtistCredit
forall (m :: * -> *) a.
MonadThrow m =>
[Char] -> m (Maybe a) -> m a
force [Char]
"artist required" (NameMatcher Name
-> AttrParser Text
-> (Text -> ConduitT Event Void m ArtistCredit)
-> ConduitT Event Void m (Maybe ArtistCredit)
forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag' NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}artist" (Name -> AttrParser Text
requireAttr Name
"id") ((Text -> ConduitT Event Void m ArtistCredit)
 -> ConduitT Event Void m (Maybe ArtistCredit))
-> (Text -> ConduitT Event Void m ArtistCredit)
-> ConduitT Event Void m (Maybe ArtistCredit)
forall a b. (a -> b) -> a -> b
$ \Text
aid -> do
    name <- NameMatcher Name
-> ConduitT Event Void m Text -> ConduitT Event Void m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}name" ConduitT Event Void m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content
    sortName <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}sort-name" content
    _ <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}disambiguation" content
    let a = Artist { _artistId :: MBID
_artistId = Text -> MBID
MBID Text
aid, _artistName :: Maybe Text
_artistName = Maybe Text
name, _artistSortName :: Maybe Text
_artistSortName = Maybe Text
sortName, _artistDisambiguation :: Maybe Text
_artistDisambiguation = Maybe Text
forall a. Maybe a
Nothing }
    return ArtistCredit { _artistCreditArtist = a, _artistCreditJoinPhrase = mjp, _artistCreditName = name }
    )

-- what's up with this
buggyJoinPhrase :: AttrParser (Maybe Text)
buggyJoinPhrase :: AttrParser (Maybe Text)
buggyJoinPhrase = (Text -> Maybe Text) -> AttrParser Text -> AttrParser (Maybe Text)
forall a b. (a -> b) -> AttrParser a -> AttrParser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe Text
forall a. a -> Maybe a
Just (Name -> AttrParser Text
requireAttr Name
"{http://musicbrainz.org/ns/mmd-2.0#}joinphrase")
    AttrParser (Maybe Text)
-> AttrParser (Maybe Text) -> AttrParser (Maybe Text)
forall a. AttrParser a -> AttrParser a -> AttrParser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Name -> AttrParser (Maybe Text)
attr Name
"{http://musicbrainz.org/ns/mmd-2.0#}joinphrase" { nameNamespace = Nothing }

forceReadDec :: Integral a => Text -> a
forceReadDec :: forall a. Integral a => Text -> a
forceReadDec = (\(Right (a
d, Text
_)) -> a
d) (Either [Char] (a, Text) -> a)
-> (Text -> Either [Char] (a, Text)) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] (a, Text)
forall a. Integral a => Reader a
TR.decimal

parseRelease :: MonadThrow m => ConduitM Event Void m (Maybe (Int, Release))
parseRelease :: forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m (Maybe (Int, Release))
parseRelease = NameMatcher Name
-> AttrParser (Text, Maybe Text)
-> ((Text, Maybe Text) -> ConduitT Event Void m (Int, Release))
-> ConduitT Event Void m (Maybe (Int, Release))
forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag' NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}release" ((Text -> Maybe Text -> (Text, Maybe Text))
-> AttrParser Text
-> AttrParser (Maybe Text)
-> AttrParser (Text, Maybe Text)
forall a b c.
(a -> b -> c) -> AttrParser a -> AttrParser b -> AttrParser c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Name -> AttrParser Text
requireAttr Name
"id") (Name -> AttrParser (Maybe Text)
attr Name
"{http://musicbrainz.org/ns/ext#-2.0}score")) (((Text, Maybe Text) -> ConduitT Event Void m (Int, Release))
 -> ConduitT Event Void m (Maybe (Int, Release)))
-> ((Text, Maybe Text) -> ConduitT Event Void m (Int, Release))
-> ConduitT Event Void m (Maybe (Int, Release))
forall a b. (a -> b) -> a -> b
$ \(Text
rid,Maybe Text
score) -> do
    title <- [Char]
-> ConduitT Event Void m (Maybe Text) -> ConduitT Event Void m Text
forall (m :: * -> *) a.
MonadThrow m =>
[Char] -> m (Maybe a) -> m a
force [Char]
"title required" (NameMatcher Name
-> ConduitT Event Void m Text -> ConduitT Event Void m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}title" ConduitT Event Void m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content)
    status <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}status" content
    quality <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}quality" content
    packaging <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}packaging" content
    tr <- parseTextRepresentation
    ncs <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}artist-credit" $ many parseArtistCredit
    _ <- parseReleaseGroup
    date <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}date" content
    country <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}country" content
    rel <- tag' "{http://musicbrainz.org/ns/mmd-2.0#}release-event-list" (requireAttr "count") $ \Text
_ -> ConduitT Event Void m (Maybe ReleaseEvent)
-> ConduitT Event Void m [ReleaseEvent]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ConduitT Event Void m (Maybe ReleaseEvent)
forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m (Maybe ReleaseEvent)
parseReleaseEvent
    barcode <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}barcode" content
    amazonASIN <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}asin" content
    coverArtArchive <- parseCoverArtArchive
    _ <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}label-info-list" $ parseLabelInfo
    media <- tag' "{http://musicbrainz.org/ns/mmd-2.0#}medium-list" (requireAttr "count") $ \Text
_ -> (NameMatcher Name
-> ConduitT Event Void m Text -> ConduitT Event Void m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}track-count" ConduitT Event Void m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content ConduitT Event Void m (Maybe Text)
-> ConduitT Event Void m [Medium] -> ConduitT Event Void m [Medium]
forall a b.
ConduitT Event Void m a
-> ConduitT Event Void m b -> ConduitT Event Void m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT Event Void m (Maybe Medium)
-> ConduitT Event Void m [Medium]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ConduitT Event Void m (Maybe Medium)
forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m (Maybe Medium)
parseMedium)
    return (maybe 0 forceReadDec score, Release {
        _releaseId = MBID rid
      , _releaseTitle = title
      , _releaseStatus = status
      , _releaseQuality = quality
      , _releasePackaging = packaging
      , _releaseTextRepresentation = tr
      , _releaseArtistCredit = fromMaybe [] ncs
      , _releaseDate = parseTimeM True defaultTimeLocale "%Y-%m-%d" . T.unpack =<< date
      , _releaseCountry = country
      , _releaseEvents = fromMaybe [] rel
      , _releaseBarcode = barcode
      , _releaseASIN = amazonASIN
      , _releaseCoverArtArchive = coverArtArchive
      , _releaseMedia = V.fromList (fromMaybe [] media)
    })

parseTextRepresentation :: MonadThrow m => ConduitM Event Void m (Maybe TextRepresentation)
parseTextRepresentation :: forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m (Maybe TextRepresentation)
parseTextRepresentation = NameMatcher Name
-> ConduitT Event Void m TextRepresentation
-> ConduitT Event Void m (Maybe TextRepresentation)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}text-representation" (ConduitT Event Void m TextRepresentation
 -> ConduitT Event Void m (Maybe TextRepresentation))
-> ConduitT Event Void m TextRepresentation
-> ConduitT Event Void m (Maybe TextRepresentation)
forall a b. (a -> b) -> a -> b
$ do
    lang <- NameMatcher Name
-> ConduitT Event Void m Text -> ConduitT Event Void m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}language" ConduitT Event Void m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content
    script <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}script" content
    return TextRepresentation {
      _textRepLanguage = lang
    , _textRepScript = script
    }

parseMedium :: MonadThrow m => ConduitM Event Void m (Maybe Medium)
parseMedium :: forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m (Maybe Medium)
parseMedium = NameMatcher Name
-> ConduitT Event Void m Medium
-> ConduitT Event Void m (Maybe Medium)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}medium" (ConduitT Event Void m Medium
 -> ConduitT Event Void m (Maybe Medium))
-> ConduitT Event Void m Medium
-> ConduitT Event Void m (Maybe Medium)
forall a b. (a -> b) -> a -> b
$ do
    title <- NameMatcher Name
-> ConduitT Event Void m Text -> ConduitT Event Void m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}title" ConduitT Event Void m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content
    position <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}position" content
    format <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}format" content
    mmed <- tag' "{http://musicbrainz.org/ns/mmd-2.0#}track-list" (liftA2 (,) (requireAttr "count") (attr "offset")) $ \(Text
c,Maybe Text
o) -> do -- not Just
        tracks <- ConduitT Event Void m (Maybe Track)
-> ConduitT Event Void m [Track]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ConduitT Event Void m (Maybe Track)
forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m (Maybe Track)
parseTrack
        return Medium {
            _mediumTitle = title
          , _mediumPosition = fmap forceReadDec position
          , _mediumFormat = format
          , _mediumTrackCount = forceReadDec c
          , _mediumTrackOffset = fmap forceReadDec o
          , _mediumTrackList = Just tracks -- not Just
          }
    case mmed of
        Just Medium
med -> Medium -> ConduitT Event Void m Medium
forall a. a -> ConduitT Event Void m a
forall (m :: * -> *) a. Monad m => a -> m a
return Medium
med
        Maybe Medium
Nothing -> [Char] -> ConduitT Event Void m Medium
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing track list"

parseTrack :: MonadThrow m => ConduitM Event Void m (Maybe Track)
parseTrack :: forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m (Maybe Track)
parseTrack = NameMatcher Name
-> AttrParser Text
-> (Text -> ConduitT Event Void m Track)
-> ConduitT Event Void m (Maybe Track)
forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag' NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}track" (Name -> AttrParser Text
requireAttr Name
"id") ((Text -> ConduitT Event Void m Track)
 -> ConduitT Event Void m (Maybe Track))
-> (Text -> ConduitT Event Void m Track)
-> ConduitT Event Void m (Maybe Track)
forall a b. (a -> b) -> a -> b
$ \Text
i -> do
    position <- NameMatcher Name
-> ConduitT Event Void m Text -> ConduitT Event Void m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}position" ConduitT Event Void m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content
    number <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}number" content
    len <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}length" content
    artistcredit <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}artist-credit" $ many parseArtistCredit
    recording <- force "recording required" parseRecording
    return Track {
      _trackId = MBID i
    , _trackArtistCredit = fromMaybe [] artistcredit
    , _trackPosition = fmap forceReadDec position
    , _trackNumber = number
    , _trackLength = fmap forceReadDec len
    , _trackRecording = recording
    }

parseReleaseGroup :: MonadThrow m => ConduitM Event Void m (Maybe ReleaseGroup)
parseReleaseGroup :: forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m (Maybe ReleaseGroup)
parseReleaseGroup = NameMatcher Name
-> AttrParser (Text, Text)
-> ((Text, Text) -> ConduitT Event Void m ReleaseGroup)
-> ConduitT Event Void m (Maybe ReleaseGroup)
forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag' NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}release-group" ((Text -> Text -> (Text, Text))
-> AttrParser Text -> AttrParser Text -> AttrParser (Text, Text)
forall a b c.
(a -> b -> c) -> AttrParser a -> AttrParser b -> AttrParser c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Name -> AttrParser Text
requireAttr Name
"type") (Name -> AttrParser Text
requireAttr Name
"id")) (((Text, Text) -> ConduitT Event Void m ReleaseGroup)
 -> ConduitT Event Void m (Maybe ReleaseGroup))
-> ((Text, Text) -> ConduitT Event Void m ReleaseGroup)
-> ConduitT Event Void m (Maybe ReleaseGroup)
forall a b. (a -> b) -> a -> b
$ \(Text
t,Text
i) -> do
    title <- NameMatcher Name
-> ConduitT Event Void m Text -> ConduitT Event Void m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}title" ConduitT Event Void m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content
    frd <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}first-release-date" content
    pt <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}primary-type" content
    ncs <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}artist-credit" $ many parseArtistCredit
    return ReleaseGroup {
      _releaseGroupId = MBID i
    , _releaseGroupType = t
    , _releaseGroupTitle = title
    , _releaseGroupFirstReleaseDate = frd
    , _releaseGroupPrimaryType = pt
    , _releaseGroupArtistCredit = fromMaybe [] ncs
    }

parseLabelInfo :: MonadThrow m => ConduitM Event Void m (Maybe LabelInfo)
parseLabelInfo :: forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m (Maybe LabelInfo)
parseLabelInfo = NameMatcher Name
-> ConduitT Event Void m LabelInfo
-> ConduitT Event Void m (Maybe LabelInfo)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}label-info" (ConduitT Event Void m LabelInfo
 -> ConduitT Event Void m (Maybe LabelInfo))
-> ConduitT Event Void m LabelInfo
-> ConduitT Event Void m (Maybe LabelInfo)
forall a b. (a -> b) -> a -> b
$ do
    catno <- NameMatcher Name
-> ConduitT Event Void m Text -> ConduitT Event Void m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}catalog-number" ConduitT Event Void m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content
    label <- force "label required" parseLabel
    return LabelInfo {
      _labelInfoCatalogNumber = catno
    , _labelInfoLabel = label
    }

parseLabel :: MonadThrow m => ConduitM Event Void m (Maybe Label)
parseLabel :: forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m (Maybe Label)
parseLabel = NameMatcher Name
-> AttrParser Text
-> (Text -> ConduitT Event Void m Label)
-> ConduitT Event Void m (Maybe Label)
forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag' NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}label" (Name -> AttrParser Text
requireAttr Name
"id") ((Text -> ConduitT Event Void m Label)
 -> ConduitT Event Void m (Maybe Label))
-> (Text -> ConduitT Event Void m Label)
-> ConduitT Event Void m (Maybe Label)
forall a b. (a -> b) -> a -> b
$ \Text
i -> do
    name <- NameMatcher Name
-> ConduitT Event Void m Text -> ConduitT Event Void m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}name" ConduitT Event Void m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content
    sortname <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}sort-name" content
    labelcode <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}label-code" content
    return Label {
      _labelId = MBID i
    , _labelName = name
    , _labelSortName = sortname
    , _labelLabelCode = labelcode
    }

parseReleaseEvent :: MonadThrow m => ConduitM Event Void m (Maybe ReleaseEvent)
parseReleaseEvent :: forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m (Maybe ReleaseEvent)
parseReleaseEvent = NameMatcher Name
-> ConduitT Event Void m ReleaseEvent
-> ConduitT Event Void m (Maybe ReleaseEvent)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}release-event" (ConduitT Event Void m ReleaseEvent
 -> ConduitT Event Void m (Maybe ReleaseEvent))
-> ConduitT Event Void m ReleaseEvent
-> ConduitT Event Void m (Maybe ReleaseEvent)
forall a b. (a -> b) -> a -> b
$ do
    date <- NameMatcher Name
-> ConduitT Event Void m Text -> ConduitT Event Void m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}date" ConduitT Event Void m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content
    area <- parseArea
    return ReleaseEvent {
      _releaseEventDate = parseTimeM True defaultTimeLocale "%Y-%m-%d" . T.unpack =<< date
    , _releaseEventArea = area
    }

parseArea :: MonadThrow m => ConduitM Event Void m (Maybe Area)
parseArea :: forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m (Maybe Area)
parseArea = NameMatcher Name
-> AttrParser Text
-> (Text -> ConduitT Event Void m Area)
-> ConduitT Event Void m (Maybe Area)
forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag' NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}area" (Name -> AttrParser Text
requireAttr Name
"id") ((Text -> ConduitT Event Void m Area)
 -> ConduitT Event Void m (Maybe Area))
-> (Text -> ConduitT Event Void m Area)
-> ConduitT Event Void m (Maybe Area)
forall a b. (a -> b) -> a -> b
$ \Text
i -> do
    name <- NameMatcher Name
-> ConduitT Event Void m Text -> ConduitT Event Void m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}name" ConduitT Event Void m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content
    sortname <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}sort-name" content
    isocodes1 <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}iso-3166-1-code-list" $ many parseISO3166Code
    isocodes2 <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}iso-3166-2-code-list" $ many parseISO3166Code
    isocodes3 <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}iso-3166-3-code-list" $ many parseISO3166Code
    return Area {
      _areaId = MBID i
    , _areaName = name
    , _areaSortName = sortname
    , _areaISO3166_1Codes = fromMaybe [] isocodes1
    , _areaISO3166_2Codes = fromMaybe [] isocodes2
    , _areaISO3166_3Codes = fromMaybe [] isocodes3
    }

parseISO3166Code :: MonadThrow m => ConduitM Event Void m (Maybe ISO3166Code)
parseISO3166Code :: forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m (Maybe ISO3166Code)
parseISO3166Code = NameMatcher Name
-> ConduitT Event Void m ISO3166Code
-> ConduitT Event Void m (Maybe ISO3166Code)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}iso-3166-1-code" (ConduitT Event Void m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content ConduitT Event Void m Text
-> (Text -> ConduitT Event Void m ISO3166Code)
-> ConduitT Event Void m ISO3166Code
forall a b.
ConduitT Event Void m a
-> (a -> ConduitT Event Void m b) -> ConduitT Event Void m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ISO3166Code -> ConduitT Event Void m ISO3166Code
forall a. a -> ConduitT Event Void m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ISO3166Code -> ConduitT Event Void m ISO3166Code)
-> (Text -> ISO3166Code)
-> Text
-> ConduitT Event Void m ISO3166Code
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ISO3166Code
ISO3166Code))

parseCoverArtArchive :: MonadThrow m => ConduitM Event Void m (Maybe CoverArtArchive)
parseCoverArtArchive :: forall (m :: * -> *).
MonadThrow m =>
ConduitM Event Void m (Maybe CoverArtArchive)
parseCoverArtArchive = NameMatcher Name
-> ConduitT Event Void m CoverArtArchive
-> ConduitT Event Void m (Maybe CoverArtArchive)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}cover-art-archive" (ConduitT Event Void m CoverArtArchive
 -> ConduitT Event Void m (Maybe CoverArtArchive))
-> ConduitT Event Void m CoverArtArchive
-> ConduitT Event Void m (Maybe CoverArtArchive)
forall a b. (a -> b) -> a -> b
$ do
    artwork <- NameMatcher Name
-> ConduitT Event Void m Text -> ConduitT Event Void m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagNoAttr NameMatcher Name
"{http://musicbrainz.org/ns/mmd-2.0#}artwork" ConduitT Event Void m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content
    count <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}count" content
    front <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}front" content
    back <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}back" content
    return CoverArtArchive {
      _coverArtArchiveArtwork = if artwork == Just "true" then Just True else Just False
    , _coverArtArchiveCount = fmap forceReadDec count
    , _coverArtArchiveFront = if front == Just "true" then Just True else Just False
    , _coverArtArchiveBack = if back == Just "true" then Just True else Just False
    }

searchReleasesByArtistAndRelease :: (MonadIO m, MonadBaseControl IO m, MonadThrow m, MonadUnliftIO m) => Text -> Text -> Maybe Int -> Maybe Int -> m [(Int, Release)]
searchReleasesByArtistAndRelease :: forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadThrow m,
 MonadUnliftIO m) =>
Text -> Text -> Maybe Int -> Maybe Int -> m [(Int, Release)]
searchReleasesByArtistAndRelease Text
artist Text
release Maybe Int
mlimit Maybe Int
moffset = do
    lbs <- Text -> Text -> Maybe Int -> Maybe Int -> m ByteString
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> Maybe Int -> Maybe Int -> m ByteString
musicBrainzWSSearch Text
"release" ([Text] -> Text
T.concat [Text
"artist:\"", Text
artist, Text
"\" AND release:\"", Text
release, Text
"\""]) Maybe Int
mlimit Maybe Int
moffset
    rs <- runConduitRes $ sourceLbs lbs .| parseBytes def .| sinkReleaseList
    return rs