{-# 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 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 :: 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] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] fj [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 fj :: [Char] fj = [Char] "&fmt=json" 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] -> [Char] -> [Char] forall a. [a] -> [a] -> [a] ++ [Char] fj [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 fj :: [Char] fj = [Char] "&fmt=json" getRecordingById :: MonadIO m => MBID -> m (Either String Recording) getRecordingById :: forall (m :: * -> *). MonadIO m => MBID -> m (Either [Char] Recording) getRecordingById MBID mbid = do ByteString 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"] Either [Char] Recording -> m (Either [Char] Recording) forall a. a -> m a forall (m :: * -> *) a. Monad m => a -> m a return (Either [Char] Recording -> m (Either [Char] Recording)) -> Either [Char] Recording -> m (Either [Char] Recording) forall a b. (a -> b) -> a -> b $ ByteString -> Either [Char] Recording forall a. FromJSON a => ByteString -> Either [Char] a eitherDecode ByteString lbs getReleaseById :: MonadIO m => MBID -> m (Either String Release) getReleaseById :: forall (m :: * -> *). MonadIO m => MBID -> m (Either [Char] Release) getReleaseById MBID mbid = do ByteString 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"] Either [Char] Release -> m (Either [Char] Release) forall a. a -> m a forall (m :: * -> *) a. Monad m => a -> m a return (Either [Char] Release -> m (Either [Char] Release)) -> Either [Char] Release -> m (Either [Char] Release) forall a b. (a -> b) -> a -> b $ ByteString -> Either [Char] Release forall a. FromJSON a => ByteString -> Either [Char] a eitherDecode ByteString lbs searchReleasesByArtistAndRelease :: MonadIO m => Text -> Text -> Maybe Int -> Maybe Int -> m (Either String [(Int, Release)]) searchReleasesByArtistAndRelease :: forall (m :: * -> *). MonadIO m => Text -> Text -> Maybe Int -> Maybe Int -> m (Either [Char] [(Int, Release)]) searchReleasesByArtistAndRelease Text artist Text release Maybe Int mlimit Maybe Int moffset = do ByteString 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 Either [Char] [(Int, Release)] -> m (Either [Char] [(Int, Release)]) forall a. a -> m a forall (m :: * -> *) a. Monad m => a -> m a return (Either [Char] [(Int, Release)] -> m (Either [Char] [(Int, Release)])) -> Either [Char] [(Int, Release)] -> m (Either [Char] [(Int, Release)]) forall a b. (a -> b) -> a -> b $ ByteString -> Either [Char] [(Int, Release)] forall a. FromJSON a => ByteString -> Either [Char] a eitherDecode ByteString lbs