MusicBrainz 0.0 → 0.1
raw patch · 4 files changed
+164/−34 lines, 4 filesdep +HTTPdep ~bytestringdep ~conduitdep ~http-conduit
Dependencies added: HTTP
Dependency ranges changed: bytestring, conduit, http-conduit, http-types, xml-conduit
Files
- MusicBrainz.cabal +10/−7
- Network/Protocol/MusicBrainz/XML2/Types.hs +34/−2
- Network/Protocol/MusicBrainz/XML2/Utils.hs +22/−0
- Network/Protocol/MusicBrainz/XML2/WebService.hs +98/−25
MusicBrainz.cabal view
@@ -1,5 +1,5 @@ name: MusicBrainz-version: 0.0+version: 0.1 synopsis: interface to MusicBrainz XML2 web service description: interface to MusicBrainz XML2 web service homepage: http://floss.scru.org/hMusicBrainz@@ -15,19 +15,22 @@ library exposed-modules: Network.Protocol.MusicBrainz.XML2.WebService , Network.Protocol.MusicBrainz.XML2.Types+ , Network.Protocol.MusicBrainz.XML2.Utils build-depends: base >= 4.5 && <5 , transformers >= 0.3 , monad-control ==0.3.*- , bytestring ==0.9.*- , conduit ==0.4.*+ , bytestring+ , conduit >= 0.4 && <0.6 , text ==0.11.* , time , vector ==0.9.* , xml-types ==0.3.*- , http-conduit ==1.4.*- , http-types ==0.6.*+ , http-conduit >= 1.4 && <1.9+ , http-types >= 0.6 && <0.8 , old-locale ==1.0.*- , xml-conduit ==0.7.*+ , xml-conduit >= 0.7 && <1.1+ , HTTP >= 4000.0+ ghc-options: -Wall source-repository head type: git@@ -37,4 +40,4 @@ source-repository this type: git location: git://anonscm.debian.org/users/clint/MusicBrainz.git- tag: hMB/0.0+ tag: hMB/0.1
Network/Protocol/MusicBrainz/XML2/Types.hs view
@@ -3,10 +3,14 @@ , Release(..) , TextRepresentation(..) , Medium(..)+ , DiscList(..) , TrackList(..) , Track(..) , Recording(..) , NameCredit(..)+ , ReleaseGroup(..)+ , LabelInfo(..)+ , Label(..) ) where import Data.Text (Text)@@ -18,7 +22,7 @@ data Release = Release { _releaseId :: MBID- , _releaseTitle :: Maybe Text+ , _releaseTitle :: Text , _releaseStatus :: Maybe Text , _releaseQuality :: Maybe Text , _releasePackaging :: Maybe Text@@ -39,11 +43,17 @@ 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 :: Integer+ _trackListOffset :: Maybe Integer , _trackListTracks :: Vector Track } deriving (Eq, Show) @@ -63,6 +73,28 @@ 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 view
@@ -0,0 +1,22 @@+{-# 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
@@ -3,52 +3,63 @@ module Network.Protocol.MusicBrainz.XML2.WebService ( getRecordingById , getReleaseById+ , searchReleasesByArtistAndRelease ) where import Network.Protocol.MusicBrainz.XML2.Types -import Control.Monad (when, replicateM)-import Control.Monad.IO.Class (MonadIO, liftIO)+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, ($=), ($$), MonadResource, MonadThrow, runResourceT)+import Data.Conduit (Source, Sink, ($=), ($$), MonadThrow, runResourceT) import Data.Conduit.List (sourceList) 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.Calendar (Day) import Data.Time.Format (parseTime) import qualified Data.Vector as V import Data.XML.Types (Event)-import Network.HTTP.Conduit (http, withManager, parseUrl, Response(..), simpleHttp)-import Network.HTTP.Types (ok200)+import Network.HTTP.Base (urlEncode)+import Network.HTTP.Conduit (simpleHttp) import System.Locale (defaultTimeLocale)-import Text.XML.Stream.Parse (parseBytes, def, content, tagNoAttr, tagName, requireAttr, force, many)+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 -musicBrainzWSRequest :: MonadIO m => Text -> Text -> [Text] -> m BL.ByteString-musicBrainzWSRequest reqtype param incparams = do+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 simpleHttp url where incs [] = "" 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+ let url = "https://musicbrainz.org/ws/2/" ++ T.unpack reqtype ++ "/?query=" ++ urlEncode (T.unpack query) ++ limit mlimit ++ offset moffset+ simpleHttp url+ where+ limit Nothing = ""+ limit (Just l) = "&limit=" ++ show l+ offset Nothing = ""+ offset (Just o) = "&offset=" ++ show o+ getRecordingById :: (MonadBaseControl IO m, MonadIO m, MonadThrow m) => MBID -> m Recording getRecordingById mbid = do- lbs <- musicBrainzWSRequest "recording" (unMBID mbid) ["artist-credits"]+ lbs <- musicBrainzWSLookup "recording" (unMBID mbid) ["artist-credits"] rs <- runResourceT $ sourceLbs lbs $= parseBytes def $$ sinkRecordings return $ head rs getReleaseById :: (MonadBaseControl IO m, MonadIO m, MonadThrow m) => MBID -> m Release getReleaseById mbid = do- lbs <- musicBrainzWSRequest "release" (unMBID mbid) ["recordings", "artist-credits"]+ lbs <- musicBrainzWSLookup "release" (unMBID mbid) ["recordings", "artist-credits"] rs <- runResourceT $ sourceLbs lbs $= parseBytes def $$ sinkReleases return $ head rs @@ -56,8 +67,12 @@ sinkRecordings = force "metadata required" (tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}metadata" $ many parseRecording) sinkReleases :: MonadThrow m => Sink Event m [Release]-sinkReleases = force "metadata required" (tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}metadata" $ many parseRelease)+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 = 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 = tagName "{http://musicbrainz.org/ns/mmd-2.0#}recording" (requireAttr "id") $ \rid -> do title <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}title" content@@ -66,29 +81,37 @@ return Recording { _recordingId = MBID rid, _recordingTitle = title, _recordingLength = fmap forceReadDec len, _recordingArtistCredit = fromMaybe [] ncs } parseNameCredits :: MonadThrow m => Sink Event m (Maybe NameCredit)-parseNameCredits = tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}name-credit" $ force "artist required" (tagName "{http://musicbrainz.org/ns/mmd-2.0#}artist" (requireAttr "id") $ \aid -> do+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 name <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}name" content sortName <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}sort-name" content- return NameCredit { _nameCreditArtistId = MBID aid, _nameCreditArtistName = name, _nameCreditArtistSortName = sortName }+ _ <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}disambiguation" content+ return NameCredit { _nameCreditArtistId = MBID aid, _nameCreditJoinPhrase = mjp, _nameCreditArtistName = name, _nameCreditArtistSortName = sortName } ) +-- 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 }+ forceReadDec :: Integral a => Text -> a forceReadDec = (\(Right (d, _)) -> d) . TR.decimal -parseRelease :: MonadThrow m => Sink Event m (Maybe Release)-parseRelease = tagName "{http://musicbrainz.org/ns/mmd-2.0#}release" (requireAttr "id") $ \rid -> do- title <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}title" content+parseRelease :: MonadThrow m => Sink 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+ _ <- parseReleaseGroup date <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}date" content country <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}country" content barcode <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}barcode" content- asin <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}asin" content- media <- tagName "{http://musicbrainz.org/ns/mmd-2.0#}medium-list" (requireAttr "count") $ \_ -> many parseMedium- return Release {+ amazonASIN <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}asin" content+ _ <- 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 { _releaseId = MBID rid , _releaseTitle = title , _releaseStatus = status@@ -99,9 +122,9 @@ , _releaseDate = parseTime defaultTimeLocale "%Y-%m-%d" . T.unpack =<< date , _releaseCountry = country , _releaseBarcode = barcode- , _releaseASIN = asin+ , _releaseASIN = amazonASIN , _releaseMedia = V.fromList (fromMaybe [] media)- }+ }) parseTextRepresentation :: MonadThrow m => Sink Event m (Maybe TextRepresentation) parseTextRepresentation = tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}text-representation" $ do@@ -116,10 +139,18 @@ 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- tracklist <- tagName "{http://musicbrainz.org/ns/mmd-2.0#}track-list" (requireAttr "count" >>= \c -> requireAttr "offset" >>= \o -> return (c, o)) $ \(c',o') -> do+ 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 tracks <- many parseTrack- return TrackList { _trackListOffset = forceReadDec o', _trackListTracks = V.fromList tracks }- return Medium { _mediumTitle = title, _mediumPosition = fmap forceReadDec position, _mediumTrackList = tracklist }+ return TrackList { _trackListOffset = fmap forceReadDec o', _trackListTracks = V.fromList tracks }+ return Medium {+ _mediumTitle = title+ , _mediumPosition = fmap forceReadDec position+ , _mediumFormat = format+ , _mediumDiscList = disclist+ , _mediumTrackList = tracklist+ } parseTrack :: MonadThrow m => Sink Event m (Maybe Track) parseTrack = tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}track" $ do@@ -133,3 +164,45 @@ , _trackLength = fmap forceReadDec len , _trackRecording = recording }++parseReleaseGroup :: MonadThrow m => Sink 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+ return ReleaseGroup {+ _releaseGroupId = MBID i+ , _releaseGroupType = t+ , _releaseGroupTitle = title+ , _releaseGroupFirstReleaseDate = frd+ , _releaseGroupPrimaryType = pt+ , _releaseGroupArtistCredit = fromMaybe [] ncs+ }++parseLabelInfo :: MonadThrow m => Sink 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+ return LabelInfo {+ _labelInfoCatalogNumber = catno+ , _labelInfoLabel = label+ }++parseLabel :: MonadThrow m => Sink 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+ labelcode <- tagNoAttr "{http://musicbrainz.org/ns/mmd-2.0#}label-code" content+ return Label {+ _labelId = MBID i+ , _labelName = name+ , _labelSortName = sortname+ , _labelLabelCode = labelcode+ }++searchReleasesByArtistAndRelease :: (MonadIO m, MonadBaseControl IO m, MonadThrow 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+ return rs