diff --git a/MusicBrainz.cabal b/MusicBrainz.cabal --- a/MusicBrainz.cabal +++ b/MusicBrainz.cabal @@ -1,5 +1,5 @@ name: MusicBrainz -version: 0.3.1 +version: 0.4 synopsis: interface to MusicBrainz XML2 and JSON web services description: interface to MusicBrainz XML2 and JSON web services homepage: http://floss.scru.org/hMusicBrainz @@ -7,7 +7,7 @@ license-file: LICENSE author: Clint Adams maintainer: clint@debian.org -copyright: 2012-2017 Clint Adams +copyright: 2012-2018 Clint Adams category: Network build-type: Simple cabal-version: >=1.8 @@ -22,7 +22,7 @@ , transformers >= 0.3 , monad-control >= 0.3 , bytestring - , conduit >= 1.0.0 + , conduit >= 1.2.8 , conduit-extra >= 1.0.0 , text , time >= 1.5 @@ -35,14 +35,15 @@ , xml-conduit >= 1.5 , HTTP >= 4000.0 , aeson >= 0.6.1 + , unliftio-core ghc-options: -Wall source-repository head type: git - location: https://anonscm.debian.org/git/users/clint/MusicBrainz.git + location: https://salsa.debian.org/clint/MusicBrainz.git branch: master source-repository this type: git - location: https://anonscm.debian.org/git/users/clint/MusicBrainz.git - tag: hMB/0.3.1 + location: https://salsa.debian.org/clint/MusicBrainz.git + tag: hMB/0.4 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 @@ -10,10 +10,11 @@ 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, runResourceT) +import Control.Monad.Trans.Resource (MonadThrow) import qualified Data.ByteString.Lazy as BL -import Data.Conduit (Consumer, ($=), ($$)) +import Data.Conduit (ConduitM, (.|), runConduitRes) import Data.Conduit.Binary (sourceLbs) import Data.List (intercalate) import Data.Maybe (fromMaybe) @@ -22,6 +23,7 @@ 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) @@ -47,36 +49,36 @@ offset Nothing = "" offset (Just o) = "&offset=" ++ show o -getRecordingById :: (MonadBaseControl IO m, MonadIO m, MonadThrow m) => MBID -> m Recording +getRecordingById :: (MonadBaseControl IO m, MonadIO m, MonadThrow m, MonadUnliftIO m) => MBID -> m Recording getRecordingById mbid = do lbs <- musicBrainzWSLookup "recording" (unMBID mbid) ["artist-credits"] - rs <- runResourceT $ sourceLbs lbs $= parseBytes def $$ sinkRecordings + rs <- runConduitRes $ sourceLbs lbs .| parseBytes def .| sinkRecordings return $ head rs -getReleaseById :: (MonadBaseControl IO m, MonadIO m, MonadThrow m) => MBID -> m Release +getReleaseById :: (MonadBaseControl IO m, MonadIO m, MonadThrow m, MonadUnliftIO m) => MBID -> m Release getReleaseById mbid = do lbs <- musicBrainzWSLookup "release" (unMBID mbid) ["recordings", "artist-credits"] - rs <- runResourceT $ sourceLbs lbs $= parseBytes def $$ sinkReleases + rs <- runConduitRes $ sourceLbs lbs .| parseBytes def .| sinkReleases return $ head rs -sinkRecordings :: MonadThrow m => Consumer Event m [Recording] +sinkRecordings :: MonadThrow m => ConduitM Event Void m [Recording] sinkRecordings = force "metadata required" (tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}metadata" $ many parseRecording) -sinkReleases :: MonadThrow m => Consumer Event m [Release] +sinkReleases :: MonadThrow m => ConduitM Event Void m [Release] 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 :: MonadThrow m => ConduitM Event Void m [(Int, Release)] 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 :: MonadThrow m => ConduitM Event Void m (Maybe Recording) 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 :: MonadThrow m => ConduitM Event Void m (Maybe ArtistCredit) 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 @@ -93,7 +95,7 @@ forceReadDec :: Integral a => Text -> a forceReadDec = (\(Right (d, _)) -> d) . TR.decimal -parseRelease :: MonadThrow m => Consumer Event m (Maybe (Int, Release)) +parseRelease :: MonadThrow m => ConduitM Event Void m (Maybe (Int, Release)) 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 @@ -127,7 +129,7 @@ , _releaseMedia = V.fromList (fromMaybe [] media) }) -parseTextRepresentation :: MonadThrow m => Consumer Event m (Maybe TextRepresentation) +parseTextRepresentation :: MonadThrow m => ConduitM Event Void 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 @@ -136,7 +138,7 @@ , _textRepScript = script } -parseMedium :: MonadThrow m => Consumer Event m (Maybe Medium) +parseMedium :: MonadThrow m => ConduitM Event Void 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 @@ -153,7 +155,7 @@ } return med -parseTrack :: MonadThrow m => Consumer Event m (Maybe Track) +parseTrack :: MonadThrow m => ConduitM Event Void m (Maybe Track) 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 @@ -169,7 +171,7 @@ , _trackRecording = recording } -parseReleaseGroup :: MonadThrow m => Consumer Event m (Maybe ReleaseGroup) +parseReleaseGroup :: MonadThrow m => ConduitM Event Void m (Maybe ReleaseGroup) 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 @@ -184,7 +186,7 @@ , _releaseGroupArtistCredit = fromMaybe [] ncs } -parseLabelInfo :: MonadThrow m => Consumer Event m (Maybe LabelInfo) +parseLabelInfo :: MonadThrow m => ConduitM Event Void 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 @@ -193,7 +195,7 @@ , _labelInfoLabel = label } -parseLabel :: MonadThrow m => Consumer Event m (Maybe Label) +parseLabel :: MonadThrow m => ConduitM Event Void m (Maybe Label) 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 @@ -205,7 +207,7 @@ , _labelLabelCode = labelcode } -parseReleaseEvent :: MonadThrow m => Consumer Event m (Maybe ReleaseEvent) +parseReleaseEvent :: MonadThrow m => ConduitM Event Void 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 @@ -214,7 +216,7 @@ , _releaseEventArea = area } -parseArea :: MonadThrow m => Consumer Event m (Maybe Area) +parseArea :: MonadThrow m => ConduitM Event Void m (Maybe Area) 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 @@ -230,10 +232,10 @@ , _areaISO3166_3Codes = fromMaybe [] isocodes3 } -parseISO3166Code :: MonadThrow m => Consumer Event m (Maybe ISO3166Code) +parseISO3166Code :: MonadThrow m => ConduitM Event Void 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 :: MonadThrow m => ConduitM Event Void 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 @@ -246,8 +248,8 @@ , _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)] +searchReleasesByArtistAndRelease :: (MonadIO m, MonadBaseControl IO m, MonadThrow m, MonadUnliftIO m) => Text -> Text -> Maybe Int -> Maybe Int -> m [(Int, Release)] searchReleasesByArtistAndRelease artist release mlimit moffset = do lbs <- musicBrainzWSSearch "release" (T.concat ["artist:\"", artist, "\" AND release:\"", release, "\""]) mlimit moffset - rs <- runResourceT $ sourceLbs lbs $= parseBytes def $$ sinkReleaseList + rs <- runConduitRes $ sourceLbs lbs .| parseBytes def .| sinkReleaseList return rs