diff --git a/MusicBrainz.cabal b/MusicBrainz.cabal --- a/MusicBrainz.cabal +++ b/MusicBrainz.cabal @@ -1,5 +1,5 @@ name: MusicBrainz -version: 0.2.4 +version: 0.3 synopsis: interface to MusicBrainz XML2 web service description: interface to MusicBrainz XML2 web service homepage: http://floss.scru.org/hMusicBrainz @@ -7,7 +7,7 @@ license-file: LICENSE author: Clint Adams maintainer: clint@debian.org -copyright: 2012-2015 Clint Adams +copyright: 2012-2017 Clint Adams category: Network build-type: Simple cabal-version: >=1.8 @@ -32,17 +32,17 @@ , xml-types >= 0.3 , http-conduit >= 1.8.8 , http-types >= 0.6 - , xml-conduit >= 1.1 + , xml-conduit >= 1.5 , HTTP >= 4000.0 , aeson >= 0.6.1 ghc-options: -Wall source-repository head type: git - location: git://anonscm.debian.org/users/clint/MusicBrainz.git + location: https://anonscm.debian.org/git/users/clint/MusicBrainz.git branch: master source-repository this type: git - location: git://anonscm.debian.org/users/clint/MusicBrainz.git - tag: hMB/0.2.4 + location: https://anonscm.debian.org/git/users/clint/MusicBrainz.git + tag: hMB/0.3 diff --git a/Network/Protocol/MusicBrainz/JSON/WebService.hs b/Network/Protocol/MusicBrainz/JSON/WebService.hs --- a/Network/Protocol/MusicBrainz/JSON/WebService.hs +++ b/Network/Protocol/MusicBrainz/JSON/WebService.hs @@ -9,7 +9,6 @@ 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) @@ -24,8 +23,8 @@ simpleHttp url where incs [] = "" - incs xs = ("?inc="++) . intercalate "+" . map T.unpack $ xs - fj = "&fmt=json" + 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 @@ -33,22 +32,22 @@ simpleHttp url where limit Nothing = "" - limit (Just l) = "&limit=" ++ show l + limit (Just l) = "&limit=" ++ show l offset Nothing = "" - offset (Just o) = "&offset=" ++ show o - fj = "&fmt=json" + offset (Just o) = "&offset=" ++ show o + fj = "&fmt=json" -getRecordingById :: (MonadBaseControl IO m, MonadIO m) => MBID -> m (Either String Recording) +getRecordingById :: 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 :: 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 :: MonadIO 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 diff --git a/Network/Protocol/MusicBrainz/Types.hs b/Network/Protocol/MusicBrainz/Types.hs --- a/Network/Protocol/MusicBrainz/Types.hs +++ b/Network/Protocol/MusicBrainz/Types.hs @@ -27,7 +27,7 @@ import Data.Aeson (FromJSON(..), (.:), (.:?), Value(..)) import Data.Maybe (fromMaybe) import qualified Data.Text as T -import Data.Time.Format (parseTime) +import Data.Time.Format (parseTimeM) import Data.Time.Locale.Compat (defaultTimeLocale) newtype MBID = MBID { unMBID :: Text } @@ -53,19 +53,19 @@ 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" + v .: "title" <*> + v .:? "status" <*> + v .:? "quality" <*> + v .:? "packaging" <*> + v .:? "text-representation" <*> + v .: "artist-credit" <*> + ((parseTimeM True 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 { @@ -75,8 +75,8 @@ instance FromJSON TextRepresentation where parseJSON (Object v) = TextRepresentation <$> - v .:? "language" <*> - v .:? "script" + v .:? "language" <*> + v .:? "script" parseJSON _ = mzero data Medium = Medium { @@ -90,12 +90,12 @@ instance FromJSON Medium where parseJSON (Object v) = Medium <$> - v .:? "title" <*> - v .:? "position" <*> - v .:? "format" <*> - v .: "track-count" <*> - v .:? "track-offset" <*> - v .:? "tracks" + v .:? "title" <*> + v .:? "position" <*> + v .:? "format" <*> + v .: "track-count" <*> + v .:? "track-offset" <*> + v .:? "tracks" parseJSON _ = mzero data Track = Track { @@ -109,12 +109,12 @@ instance FromJSON Track where parseJSON (Object v) = Track <$> - (MBID <$> v .: "id") <*> - v .: "artist-credit" <*> - v .:? "position" <*> - v .:? "number" <*> - v .:? "length" <*> - v .: "recording" + (MBID <$> v .: "id") <*> + v .: "artist-credit" <*> + v .:? "position" <*> + v .:? "number" <*> + v .:? "length" <*> + v .: "recording" parseJSON _ = mzero data Recording = Recording { @@ -126,10 +126,10 @@ instance FromJSON Recording where parseJSON (Object v) = Recording <$> - (MBID <$> v .: "id") <*> - v .:? "title" <*> - v .:? "length" <*> - v .: "artist-credit" + (MBID <$> v .: "id") <*> + v .:? "title" <*> + v .:? "length" <*> + v .: "artist-credit" parseJSON _ = mzero data ArtistCredit = ArtistCredit { @@ -140,9 +140,9 @@ instance FromJSON ArtistCredit where parseJSON (Object v) = ArtistCredit <$> - v .: "artist" <*> - v .:? "joinphrase" <*> - v .:? "name" + v .: "artist" <*> + v .:? "joinphrase" <*> + v .:? "name" parseJSON _ = mzero data Artist = Artist { @@ -154,10 +154,10 @@ instance FromJSON Artist where parseJSON (Object v) = Artist <$> - (MBID <$> v .: "id") <*> - v .:? "name" <*> - v .:? "sort-name" <*> - v .:? "disambiguation" + (MBID <$> v .: "id") <*> + v .:? "name" <*> + v .:? "sort-name" <*> + v .:? "disambiguation" parseJSON _ = mzero data ReleaseGroup = ReleaseGroup { @@ -188,8 +188,8 @@ instance FromJSON ReleaseEvent where parseJSON (Object v) = ReleaseEvent <$> - ((parseTime defaultTimeLocale "%Y-%m-%d" . T.unpack =<<) <$> v .:? "date") <*> - v .:? "area" + ((parseTimeM True defaultTimeLocale "%Y-%m-%d" . T.unpack =<<) <$> v .:? "date") <*> + v .:? "area" parseJSON _ = mzero data Area = Area { @@ -203,12 +203,12 @@ 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") + (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 { @@ -220,10 +220,10 @@ instance FromJSON CoverArtArchive where parseJSON (Object v) = CoverArtArchive <$> - v .:? "artwork" <*> - v .:? "count" <*> - v .:? "front" <*> - v .:? "back" + v .:? "artwork" <*> + v .:? "count" <*> + v .:? "front" <*> + v .:? "back" parseJSON _ = mzero newtype ISO3166Code = ISO3166Code { unISO3166Code :: Text } diff --git a/Network/Protocol/MusicBrainz/XML2/WebService.hs b/Network/Protocol/MusicBrainz/XML2/WebService.hs --- a/Network/Protocol/MusicBrainz/XML2/WebService.hs +++ b/Network/Protocol/MusicBrainz/XML2/WebService.hs @@ -20,13 +20,13 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Read as TR -import Data.Time.Format (parseTime) +import Data.Time.Format (parseTimeM) import qualified Data.Vector as V 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, tagName, requireAttr, optionalAttr, force, many, AttrParser) +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 @@ -35,7 +35,7 @@ simpleHttp url where incs [] = "" - incs xs = ("?inc="++) . intercalate "+" . map T.unpack $ xs + incs xs = ("?inc="++) . intercalate "+" . map T.unpack $ xs musicBrainzWSSearch :: MonadIO m => Text -> Text -> Maybe Int -> Maybe Int -> m BL.ByteString musicBrainzWSSearch reqtype query mlimit moffset = do @@ -43,9 +43,9 @@ simpleHttp url where limit Nothing = "" - limit (Just l) = "&limit=" ++ show l + limit (Just l) = "&limit=" ++ show l offset Nothing = "" - offset (Just o) = "&offset=" ++ show o + offset (Just o) = "&offset=" ++ show o getRecordingById :: (MonadBaseControl IO m, MonadIO m, MonadThrow m) => MBID -> m Recording getRecordingById mbid = do @@ -66,18 +66,18 @@ sinkReleases = force "metadata required" (tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}metadata" $ many (fmap (fmap snd) parseRelease)) 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)) +sinkReleaseList = force "metadata required" (tag' "{http://musicbrainz.org/ns/mmd-2.0#}metadata" (attr "created") $ \_ -> + force "release-list required" (tag' "{http://musicbrainz.org/ns/mmd-2.0#}release-list" (liftA2 (,) (requireAttr "count") (requireAttr "offset")) $ \_ -> many parseRelease)) parseRecording :: MonadThrow m => Consumer Event m (Maybe Recording) -parseRecording = tagName "{http://musicbrainz.org/ns/mmd-2.0#}recording" (requireAttr "id") $ \rid -> do +parseRecording = tag' "{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 parseArtistCredit return Recording { _recordingId = MBID rid, _recordingTitle = title, _recordingLength = fmap forceReadDec len, _recordingArtistCredit = fromMaybe [] ncs } 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 +parseArtistCredit = tag' "{http://musicbrainz.org/ns/mmd-2.0#}name-credit" (buggyJoinPhrase) $ \mjp -> force "artist required" (tag' "{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 @@ -88,13 +88,13 @@ -- what's up with this buggyJoinPhrase :: AttrParser (Maybe Text) buggyJoinPhrase = fmap Just (requireAttr "{http://musicbrainz.org/ns/mmd-2.0#}joinphrase") - <|> optionalAttr "{http://musicbrainz.org/ns/mmd-2.0#}joinphrase" { nameNamespace = Nothing } + <|> attr "{http://musicbrainz.org/ns/mmd-2.0#}joinphrase" { nameNamespace = Nothing } forceReadDec :: Integral a => Text -> a forceReadDec = (\(Right (d, _)) -> d) . TR.decimal 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 +parseRelease = tag' "{http://musicbrainz.org/ns/mmd-2.0#}release" (liftA2 (,) (requireAttr "id") (attr "{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 @@ -104,12 +104,12 @@ _ <- 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 + rel <- tag' "{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) + media <- tag' "{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 { _releaseId = MBID rid , _releaseTitle = title @@ -118,7 +118,7 @@ , _releasePackaging = packaging , _releaseTextRepresentation = tr , _releaseArtistCredit = fromMaybe [] ncs - , _releaseDate = parseTime defaultTimeLocale "%Y-%m-%d" . T.unpack =<< date + , _releaseDate = parseTimeM True defaultTimeLocale "%Y-%m-%d" . T.unpack =<< date , _releaseCountry = country , _releaseEvents = fromMaybe [] rel , _releaseBarcode = barcode @@ -141,7 +141,7 @@ 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 - Just med <- tagName "{http://musicbrainz.org/ns/mmd-2.0#}track-list" (liftA2 (,) (requireAttr "count") (optionalAttr "offset")) $ \(c,o) -> do -- not Just + Just med <- tag' "{http://musicbrainz.org/ns/mmd-2.0#}track-list" (liftA2 (,) (requireAttr "count") (attr "offset")) $ \(c,o) -> do -- not Just tracks <- many parseTrack return Medium { _mediumTitle = title @@ -154,7 +154,7 @@ return med parseTrack :: MonadThrow m => Consumer Event m (Maybe Track) -parseTrack = tagName "{http://musicbrainz.org/ns/mmd-2.0#}track" (requireAttr "id") $ \i -> do +parseTrack = tag' "{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 @@ -170,7 +170,7 @@ } 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 +parseReleaseGroup = tag' "{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 @@ -194,7 +194,7 @@ } parseLabel :: MonadThrow m => Consumer Event m (Maybe Label) -parseLabel = tagName "{http://musicbrainz.org/ns/mmd-2.0#}label" (requireAttr "id") $ \i -> do +parseLabel = tag' "{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 labelcode <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}label-code" content @@ -210,12 +210,12 @@ date <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}date" content area <- parseArea return ReleaseEvent { - _releaseEventDate = parseTime defaultTimeLocale "%Y-%m-%d" . T.unpack =<< date + _releaseEventDate = parseTimeM True 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 +parseArea = tag' "{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