MusicBrainz 0.1.1 → 0.2
raw patch · 7 files changed
+402/−169 lines, 7 filesdep +aesondep ~conduitdep ~http-conduitdep ~http-types
Dependencies added: aeson
Dependency ranges changed: conduit, http-conduit, http-types, xml-conduit
Files
- MusicBrainz.cabal +11/−9
- Network/Protocol/MusicBrainz/JSON/WebService.hs +54/−0
- Network/Protocol/MusicBrainz/Types.hs +233/−0
- Network/Protocol/MusicBrainz/Utils.hs +22/−0
- Network/Protocol/MusicBrainz/XML2/Types.hs +0/−100
- Network/Protocol/MusicBrainz/XML2/Utils.hs +0/−22
- Network/Protocol/MusicBrainz/XML2/WebService.hs +82/−38
MusicBrainz.cabal view
@@ -1,5 +1,5 @@ name: MusicBrainz-version: 0.1.1+version: 0.2 synopsis: interface to MusicBrainz XML2 web service description: interface to MusicBrainz XML2 web service homepage: http://floss.scru.org/hMusicBrainz@@ -14,23 +14,25 @@ extra-source-files: AUTHORS library- exposed-modules: Network.Protocol.MusicBrainz.XML2.WebService- , Network.Protocol.MusicBrainz.XML2.Types- , Network.Protocol.MusicBrainz.XML2.Utils+ exposed-modules: Network.Protocol.MusicBrainz.Types+ , Network.Protocol.MusicBrainz.Utils+ , Network.Protocol.MusicBrainz.JSON.WebService+ , Network.Protocol.MusicBrainz.XML2.WebService build-depends: base >= 4.5 && <5 , transformers >= 0.3 , monad-control ==0.3.* , bytestring- , conduit >= 0.4 && <0.6+ , conduit >= 1.0.0 , text ==0.11.* , time , vector >=0.9 , xml-types ==0.3.*- , http-conduit >= 1.4 && <1.9- , http-types >= 0.6 && <0.8+ , http-conduit >= 1.8.8+ , http-types >= 0.6 , old-locale ==1.0.*- , xml-conduit >= 0.7 && <1.1+ , xml-conduit >= 1.1 , HTTP >= 4000.0+ , aeson >= 0.6.1 ghc-options: -Wall source-repository head@@ -41,4 +43,4 @@ source-repository this type: git location: git://anonscm.debian.org/users/clint/MusicBrainz.git- tag: hMB/0.1.1+ tag: hMB/0.2
+ Network/Protocol/MusicBrainz/JSON/WebService.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}++module Network.Protocol.MusicBrainz.JSON.WebService (+ getRecordingById+ , getReleaseById+ , searchReleasesByArtistAndRelease+) where++import Network.Protocol.MusicBrainz.Types++import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Trans.Control (MonadBaseControl)+import Data.Aeson (eitherDecode)+import qualified Data.ByteString.Lazy as BL+import Data.List (intercalate)+import Data.Text (Text)+import qualified Data.Text as T+import Network.HTTP.Base (urlEncode)+import Network.HTTP.Conduit (simpleHttp)++musicBrainzWSLookup :: MonadIO m => Text -> Text -> [Text] -> m BL.ByteString+musicBrainzWSLookup reqtype param incparams = do+ let url = "https://musicbrainz.org/ws/2/" ++ T.unpack reqtype ++ "/" ++ T.unpack param ++ incs incparams ++ fj+ simpleHttp url+ where+ incs [] = ""+ incs xs = ("?inc="++) . intercalate "+" . map T.unpack $ xs+ fj = "&fmt=json"++musicBrainzWSSearch :: MonadIO m => Text -> Text -> Maybe Int -> Maybe Int -> m BL.ByteString+musicBrainzWSSearch reqtype query mlimit moffset = do+ let url = "https://musicbrainz.org/ws/2/" ++ T.unpack reqtype ++ "/?query=" ++ urlEncode (T.unpack query) ++ limit mlimit ++ offset moffset ++ fj+ simpleHttp url+ where+ limit Nothing = ""+ limit (Just l) = "&limit=" ++ show l+ offset Nothing = ""+ offset (Just o) = "&offset=" ++ show o+ fj = "&fmt=json"++getRecordingById :: (MonadBaseControl IO m, MonadIO m) => MBID -> m (Either String Recording)+getRecordingById mbid = do+ lbs <- musicBrainzWSLookup "recording" (unMBID mbid) ["artist-credits"]+ return $ eitherDecode lbs++getReleaseById :: (MonadBaseControl IO m, MonadIO m) => MBID -> m (Either String Release)+getReleaseById mbid = do+ lbs <- musicBrainzWSLookup "release" (unMBID mbid) ["recordings", "artist-credits"]+ return $ eitherDecode lbs++searchReleasesByArtistAndRelease :: (MonadIO m, MonadBaseControl IO m) => Text -> Text -> Maybe Int -> Maybe Int -> m (Either String [(Int, Release)])+searchReleasesByArtistAndRelease artist release mlimit moffset = do+ lbs <- musicBrainzWSSearch "release" (T.concat ["artist:\"", artist, "\" AND release:\"", release, "\""]) mlimit moffset+ return $ eitherDecode lbs
+ Network/Protocol/MusicBrainz/Types.hs view
@@ -0,0 +1,233 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Protocol.MusicBrainz.Types (+ MBID(..)+ , Release(..)+ , TextRepresentation(..)+ , Medium(..)+ , Track(..)+ , Recording(..)+ , ArtistCredit(..)+ , Artist(..)+ , ReleaseGroup(..)+ , LabelInfo(..)+ , Label(..)+ , ReleaseEvent(..)+ , Area(..)+ , ISO3166Code(..)+ , CoverArtArchive(..)+) where++import Data.Text (Text)+import Data.Time.Calendar (Day)+import Data.Vector (Vector)++import Control.Applicative ((<$>), (<*>))+import Control.Monad (mzero)+import Data.Aeson (FromJSON(..), (.:), (.:?), Value(..))+import Data.Maybe (fromMaybe)+import qualified Data.Text as T+import Data.Time.Format (parseTime)+import System.Locale (defaultTimeLocale)++newtype MBID = MBID { unMBID :: Text }+ deriving (Eq, Show)++data Release = Release {+ _releaseId :: MBID+ , _releaseTitle :: Text+ , _releaseStatus :: Maybe Text+ , _releaseQuality :: Maybe Text+ , _releasePackaging :: Maybe Text+ , _releaseTextRepresentation :: Maybe TextRepresentation+ , _releaseArtistCredit :: [ArtistCredit]+ , _releaseDate :: Maybe Day+ , _releaseCountry :: Maybe Text+ , _releaseEvents :: [ReleaseEvent]+ , _releaseBarcode :: Maybe Text+ , _releaseASIN :: Maybe Text+ , _releaseCoverArtArchive :: Maybe CoverArtArchive+ , _releaseMedia :: Vector Medium+} deriving (Eq, Show)++instance FromJSON Release where+ parseJSON (Object v) = Release <$>+ (MBID <$> v .: "id") <*>+ v .: "title" <*>+ v .:? "status" <*>+ v .:? "quality" <*>+ v .:? "packaging" <*>+ v .:? "text-representation" <*>+ v .: "artist-credit" <*>+ ((parseTime defaultTimeLocale "%Y-%m-%d" . T.unpack =<<) <$> v .:? "date") <*>+ v .:? "country" <*>+ v .: "release-events" <*>+ v .:? "barcode" <*>+ v .:? "asin" <*>+ v .:? "cover-art-archive" <*>+ v .: "media"+ parseJSON _ = mzero++data TextRepresentation = TextRepresentation {+ _textRepLanguage :: Maybe Text+ , _textRepScript :: Maybe Text+} deriving (Eq, Show)++instance FromJSON TextRepresentation where+ parseJSON (Object v) = TextRepresentation <$>+ v .:? "language" <*>+ v .:? "script"+ parseJSON _ = mzero++data Medium = Medium {+ _mediumTitle :: Maybe Text+ , _mediumPosition :: Maybe Integer+ , _mediumFormat :: Maybe Text+ , _mediumTrackCount :: Integer+ , _mediumTrackOffset :: Maybe Integer+ , _mediumTrackList :: Maybe [Track]+} deriving (Eq, Show)++instance FromJSON Medium where+ parseJSON (Object v) = Medium <$>+ v .:? "title" <*>+ v .:? "position" <*>+ v .:? "format" <*>+ v .: "track-count" <*>+ v .:? "track-offset" <*>+ v .:? "tracks"+ parseJSON _ = mzero++data Track = Track {+ _trackId :: MBID+ , _trackArtistCredit :: [ArtistCredit]+ , _trackPosition :: Maybe Integer+ , _trackNumber :: Maybe Text+ , _trackLength :: Maybe Integer+ , _trackRecording :: Recording+} deriving (Eq, Show)++instance FromJSON Track where+ parseJSON (Object v) = Track <$>+ (MBID <$> v .: "id") <*>+ v .: "artist-credit" <*>+ v .:? "position" <*>+ v .:? "number" <*>+ v .:? "length" <*>+ v .: "recording"+ parseJSON _ = mzero++data Recording = Recording {+ _recordingId :: MBID+ , _recordingTitle :: Maybe Text+ , _recordingLength :: Maybe Integer+ , _recordingArtistCredit :: [ArtistCredit]+} deriving (Eq, Show)++instance FromJSON Recording where+ parseJSON (Object v) = Recording <$>+ (MBID <$> v .: "id") <*>+ v .:? "title" <*>+ v .:? "length" <*>+ v .: "artist-credit"+ parseJSON _ = mzero++data ArtistCredit = ArtistCredit {+ _artistCreditArtist :: Artist+ , _artistCreditJoinPhrase :: Maybe Text+ , _artistCreditName :: Maybe Text+} deriving (Eq, Show)++instance FromJSON ArtistCredit where+ parseJSON (Object v) = ArtistCredit <$>+ v .: "artist" <*>+ v .:? "joinphrase" <*>+ v .:? "name"+ parseJSON _ = mzero++data Artist = Artist {+ _artistId :: MBID+ , _artistName :: Maybe Text+ , _artistSortName :: Maybe Text+ , _artistDisambiguation :: Maybe Text+} deriving (Eq, Show)++instance FromJSON Artist where+ parseJSON (Object v) = Artist <$>+ (MBID <$> v .: "id") <*>+ v .:? "name" <*>+ v .:? "sort-name" <*>+ v .:? "disambiguation"+ parseJSON _ = mzero++data ReleaseGroup = ReleaseGroup {+ _releaseGroupId :: MBID+ , _releaseGroupType :: Text+ , _releaseGroupTitle :: Maybe Text+ , _releaseGroupFirstReleaseDate :: Maybe Text+ , _releaseGroupPrimaryType :: Maybe Text+ , _releaseGroupArtistCredit :: [ArtistCredit]+} deriving (Eq, Show)++data LabelInfo = LabelInfo {+ _labelInfoCatalogNumber :: Maybe Text+ , _labelInfoLabel :: Label+} deriving (Eq, Show)++data Label = Label {+ _labelId :: MBID+ , _labelName :: Maybe Text+ , _labelSortName :: Maybe Text+ , _labelLabelCode :: Maybe Text+} deriving (Eq, Show)++data ReleaseEvent = ReleaseEvent {+ _releaseEventDate :: Maybe Day+ , _releaseEventArea :: Maybe Area+} deriving (Eq, Show)++instance FromJSON ReleaseEvent where+ parseJSON (Object v) = ReleaseEvent <$>+ ((parseTime defaultTimeLocale "%Y-%m-%d" . T.unpack =<<) <$> v .:? "date") <*>+ v .:? "area"+ parseJSON _ = mzero++data Area = Area {+ _areaId :: MBID+ , _areaName :: Maybe Text+ , _areaSortName :: Maybe Text+ , _areaISO3166_1Codes :: [ISO3166Code]+ , _areaISO3166_2Codes :: [ISO3166Code]+ , _areaISO3166_3Codes :: [ISO3166Code]+} deriving (Eq, Show)++instance FromJSON Area where+ parseJSON (Object v) = Area <$>+ (MBID <$> v .: "id") <*>+ v .:? "name" <*>+ v .:? "sort-name" <*>+ (fromMaybe [] <$> v .:? "iso_3166_1_codes") <*>+ (fromMaybe [] <$> v .:? "iso_3166_2_codes") <*>+ (fromMaybe [] <$> v .:? "iso_3166_3_codes")+ parseJSON _ = mzero++data CoverArtArchive = CoverArtArchive {+ _coverArtArchiveArtwork :: Maybe Bool+ , _coverArtArchiveCount :: Maybe Integer+ , _coverArtArchiveFront :: Maybe Bool+ , _coverArtArchiveBack :: Maybe Bool+} deriving (Eq, Show)++instance FromJSON CoverArtArchive where+ parseJSON (Object v) = CoverArtArchive <$>+ v .:? "artwork" <*>+ v .:? "count" <*>+ v .:? "front" <*>+ v .:? "back"+ parseJSON _ = mzero++newtype ISO3166Code = ISO3166Code { unISO3166Code :: Text }+ deriving (Eq, Show)++instance FromJSON ISO3166Code where+ parseJSON t = ISO3166Code <$> parseJSON t
+ Network/Protocol/MusicBrainz/Utils.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Protocol.MusicBrainz.Utils (+ nameCreditsToArtistName+ , nameCreditsToArtistSortName+) where++import Control.Applicative ((<|>), liftA2)+import Data.Maybe (catMaybes)+import Data.Text (Text)+import qualified Data.Text as T++import Network.Protocol.MusicBrainz.Types++nameCreditsToArtistName :: [ArtistCredit] -> Text+nameCreditsToArtistName = T.concat . map (nameSpan (_artistName . _artistCreditArtist))++nameCreditsToArtistSortName :: [ArtistCredit] -> Text+nameCreditsToArtistSortName = T.concat . map (nameSpan (liftA2 (<|>) _artistSortName _artistName . _artistCreditArtist))++nameSpan :: (ArtistCredit -> Maybe Text) -> ArtistCredit -> Text+nameSpan f = T.concat . catMaybes . liftA2 (:) f (return . _artistCreditJoinPhrase)
− Network/Protocol/MusicBrainz/XML2/Types.hs
@@ -1,100 +0,0 @@-module Network.Protocol.MusicBrainz.XML2.Types (- MBID(..)- , Release(..)- , TextRepresentation(..)- , Medium(..)- , DiscList(..)- , TrackList(..)- , Track(..)- , Recording(..)- , NameCredit(..)- , ReleaseGroup(..)- , LabelInfo(..)- , Label(..)-) where--import Data.Text (Text)-import Data.Time.Calendar (Day)-import Data.Vector (Vector)--newtype MBID = MBID { unMBID :: Text }- deriving (Eq, Show)--data Release = Release {- _releaseId :: MBID- , _releaseTitle :: Text- , _releaseStatus :: Maybe Text- , _releaseQuality :: Maybe Text- , _releasePackaging :: Maybe Text- , _releaseTextRepresentation :: Maybe TextRepresentation- , _releaseArtistCredit :: [NameCredit]- , _releaseDate :: Maybe Day- , _releaseCountry :: Maybe Text- , _releaseBarcode :: Maybe Text- , _releaseASIN :: Maybe Text- , _releaseMedia :: Vector Medium-} deriving (Eq, Show)--data TextRepresentation = TextRepresentation {- _textRepLanguage :: Maybe Text- , _textRepScript :: Maybe Text-} deriving (Eq, Show)--data Medium = Medium {- _mediumTitle :: Maybe Text- , _mediumPosition :: Maybe Integer- , _mediumFormat :: Maybe Text- , _mediumDiscList :: Maybe DiscList- , _mediumTrackList :: Maybe TrackList-} deriving (Eq, Show)--data DiscList = DiscList {- _discListCount :: Integer-} deriving (Eq, Show)--data TrackList = TrackList {- _trackListOffset :: Maybe Integer- , _trackListTracks :: Vector Track-} deriving (Eq, Show)--data Track = Track {- _trackPosition :: Maybe Integer- , _trackNumber :: Maybe Integer- , _trackLength :: Maybe Integer- , _trackRecording :: Recording-} deriving (Eq, Show)--data Recording = Recording {- _recordingId :: MBID- , _recordingTitle :: Maybe Text- , _recordingLength :: Maybe Integer- , _recordingArtistCredit :: [NameCredit]-} deriving (Eq, Show)--data NameCredit = NameCredit {- _nameCreditArtistId :: MBID- , _nameCreditJoinPhrase :: Maybe Text- , _nameCreditArtistName :: Maybe Text- , _nameCreditArtistSortName :: Maybe Text-} deriving (Eq, Show)--data ReleaseGroup = ReleaseGroup {- _releaseGroupId :: MBID- , _releaseGroupType :: Text- , _releaseGroupTitle :: Maybe Text- , _releaseGroupFirstReleaseDate :: Maybe Text- , _releaseGroupPrimaryType :: Maybe Text- , _releaseGroupArtistCredit :: [NameCredit]-} deriving (Eq, Show)--data LabelInfo = LabelInfo {- _labelInfoCatalogNumber :: Maybe Text- , _labelInfoLabel :: Label-} deriving (Eq, Show)--data Label = Label {- _labelId :: MBID- , _labelName :: Maybe Text- , _labelSortName :: Maybe Text- , _labelLabelCode :: Maybe Text-} deriving (Eq, Show)
− Network/Protocol/MusicBrainz/XML2/Utils.hs
@@ -1,22 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Network.Protocol.MusicBrainz.XML2.Utils (- nameCreditsToArtistName- , nameCreditsToArtistSortName-) where--import Control.Applicative ((<|>), liftA2)-import Data.Maybe (catMaybes)-import Data.Text (Text)-import qualified Data.Text as T--import Network.Protocol.MusicBrainz.XML2.Types--nameCreditsToArtistName :: [NameCredit] -> Text-nameCreditsToArtistName = T.concat . map (nameSpan _nameCreditArtistName)--nameCreditsToArtistSortName :: [NameCredit] -> Text-nameCreditsToArtistSortName = T.concat . map (nameSpan (liftA2 (<|>) _nameCreditArtistSortName _nameCreditArtistName))--nameSpan :: (NameCredit -> Maybe Text) -> NameCredit -> Text-nameSpan f = T.concat . catMaybes . liftA2 (:) f (return . _nameCreditJoinPhrase)
Network/Protocol/MusicBrainz/XML2/WebService.hs view
@@ -6,15 +6,14 @@ , searchReleasesByArtistAndRelease ) where -import Network.Protocol.MusicBrainz.XML2.Types+import Network.Protocol.MusicBrainz.Types import Control.Applicative (liftA2, (<|>)) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Control (MonadBaseControl)-import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as BL-import Data.Conduit (Source, Sink, ($=), ($$), MonadThrow, runResourceT)-import Data.Conduit.List (sourceList)+import Data.Conduit (Consumer, ($=), ($$), MonadThrow, runResourceT)+import Data.Conduit.Binary (sourceLbs) import Data.List (intercalate) import Data.Maybe (fromMaybe) import Data.Text (Text)@@ -29,10 +28,6 @@ import Text.XML.Stream.Parse (parseBytes, def, content, tagNoAttr, tagName, requireAttr, optionalAttr, force, many, AttrParser) import Text.XML (Name(..)) --- not until conduit 0.5-sourceLbs :: Monad m => BL.ByteString -> Source m ByteString-sourceLbs = sourceList . BL.toChunks- musicBrainzWSLookup :: MonadIO m => Text -> Text -> [Text] -> m BL.ByteString musicBrainzWSLookup reqtype param incparams = do let url = "https://musicbrainz.org/ws/2/" ++ T.unpack reqtype ++ "/" ++ T.unpack param ++ incs incparams@@ -63,29 +58,30 @@ rs <- runResourceT $ sourceLbs lbs $= parseBytes def $$ sinkReleases return $ head rs -sinkRecordings :: MonadThrow m => Sink Event m [Recording]+sinkRecordings :: MonadThrow m => Consumer Event m [Recording] sinkRecordings = force "metadata required" (tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}metadata" $ many parseRecording) -sinkReleases :: MonadThrow m => Sink Event m [Release]+sinkReleases :: MonadThrow m => Consumer Event m [Release] sinkReleases = force "metadata required" (tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}metadata" $ many (fmap (fmap snd) parseRelease)) -sinkReleaseList :: MonadThrow m => Sink Event m [(Int, Release)]+sinkReleaseList :: MonadThrow m => Consumer Event m [(Int, Release)] sinkReleaseList = force "metadata required" (tagName "{http://musicbrainz.org/ns/mmd-2.0#}metadata" (optionalAttr "created") $ \_ -> force "release-list required" (tagName "{http://musicbrainz.org/ns/mmd-2.0#}release-list" (liftA2 (,) (requireAttr "count") (requireAttr "offset")) $ \_ -> many parseRelease)) -parseRecording :: MonadThrow m => Sink Event m (Maybe Recording)+parseRecording :: MonadThrow m => Consumer Event m (Maybe Recording) parseRecording = tagName "{http://musicbrainz.org/ns/mmd-2.0#}recording" (requireAttr "id") $ \rid -> do title <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}title" content len <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}length" content- ncs <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}artist-credit" $ many parseNameCredits+ 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 } -parseNameCredits :: MonadThrow m => Sink Event m (Maybe NameCredit)-parseNameCredits = tagName "{http://musicbrainz.org/ns/mmd-2.0#}name-credit" (buggyJoinPhrase) $ \mjp -> force "artist required" (tagName "{http://musicbrainz.org/ns/mmd-2.0#}artist" (requireAttr "id") $ \aid -> do+parseArtistCredit :: MonadThrow m => Consumer Event m (Maybe ArtistCredit)+parseArtistCredit = tagName "{http://musicbrainz.org/ns/mmd-2.0#}name-credit" (buggyJoinPhrase) $ \mjp -> force "artist required" (tagName "{http://musicbrainz.org/ns/mmd-2.0#}artist" (requireAttr "id") $ \aid -> do name <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}name" content sortName <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}sort-name" content _ <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}disambiguation" content- return NameCredit { _nameCreditArtistId = MBID aid, _nameCreditJoinPhrase = mjp, _nameCreditArtistName = name, _nameCreditArtistSortName = sortName }+ let a = Artist { _artistId = MBID aid, _artistName = name, _artistSortName = sortName, _artistDisambiguation = Nothing }+ return ArtistCredit { _artistCreditArtist = a, _artistCreditJoinPhrase = mjp, _artistCreditName = name } ) -- what's up with this@@ -96,19 +92,21 @@ forceReadDec :: Integral a => Text -> a forceReadDec = (\(Right (d, _)) -> d) . TR.decimal -parseRelease :: MonadThrow m => Sink Event m (Maybe (Int, Release))+parseRelease :: MonadThrow m => Consumer Event m (Maybe (Int, Release)) parseRelease = tagName "{http://musicbrainz.org/ns/mmd-2.0#}release" (liftA2 (,) (requireAttr "id") (optionalAttr "{http://musicbrainz.org/ns/ext#-2.0}score")) $ \(rid,score) -> do title <- force "title required" (tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}title" 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 parseNameCredits+ 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 <- tagName "{http://musicbrainz.org/ns/mmd-2.0#}release-event-list" (requireAttr "count") $ \_ -> many 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 <- tagName "{http://musicbrainz.org/ns/mmd-2.0#}medium-list" (requireAttr "count") $ \_ -> (tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}track-count" content >> many parseMedium) return (maybe 0 forceReadDec score, Release {@@ -121,12 +119,14 @@ , _releaseArtistCredit = fromMaybe [] ncs , _releaseDate = parseTime 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 => Sink Event m (Maybe TextRepresentation)+parseTextRepresentation :: MonadThrow m => Consumer Event m (Maybe TextRepresentation) parseTextRepresentation = tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}text-representation" $ do lang <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}language" content script <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}script" content@@ -135,42 +135,45 @@ , _textRepScript = script } -parseMedium :: MonadThrow m => Sink Event m (Maybe Medium)+parseMedium :: MonadThrow m => Consumer Event m (Maybe Medium) parseMedium = tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}medium" $ do title <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}title" content position <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}position" content format <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}format" content- disclist <- tagName "{http://musicbrainz.org/ns/mmd-2.0#}disc-list" (requireAttr "count") $ \c -> return (DiscList . forceReadDec $ c)- tracklist <- tagName "{http://musicbrainz.org/ns/mmd-2.0#}track-list" (requireAttr "count" >>= \c -> optionalAttr "offset" >>= \o -> return (c, o)) $ \(_,o') -> do+ Just med <- tagName "{http://musicbrainz.org/ns/mmd-2.0#}track-list" (liftA2 (,) (requireAttr "count") (optionalAttr "offset")) $ \(c,o) -> do -- not Just tracks <- many parseTrack- return TrackList { _trackListOffset = fmap forceReadDec o', _trackListTracks = V.fromList tracks }- return Medium {- _mediumTitle = title- , _mediumPosition = fmap forceReadDec position- , _mediumFormat = format- , _mediumDiscList = disclist- , _mediumTrackList = tracklist- }+ return Medium {+ _mediumTitle = title+ , _mediumPosition = fmap forceReadDec position+ , _mediumFormat = format+ , _mediumTrackCount = forceReadDec c+ , _mediumTrackOffset = fmap forceReadDec o+ , _mediumTrackList = Just tracks -- not Just+ }+ return med -parseTrack :: MonadThrow m => Sink Event m (Maybe Track)-parseTrack = tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}track" $ do+parseTrack :: MonadThrow m => Consumer Event m (Maybe Track)+parseTrack = tagName "{http://musicbrainz.org/ns/mmd-2.0#}track" (requireAttr "id") $ \i -> do position <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}position" 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 {- _trackPosition = fmap forceReadDec position- , _trackNumber = fmap forceReadDec number+ _trackId = MBID i+ , _trackArtistCredit = fromMaybe [] artistcredit+ , _trackPosition = fmap forceReadDec position+ , _trackNumber = number , _trackLength = fmap forceReadDec len , _trackRecording = recording } -parseReleaseGroup :: MonadThrow m => Sink Event m (Maybe ReleaseGroup)+parseReleaseGroup :: MonadThrow m => Consumer Event m (Maybe ReleaseGroup) parseReleaseGroup = tagName "{http://musicbrainz.org/ns/mmd-2.0#}release-group" (liftA2 (,) (requireAttr "type") (requireAttr "id")) $ \(t,i) -> do title <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}title" 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 parseNameCredits+ ncs <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}artist-credit" $ many parseArtistCredit return ReleaseGroup { _releaseGroupId = MBID i , _releaseGroupType = t@@ -180,7 +183,7 @@ , _releaseGroupArtistCredit = fromMaybe [] ncs } -parseLabelInfo :: MonadThrow m => Sink Event m (Maybe LabelInfo)+parseLabelInfo :: MonadThrow m => Consumer Event m (Maybe LabelInfo) parseLabelInfo = tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}label-info" $ do catno <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}catalog-number" content label <- force "label required" parseLabel@@ -189,7 +192,7 @@ , _labelInfoLabel = label } -parseLabel :: MonadThrow m => Sink Event m (Maybe Label)+parseLabel :: MonadThrow m => Consumer Event m (Maybe Label) parseLabel = tagName "{http://musicbrainz.org/ns/mmd-2.0#}label" (requireAttr "id") $ \i -> do name <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}name" content sortname <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}sort-name" content@@ -199,6 +202,47 @@ , _labelName = name , _labelSortName = sortname , _labelLabelCode = labelcode+ }++parseReleaseEvent :: MonadThrow m => Consumer Event m (Maybe ReleaseEvent)+parseReleaseEvent = tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}release-event" $ do+ date <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}date" content+ area <- parseArea+ return ReleaseEvent {+ _releaseEventDate = parseTime defaultTimeLocale "%Y-%m-%d" . T.unpack =<< date+ , _releaseEventArea = area+ }++parseArea :: MonadThrow m => Consumer Event m (Maybe Area)+parseArea = tagName "{http://musicbrainz.org/ns/mmd-2.0#}area" (requireAttr "id") $ \i -> do+ name <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}name" 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 => Consumer Event m (Maybe ISO3166Code)+parseISO3166Code = tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}iso-3166-1-code" (content >>= (return . ISO3166Code))++parseCoverArtArchive :: MonadThrow m => Consumer Event m (Maybe CoverArtArchive)+parseCoverArtArchive = tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}cover-art-archive" $ do+ artwork <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}artwork" 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) => Text -> Text -> Maybe Int -> Maybe Int -> m [(Int, Release)]