discogs-haskell (empty) → 0.0.5.0
raw patch · 27 files changed
+1224/−0 lines, 27 filesdep +Cabaldep +aesondep +api-buildersetup-changed
Dependencies added: Cabal, aeson, api-builder, base, bytestring, data-default-class, discogs-haskell, free, hspec, http-client, http-client-tls, http-types, network, text, time, transformers, unordered-containers, vector
Files
- LICENSE +21/−0
- Setup.hs +2/−0
- discogs-haskell.cabal +96/−0
- src/Discogs.hs +153/−0
- src/Discogs/Actions.hs +12/−0
- src/Discogs/Actions/Artist.hs +36/−0
- src/Discogs/Actions/Label.hs +32/−0
- src/Discogs/Actions/Master.hs +34/−0
- src/Discogs/Actions/Release.hs +22/−0
- src/Discogs/Login.hs +24/−0
- src/Discogs/Routes.hs +7/−0
- src/Discogs/Routes/Artist.hs +16/−0
- src/Discogs/Routes/Label.hs +15/−0
- src/Discogs/Routes/Master.hs +15/−0
- src/Discogs/Routes/Release.hs +10/−0
- src/Discogs/Types.hs +8/−0
- src/Discogs/Types/Artist.hs +100/−0
- src/Discogs/Types/Discogs.hs +119/−0
- src/Discogs/Types/Error.hs +38/−0
- src/Discogs/Types/Label.hs +107/−0
- src/Discogs/Types/Master.hs +58/−0
- src/Discogs/Types/Pagination.hs +29/−0
- src/Discogs/Types/Release.hs +150/−0
- src/Discogs/Types/User.hs +45/−0
- test/Discogs/Types/ArtistSpec.hs +37/−0
- test/Discogs/Types/ReleaseSpec.hs +37/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2016 accraze++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ discogs-haskell.cabal view
@@ -0,0 +1,96 @@+name: discogs-haskell+version: 0.0.5.0+synopsis: Client for Discogs REST API+description: Contains actions to retrieve data from the Discogs database.+homepage: http://github.com/accraze/discogs-haskell+license: MIT+license-file: LICENSE+author: accraze+maintainer: accraze@gmail.com+copyright: 2016 accraze+category: Web+build-type: Simple+cabal-version: >=1.10++library+ exposed-modules:+ Discogs+ Discogs.Actions+ Discogs.Actions.Artist+ Discogs.Actions.Label+ Discogs.Actions.Master+ Discogs.Actions.Release+ Discogs.Types+ Discogs.Types.Artist+ Discogs.Types.Label+ Discogs.Types.Master+ Discogs.Types.Release+ other-modules:+ Discogs.Routes+ Discogs.Routes.Artist+ Discogs.Login+ Discogs.Routes.Release+ Discogs.Types.Discogs+ Discogs.Types.Error+ Discogs.Types.User+ Discogs.Routes.Label+ Discogs.Routes.Master+ Discogs.Types.Pagination+ hs-source-dirs: src/+ default-extensions:+ FlexibleInstances+ GADTs+ GeneralizedNewtypeDeriving+ LambdaCase+ OverloadedStrings+ default-language: Haskell2010+ hs-source-dirs: src/+ build-depends:+ base >= 4.6 && < 4.9,+ aeson >= 0.9 && < 0.10,+ bytestring == 0.10.*,+ data-default-class == 0.0.1,+ free >= 4 && < 5,+ http-client == 0.4.20,+ http-client-tls >= 0.2 && < 0.2.3,+ http-types == 0.8.6,+ network == 2.6.*,+ api-builder == 0.11.0.0,+ text == 1.*,+ time == 1.5.*,+ transformers == 0.4.*,+ unordered-containers == 0.2.5.*,+ vector >= 0.10 && < 0.12+ ghc-options: -Wall++test-suite test+ hs-source-dirs: test/+ main-is: Spec.hs+ default-extensions: OverloadedStrings+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ build-depends:+ base == 4.*,+ Cabal >= 1.16.0,+ aeson,+ api-builder,+ bytestring,+ hspec,+ discogs-haskell,+ text,+ time,+ transformers+ other-modules:+ Discogs.Types.ArtistSpec+ Discogs.Types.ReleaseSpec+ ghc-options: -Wall++source-repository head+ type: git+ location: http://github.com/accraze/discogs-haskell++source-repository this+ type: git+ location: http://github.com/accraze/discogs-haskell+ tag: 0.0.5.0+
+ src/Discogs.hs view
@@ -0,0 +1,153 @@+-- | This main module contains the building blocks to operate the library.+-- It exports functionality for running built 'DiscogsT' actions, as well+-- as re-exporting a few helpful types from around the library. Not every+-- type is exported, however, due to clashing record fields. It's recommended+-- to import modules from @Discogs.Types.*@ qualified so that you can use all+-- the record fields without having to deal with ambiguous functions.+module Discogs+ (runDiscogs+ , runDiscogsAnon+ , runDiscogsWith+ , runResumeDiscogsWith+ , interpretIO+ , DiscogsOptions(..)+ , defaultDiscogsOptions+ , LoginMethod(..)+ , APIError(..)+ , module Discogs.Types.Error+ , module Discogs.Types.Discogs) where++import Discogs.Actions()+import Discogs.Types()+import Discogs.Login+import Discogs.Types.Error+import Discogs.Types.Discogs++import Control.Concurrent+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Free+import Data.ByteString.Char8 (ByteString)+import Data.Default.Class+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)+import Network.API.Builder as API+import Network.HTTP.Client+import Network.HTTP.Client.TLS+import Network.HTTP.Types++data DiscogsOptions =+ DiscogsOptions { rateLimitingEnabled :: Bool+ , connectionManager :: Maybe Manager+ , loginMethod :: LoginMethod+ , customUserAgent :: Maybe ByteString }++instance Default DiscogsOptions where+ def = DiscogsOptions True Nothing Anonymous Nothing++-- | The default set of options (ie: Anonymous login)+defaultDiscogsOptions :: DiscogsOptions+defaultDiscogsOptions = def++-- | Are we logging in to Discogs? If yes, should we use a stored set of credentials+-- or get a new fresh set?+data LoginMethod = Anonymous -- ^ Don't login, instead use an anonymous account+ | Credentials Text Text -- ^ Login using the specified username and password+ | StoredDetails LoginDetails -- ^+ -- Login using a stored set of credentials. Usually the best way to get+ -- these is to do @'runDiscogsAnon' $ 'login' user pass@.+ deriving (Show)++instance Default LoginMethod where def = Anonymous++-- | Run a 'Discogs' action (or a 'DiscogsT' transformer action). This uses the default logged-in settings+-- for 'DiscogsOptions': rate limiting enabled, default manager, login via username and password, and+-- the default user-agent. You should change the user agent if you're making anything more complex than+-- a basic script, since Discogs's API policy says that you should have a uniquely identifiable user agent.+runDiscogs :: MonadIO m => Text -> Text -> DiscogsT m a -> m (Either (APIError DiscogsError) a)+runDiscogs user pass = runDiscogsWith def { loginMethod = Credentials user pass }++-- | Run a 'Discogs' action (or a 'DiscogsT' transformer action). This uses the default logged-out settings, so+-- you won't be able to do anything that requires authentication (like searching or marketplace related functions).+runDiscogsAnon :: MonadIO m => DiscogsT m a -> m (Either (APIError DiscogsError) a)+runDiscogsAnon = runDiscogsWith def++---- | Run a 'Discogs' or 'DiscogsT' action with custom settings. Us this+---- if you want to persist a connection over multiple 'Discogs' sessions or+---- use a custom user-agent string.+runDiscogsWith :: MonadIO m => DiscogsOptions -> DiscogsT m a -> m (Either (APIError DiscogsError) a)+runDiscogsWith opts discogs = liftM dropResume $ runResumeDiscogsWith opts discogs++-- | Run a 'Discogs' or 'DiscogsT' action with custom settings. You probably won't need this function for+-- most things, but it's handy if you want to persist a connection over multiple 'Discogs' sessions or+-- use a custom user agent string.+runResumeDiscogsWith :: MonadIO m => DiscogsOptions -> DiscogsT m a -> m (Either (APIError DiscogsError, Maybe (DiscogsT m a)) a)+runResumeDiscogsWith (DiscogsOptions rl man lm _ua) discogs = do+ manager <- case man of+ Just m -> return m+ Nothing -> liftIO $ newManager tlsManagerSettings+ loginCreds <- case lm of+ Anonymous -> return $ Right Nothing+ StoredDetails ld -> return $ Right $ Just ld+ Credentials user pass -> liftM (fmap Just) $ interpretIO (DiscogsState loginBaseURL rl manager [] Nothing) $ login user pass+ case loginCreds of+ Left (err, _) -> return $ Left (err, Just discogs)+ Right lds ->+ interpretIO+ (DiscogsState mainBaseURL rl manager [("User-Agent", "discogs-haskell dev version")] lds) discogs++interpretIO :: MonadIO m => DiscogsState -> DiscogsT m a -> m (Either (APIError DiscogsError, Maybe (DiscogsT m a)) a)+interpretIO rstate (DiscogsT r) =+ runFreeT r >>= \case+ Pure x -> return $ Right x+ Free (WithBaseURL u x n) ->+ interpretIO (rstate { currentBaseURL = u }) x >>= \case+ Left (err, Just resume) ->+ return $ Left (err, Just $ resume >>= DiscogsT . n)+ Left (err, Nothing) -> return $ Left (err, Nothing)+ Right res -> interpretIO rstate $ DiscogsT $ n res+ Free (FailWith x) -> return $ Left (x, Nothing)+ Free (Nest x n) ->+ interpretIO rstate $ DiscogsT $ wrap $ NestResuming x (n . dropResume)+ Free (NestResuming x n) -> do+ res <- interpretIO rstate x+ interpretIO rstate $ DiscogsT $ n res+ Free (RunRoute route n) ->+ interpretIO rstate $ DiscogsT $ wrap $ ReceiveRoute route (n . unwrapJSON)+ Free (ReceiveRoute route n) ->+ handleReceive route rstate >>= \case+ Left err@(APIError (RateLimitError secs _)) ->+ if rateLimit rstate+ then do+ liftIO $ threadDelay $ fromInteger secs * 1000 * 1000+ interpretIO rstate $ DiscogsT $ wrap $ ReceiveRoute route n+ else return $ Left (err, Just $ DiscogsT $ wrap $ ReceiveRoute route n)+ Left err -> return $ Left (err, Just $ DiscogsT $ wrap $ ReceiveRoute route n)+ Right x -> interpretIO rstate $ DiscogsT $ n x++dropResume :: Either (APIError DiscogsError, Maybe (DiscogsT m a)) a -> Either (APIError DiscogsError) a+dropResume (Left (x, _)) = Left x+dropResume (Right x) = Right x++handleReceive :: (MonadIO m, Receivable a) => Route -> DiscogsState -> m (Either (APIError DiscogsError) a)+handleReceive d dstate = do+ (res, _, _) <- runAPI (builderFromState dstate) (connMgr dstate) () $+ API.runRoute d+ return res++builderFromState :: DiscogsState -> Builder+builderFromState (DiscogsState burl _ _ hdrs (Just (LoginDetails (Modhash mh) cj))) =+ Builder "Discogs" burl addAPIType $+ \req -> addHeaders (("X-Modhash", encodeUtf8 mh):hdrs) req { cookieJar = Just cj }+builderFromState (DiscogsState burl _ _ hdrs Nothing) =+ Builder "Discogs" burl addAPIType (addHeaders hdrs)++addHeaders :: [Header] -> Request -> Request+addHeaders xs req = req { requestHeaders = requestHeaders req ++ xs }++data DiscogsState =+ DiscogsState { currentBaseURL :: Text+ , rateLimit :: Bool+ , connMgr :: Manager+ , _extraHeaders :: [Header]+ , _creds :: Maybe LoginDetails }
+ src/Discogs/Actions.hs view
@@ -0,0 +1,12 @@+-- | This module contains all actions that wrap Discog's API endpoints.+-- Only database actions (with the exception of search) have been implemented so far.+module Discogs.Actions+ ( module Discogs.Actions.Artist+ , module Discogs.Actions.Release+ , module Discogs.Actions.Master+ , module Discogs.Actions.Label ) where++import Discogs.Actions.Artist +import Discogs.Actions.Release+import Discogs.Actions.Master+import Discogs.Actions.Label
+ src/Discogs/Actions/Artist.hs view
@@ -0,0 +1,36 @@+-- | Contains artist-related actions, like finding an artist's releases or retrieving an+-- artist's information.+module Discogs.Actions.Artist+ ( getArtist+ , getArtistReleases ) where++import Discogs.Types.Artist+import Discogs.Types.Discogs+import Discogs.Types.Release+import qualified Discogs.Routes.Artist as Route++import Control.Monad+import Data.Default.Class+import Data.Text (Text)+import qualified Data.Text as Text++-- | Get the information Discogs exposes on artist with the specified id+--+-- GET \/artists\/:artistId+--+-- @+-- runDiscogsAnon $ Discogs.Actions.getArtist $ ArtistID "108713"+-- @+getArtist :: Monad m => ArtistID -> DiscogsT m Artist+getArtist = runRoute . Route.getArtist++-- | Get all release information exposed for an artist with specified id+--+-- GET \/artists\/:artistId\/releases+--+-- @+-- runDiscogsAnon $ Discogs.Actions.getArtistReleases $ ArtistID "108713"+-- @+getArtistReleases :: Monad m => ArtistID -> DiscogsT m ReleaseList+getArtistReleases = runRoute . Route.getArtistReleases+
+ src/Discogs/Actions/Label.hs view
@@ -0,0 +1,32 @@+-- | Contains label related actions, like finding a label by id or getting a list of all the label's releases.+module Discogs.Actions.Label+ ( getLabel, getLabelReleases ) where++import Discogs.Types.Label+import Discogs.Types.Discogs+import qualified Discogs.Routes.Label as Route++import Control.Monad+import Data.Default.Class+import Data.Aeson+import qualified Data.Text as Text++-- | Get a label with a specific id+--+-- GET \/labels\/:labelId+--+-- @+-- runDiscogsAnon $ Discogs.Actions.getLabel $ LabelID "1"+-- @+getLabel :: Monad m => LabelID -> DiscogsT m Label+getLabel = runRoute . Route.getLabel++-- | Get all releases from a label with a specific id+--+-- GET \/labels\/:labelId\/releases+--+-- @+-- runDiscogsAnon $ Discogs.Actions.getLabelReleases $ LabelID "1"+-- @+getLabelReleases :: Monad m => LabelID -> DiscogsT m LabelReleaseList+getLabelReleases = runRoute . Route.getLabelReleases
+ src/Discogs/Actions/Master.hs view
@@ -0,0 +1,34 @@+-- | Contains master-related actions, like finding a specific master release by id +-- or getting a list of all master versions.+module Discogs.Actions.Master+ ( getMaster,+ getMasterVersions ) where++import Discogs.Types.Master+import Discogs.Types.Discogs+import qualified Discogs.Routes.Master as Route++import Control.Monad+import Data.Default.Class+import Data.Aeson+import qualified Data.Text as Text++-- | Get the information on a master release with the specified id+--+-- GET \/masters\/:masterId+--+-- @+-- runDiscogsAnon $ Discogs.Actions.getMaster $ MasterID "1000"+-- @+getMaster :: Monad m => MasterID -> DiscogsT m Master+getMaster = runRoute . Route.getMaster++-- | Get a list of all master versions with a specific id+--+-- GET \/masters\/:masterId\/versions+--+-- @+-- runDiscogsAnon $ Discogs.Actions.getMasterVersions $ MasterID "1000"+-- @+getMasterVersions :: Monad m => MasterID -> DiscogsT m MasterVersionsList+getMasterVersions = runRoute . Route.getMasterVersions
+ src/Discogs/Actions/Release.hs view
@@ -0,0 +1,22 @@+-- | Contains release related actions, like finding a specific release by id.+module Discogs.Actions.Release+ ( getRelease ) where++import Discogs.Types.Release+import Discogs.Types.Discogs+import qualified Discogs.Routes.Release as Route++import Control.Monad+import Data.Default.Class+import Data.Text (Text)+import qualified Data.Text as Text++-- | Get release with the specified id+--+-- GET \/releases\/:releaseId+--+-- @+-- runDiscogsAnon $ Discogs.Actions.getRelease $ ReleaseID "249504"+-- @+getRelease :: Monad m => ReleaseID -> DiscogsT m Release+getRelease = runRoute . Route.getRelease
+ src/Discogs/Login.hs view
@@ -0,0 +1,24 @@+module Discogs.Login+ ( login ) where++import Discogs.Types.Discogs++import Data.Text (Text)+import Network.API.Builder hiding (runRoute)++loginRoute :: Text -> Text -> Route+loginRoute user pass = Route [ "api", "login" ]+ [ "rem" =. True+ , "user" =. user+ , "passwd" =. pass ]+ "POST"++getLoginDetails :: Monad m => Text -> Text -> DiscogsT m LoginDetails+getLoginDetails user pass = receiveRoute $ loginRoute user pass++-- | Make a login request with the given username and password.+login :: Monad m+ => Text -- ^ Username to login with+ -> Text -- ^ Password to login with+ -> DiscogsT m LoginDetails+login = getLoginDetails
+ src/Discogs/Routes.hs view
@@ -0,0 +1,7 @@+module Discogs.Routes+ ( module Routes ) where++import Discogs.Routes.Artist as Routes+import Discogs.Routes.Release as Routes+import Discogs.Routes.Master as Routes+import Discogs.Routes.Label as Routes
+ src/Discogs/Routes/Artist.hs view
@@ -0,0 +1,16 @@+module Discogs.Routes.Artist where++import Discogs.Types.Artist+import Discogs.Types.Release++import Network.API.Builder.Routes++getArtist :: ArtistID -> Route+getArtist (ArtistID artist) = Route [ "artists", artist ]+ []+ "GET"++getArtistReleases :: ArtistID -> Route+getArtistReleases (ArtistID artist) = Route [ "artists", artist, "releases" ]+ []+ "GET"
+ src/Discogs/Routes/Label.hs view
@@ -0,0 +1,15 @@+module Discogs.Routes.Label where++import Discogs.Types.Label++import Network.API.Builder.Routes++getLabel :: LabelID -> Route+getLabel (LabelID label) = Route [ "labels", label ]+ []+ "GET"++getLabelReleases :: LabelID -> Route+getLabelReleases (LabelID label) = Route [ "labels", label, "releases" ]+ []+ "GET"
+ src/Discogs/Routes/Master.hs view
@@ -0,0 +1,15 @@+module Discogs.Routes.Master where++import Discogs.Types.Master++import Network.API.Builder.Routes++getMaster :: MasterID -> Route+getMaster (MasterID master) = Route [ "masters", master ]+ []+ "GET"++getMasterVersions :: MasterID -> Route+getMasterVersions (MasterID master) = Route [ "masters", master, "versions" ]+ []+ "GET"
+ src/Discogs/Routes/Release.hs view
@@ -0,0 +1,10 @@+module Discogs.Routes.Release where++import Discogs.Types.Release++import Network.API.Builder.Routes++getRelease :: ReleaseID -> Route+getRelease (ReleaseID release) = Route [ "releases", release ]+ []+ "GET"
+ src/Discogs/Types.hs view
@@ -0,0 +1,8 @@+-- | This module contains all types of data returned by the Discogs API.+-- Only database actions (with the exception of search) have been implemented so far.+module Discogs.Types ( Artist, Release, Master, Label ) where++import Discogs.Types.Artist (Artist)+import Discogs.Types.Release (Release)+import Discogs.Types.Master (Master)+import Discogs.Types.Label (Label)
+ src/Discogs/Types/Artist.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE DeriveGeneric #-}++module Discogs.Types.Artist where++import GHC.Generics++import Control.Applicative+import Control.Monad+import Data.Aeson+import Data.Monoid+import Data.Text (Text)+import Network.API.Builder.Query++-- | This is required to look up an artist. Example: \'108713\'+newtype ArtistID = ArtistID Text+ deriving (Show, Read, Eq, Ord, Generic)++instance FromJSON ArtistID++-- | The Artist resource represents a person in the Discogs database who contributed to a Release in some capacity.+data Artist =+ Artist { + profile :: Maybe Text -- Artist profile info+ , id :: Int -- The Artist ID+ , releases_url :: Text -- Url with Artist's releases + , resource_url :: Maybe Text -- Url with Artist resources+ , uri :: Maybe Text+ , data_quality :: Text + , namevariations :: Maybe [Text] -- Different names for the Artist.+ , urls :: [Text] -- + , images :: !Array+ , members :: !Array }+ deriving (Show, Eq, Read, Generic)++instance FromJSON Artist++-- | This is a list of type Image.+data ImagesList = ImagesList {imagesList :: !Array}+ deriving (Show, Eq, Generic)++instance FromJSON ImagesList++-- | This is a image of an Artist which has been submitted by a contributor.+data Image = Image {height :: Int+ , iResource_url :: String+ , iType :: String+ , iUri :: String+ , uri150 :: String+ , width :: Int }+ deriving (Show, Eq, Generic)++instance FromJSON Image where+ parseJSON (Object o) = Image <$> o .: "height" + <*> o .: "resource_url"+ <*> o .: "type"+ <*> o .: "uri"+ <*> o .: "uri150"+ <*> o .: "width"+ parseJSON _ = mempty++-- | This is a list of type Member.+data MembersList + = MembersList {+ membersList :: !Array+ } deriving (Show, Eq)++instance FromJSON MembersList where+ parseJSON (Object o) = MembersList <$> (o .: "members")+ parseJSON _ = mzero++-- | This is a member that belongs to the Artists. Eg: members of a band, contributors to a project.+data Member = Member {active :: Bool+ , id2 :: Integer+ , name :: String+ , mResource_url :: String }+ deriving (Show, Eq, Generic)++instance FromJSON Member++-- | This is a list of type ReleaseArtist+data ReleaseArtistList+ = ReleaseArtistList {+ releaseArtists :: !Array+ } deriving (Show, Eq)++instance FromJSON ReleaseArtistList where+ parseJSON (Object o) = ReleaseArtistList <$> (o .: "artists")+ parseJSON _ = mzero++-- | This a Release that the Artist has performed on.+data ReleaseArtist = ReleaseArtist {anv :: String+ , rId :: Int+ , join :: String+ , rName :: String+ , rResource_url :: String+ , role :: String+ , tracks :: String }+ deriving (Show, Eq, Generic)++instance FromJSON ReleaseArtist
+ src/Discogs/Types/Discogs.hs view
@@ -0,0 +1,119 @@+module Discogs.Types.Discogs+ ( Discogs+ , DiscogsT(..)+ , DiscogsF(..)+ , runRoute+ , receiveRoute+ , nest+ , failWith+ , Modhash(..)+ , LoginDetails(..)+ , withBaseURL+ , builder+ , mainBaseURL+ , loginBaseURL+ , addHeader+ , addAPIType ) where++import Discogs.Types.Error++import Control.Applicative+import Control.Monad.IO.Class+import Control.Monad.Trans.Free+import Control.Monad.Trans.Class+import Data.Aeson+import Data.ByteString.Lazy (ByteString)+import Data.Monoid+import Data.Text (Text)+import Data.Time.Clock+import Network.API.Builder hiding (runRoute)+import Network.HTTP.Client hiding (path)+import Network.HTTP.Types+import Prelude+import Text.Read (readMaybe)+import qualified Data.ByteString.Char8 as BS++type Discogs a = DiscogsT IO a++data DiscogsF m a where+ FailWith :: APIError DiscogsError -> DiscogsF m a+ Nest :: DiscogsT m b -> (Either (APIError DiscogsError) b -> a) -> DiscogsF m a+ NestResuming :: DiscogsT m b -> (Either (APIError DiscogsError, Maybe (DiscogsT m b)) b -> a) -> DiscogsF m a+ ReceiveRoute :: Receivable b => Route -> (b -> a) -> DiscogsF m a+ RunRoute :: FromJSON b => Route -> (b -> a) -> DiscogsF m a+ WithBaseURL :: Text -> DiscogsT m b -> (b -> a) -> DiscogsF m a++instance Functor (DiscogsF m) where+ fmap _ (FailWith x) = FailWith x+ fmap f (Nest a x) = Nest a (fmap f x)+ fmap f (NestResuming a x) = NestResuming a (fmap f x)+ fmap f (ReceiveRoute r x) = ReceiveRoute r (fmap f x)+ fmap f (RunRoute r x) = RunRoute r (fmap f x)+ fmap f (WithBaseURL u a x) = WithBaseURL u a (fmap f x)++newtype DiscogsT m a = DiscogsT (FreeT (DiscogsF m) m a)+ deriving (Functor, Applicative, Monad)++instance MonadTrans DiscogsT where+ lift = DiscogsT . lift++instance MonadIO m => MonadIO (DiscogsT m) where+ liftIO = DiscogsT . liftIO++runRoute :: (FromJSON a, Monad m) => Route -> DiscogsT m a+runRoute r = DiscogsT $ liftF $ RunRoute r id++receiveRoute :: (Receivable a, Monad m) => Route -> DiscogsT m a+receiveRoute r = DiscogsT $ liftF $ ReceiveRoute r id++nest :: Monad m => DiscogsT m a -> DiscogsT m (Either (APIError DiscogsError) a)+nest f = DiscogsT $ liftF $ Nest f id++withBaseURL :: Monad m => Text -> DiscogsT m a -> DiscogsT m a+withBaseURL u f = DiscogsT $ liftF $ WithBaseURL u f id++failWith :: Monad m => APIError DiscogsError -> DiscogsT m a+failWith = DiscogsT . liftF . FailWith++newtype Modhash = Modhash Text+ deriving (Show, Read, Eq)++instance FromJSON Modhash where+ parseJSON (Object o) =+ Modhash <$> ((o .: "json") >>= (.: "data") >>= (.: "modhash"))+ parseJSON _ = mempty++data LoginDetails = LoginDetails Modhash CookieJar+ deriving (Show, Eq)++instance Receivable LoginDetails where+ receive x = do+ (resp, mh) <- receive x+ return $ LoginDetails (unwrapJSON mh) (responseCookieJar (resp :: Response ByteString))++newtype POSTWrapped a = POSTWrapped a+ deriving (Show, Read, Eq)++instance Functor POSTWrapped where+ fmap f (POSTWrapped a) = POSTWrapped (f a)++builder :: Builder+builder = Builder "Discogs API"+ mainBaseURL+ addAPIType+ (addHeader Nothing)++addHeader :: Maybe BS.ByteString -> Request -> Request+addHeader Nothing req = req { requestHeaders =+ ("User-Agent", "discogs-haskell 0.1.0.0 / accraze") : requestHeaders req }+addHeader (Just hdr) req = req { requestHeaders =+ ("User-Agent", hdr) : requestHeaders req }++addAPIType :: Route -> Route+addAPIType (Route fs ps m) = Route fs ps m++mainBaseURL :: Text+mainBaseURL = "https://api.discogs.com"++loginBaseURL :: Text+loginBaseURL = "https://api.discogs.com"
+ src/Discogs/Types/Error.hs view
@@ -0,0 +1,38 @@+module Discogs.Types.Error+ (DiscogsError(..)) where++import Control.Applicative+import Control.Monad+import Data.Aeson+import Data.Monoid+import Data.Text (Text)+import Data.Vector ((!?))+import Network.API.Builder.Receive+import Prelude+import qualified Data.Vector as V++data DiscogsError = DiscogsError Object+ | NoRelease+ | NoArtist+ | RateLimitError Integer Text+ | NoMasterRelease+ | NoLabel+ deriving (Show, Eq)++instance FromJSON DiscogsError where+ parseJSON (Object o) = do+ Array errors <- o .: "message"+ case errors !? 0 of+ Just (Array e) -> case V.toList e of+ String "Release not found." : _ -> return NoRelease+ String "Artist not found." : _ -> return NoArtist+ String "RATELIMIT" : String d : _ ->+ RateLimitError <$> ((o .: "json") >>= (.: "ratelimit")) <*> pure d+ String "Master Release not found." : _ -> return NoMasterRelease+ String "Label not found." : _ -> return NoLabel+ _ -> return $ DiscogsError o+ _ -> mempty+ parseJSON _ = mempty++instance ErrorReceivable DiscogsError where+ receiveError = useErrorFromJSON
+ src/Discogs/Types/Label.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE DeriveGeneric #-}++module Discogs.Types.Label where++import GHC.Generics++import Control.Applicative+import Control.Monad+import Data.Aeson+import Data.Monoid+import Data.Text (Text)+import Network.API.Builder.Query++import Discogs.Types.Artist+import Discogs.Types.Pagination++-- | This is required to look up a release. Example: \'1\'+newtype LabelID = LabelID Text+ deriving (Show, Read, Eq, Ord, Generic)+instance FromJSON LabelID++-- | The Label resource represents a label, company, recording studio, +-- location, or other entity involved with Artists and Releases. +data Label+ = Label {+ id :: Int+ , profile :: String+ , releases_url :: String+ , name :: String+ , contact_info :: String+ , uri :: String+ , sublabels :: Array+ , urls :: Array+ , images:: Array+ , resource_url :: String+ , data_quality :: String+ } deriving (Show, Generic, Eq)++instance FromJSON Label++-- | This is for any sort of associated sub-label, siblings, etc.+data Sublabel+ = Sublabel {+ sublabel_id :: Int+ , sublabel_name :: String+ , sublabel_resource_url :: String+ } deriving (Show, Generic, Eq) ++instance FromJSON Sublabel where+ parseJSON (Object o) = Sublabel <$> o .: "id" + <*> o .: "name"+ <*> o .: "resource_url"+ parseJSON _ = mempty++-- | A list of type LabelRelease.+data LabelReleaseList+ = LabelReleaseList { + pagination :: Pagination+ ,releases :: !Array+ } deriving (Show, Generic, Eq)++instance FromJSON LabelReleaseList++-- | A release that was put out by a Label.+data LabelRelease+ = LabelRelease { artist :: String+ ,release_catno :: String+ ,format :: String+ ,release_id :: String+ ,release_resource_url :: String+ ,status :: String+ ,thumb :: String+ ,title :: String+ ,year :: Int+ } deriving (Show, Generic, Eq)++instance FromJSON LabelRelease where+ parseJSON (Object o) = LabelRelease <$> o .: "artist" + <*> o .: "catno"+ <*> o .: "format"+ <*> o .: "release_id"+ <*> o .: "resource_url"+ <*> o .: "status"+ <*> o .: "thumb"+ <*> o .: "title"+ <*> o .: "year"+ parseJSON _ = mempty++-- | A company that was involved with a specific Label.+data Company+ = Company { + catno :: String+ , entity_type :: String+ , entity_type_name :: Maybe String+ , company_id :: Int+ , company_name :: String+ , company_resource_url :: String+ } deriving (Show, Generic, Eq)++instance FromJSON Company where + parseJSON (Object o) = Company <$> o .: "catno" + <*> o .: "entity_type"+ <*> o .: "entity_type_name"+ <*> o .: "id"+ <*> o .: "name"+ <*> o .: "resource_url"+ parseJSON _ = mempty
+ src/Discogs/Types/Master.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE DeriveGeneric #-}++module Discogs.Types.Master where++import GHC.Generics++import Control.Applicative+import Control.Monad+import Data.Aeson+import Data.Monoid+import Data.Text (Text)+import Network.API.Builder.Query++import Discogs.Types.Artist+import Discogs.Types.Label+import Discogs.Types.User+import Discogs.Types.Release+import Discogs.Types.Pagination++-- | This is required to look up a master release. Example: \'1000\'+data MasterID = MasterID Text+ deriving (Show, Read, Eq, Ord, Generic)+++instance FromJSON MasterID++-- | The Master resource represents a set of similar Releases. +-- Masters (also known as “master releases”) have a “main release” which is +-- often the chronologically earliest.+data Master =+ Master { + title :: Text+ , id :: Int+ , artists :: !Array+ , data_quality :: Text+ , genres :: [Text]+ , images :: Maybe Array+ , main_release :: Int+ , main_release_url :: Text+ , resource_url :: Maybe Text+ , styles :: [Text]+ , tracklist :: !Array+ , uri :: Text + , videos :: Maybe Array+ , versions_url :: Text+ , year :: Maybe Int }+ deriving (Show, Eq, Generic)++instance FromJSON Master++-- | This is a list of type MasterVersion.+data MasterVersionsList =+ MasterVersionsList { + pagination :: Pagination+ , versions :: !Array }+ deriving (Show, Eq, Generic)++instance FromJSON MasterVersionsList
+ src/Discogs/Types/Pagination.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE DeriveGeneric #-}++module Discogs.Types.Pagination where++import GHC.Generics++import Control.Applicative+import Control.Monad+import Data.Aeson+import Data.Monoid+import Data.Text (Text)+import Network.API.Builder.Query++data Pagination+ = Pagination { per_page :: Int+ ,items :: Int+ ,page :: Int+ ,pages :: Int+ ,urls :: Urls+ } deriving (Show, Generic, Eq)++instance FromJSON Pagination++data Urls+ = Urls { last :: Maybe String+ ,next :: Maybe String+ } deriving (Show, Generic, Eq)++instance FromJSON Urls
+ src/Discogs/Types/Release.hs view
@@ -0,0 +1,150 @@+{-# LANGUAGE DeriveGeneric #-}++module Discogs.Types.Release where++import GHC.Generics++import Control.Applicative+import Control.Monad+import Data.Aeson+import Data.Monoid+import Data.Text (Text)+import Network.API.Builder.Query++import Discogs.Types.Artist+import Discogs.Types.Label+import Discogs.Types.User+import Discogs.Types.Pagination++-- | This is required to look up a release. Example: \'249504\'+newtype ReleaseID = ReleaseID Text+ deriving (Show, Read, Eq, Ord, Generic)++instance FromJSON ReleaseID++-- | The Release resource represents a particular physical or digital object +-- released by one or more Artists.+data Release =+ Release { + title :: Text+ , id :: Int+ , artists :: !Array+ , data_quality :: Text+ , thumb :: Maybe Text+ , community :: Community+ , companies :: Maybe Array+ , country :: Maybe Text+ , date_added :: Maybe Text+ , date_changed :: Maybe Text+ , estimated_weight :: Maybe Int+ , extraartists :: Maybe Array+ , format_quantity :: Maybe Int+ , formats :: Array+ , genres :: [Text]+ , identifiers :: Maybe Array+ , images :: Maybe Array+ , labels :: Maybe Array+ , master_id :: Int+ , master_url :: Text+ , notes :: Text+ , released :: Maybe Text+ , released_formatted :: Maybe Text+ , resource_url :: Maybe Text+ , series :: Maybe Array+ , status :: Text+ , styles :: [Text]+ , tracklist :: !Array+ , uri :: Text + , videos :: Maybe Array+ , year :: Maybe Int }+ deriving (Show, Eq, Generic)++instance FromJSON Release++-- | This is a list containg Releases.+data ReleaseList+ = ReleaseList {+ releases :: !Array+ ,pagination :: Pagination+ } deriving Show++instance FromJSON ReleaseList where+ parseJSON (Object o) = ReleaseList <$>+ (o .: "releases")+ <*> (o .: "pagination")+ parseJSON _ = mzero++-- | This is an artist who performs on a release.+data ArtistRelease+ = ArtistRelease { artist :: String+ ,r_id :: Int+ ,main_release :: Int+ ,rResource_url :: String+ ,role :: String+ ,rthumb :: String+ ,rtitle :: String+ ,rtype :: String+ ,ryear :: Int+ } deriving Show++instance FromJSON ArtistRelease where+ parseJSON (Object o) =+ ArtistRelease <$> (o .: "artist")+ <*> (o .: "id")+ <*> (o .: "main_release")+ <*> (o .: "resource_url")+ <*> (o .: "role")+ <*> (o .: "thumb")+ <*> (o .: "title")+ <*> (o .: "type")+ <*> (o .: "year")+ parseJSON _ = mzero++-- | This is the format of a release. Example: 2 X 7" Vinyl +data Format+ = Format { descriptions :: Maybe Array+ ,name :: Int+ ,quantity :: Int+ } deriving (Show, Generic, Eq)++instance FromJSON Format++-- | This is the Release's identifier (barcode, etc.)+data Identifier+ = Identifier { iType :: String+ , value :: String+ } deriving (Show, Generic, Eq)++instance FromJSON Identifier where+ parseJSON (Object o) =+ Identifier <$> (o .: "type")+ <*> (o .: "value")+ parseJSON _ = mzero++-- | This is a track contained on a Release.+data Track+ = Track { duration :: String+ , position :: String+ , tTitle :: String+ , type_ :: String+ } deriving (Show, Generic, Eq)++instance FromJSON Track++-- | This is a Video resource associated with a Release.+data Video+ = Video { v_description :: String+ , v_duration :: Int+ , embed :: Bool+ , v_title :: String+ , v_uri :: String+ } deriving (Show, Generic, Eq)++instance FromJSON Video where+ parseJSON (Object o) =+ Video <$> (o .: "description")+ <*> (o .: "duration")+ <*> (o .: "embed")+ <*> (o .: "title")+ <*> (o .: "uri")+ parseJSON _ = mzero
+ src/Discogs/Types/User.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE DeriveGeneric #-}++module Discogs.Types.User where++import GHC.Generics++import Control.Applicative+import Control.Monad+import Data.Aeson+import Data.Monoid+import Data.Text (Text)+import Network.API.Builder.Query++import Discogs.Types.Artist+++data Community+ = Community {+ contributors :: !Array+ , data_quality :: String+ , have :: Int+ , rating :: Rating+ , status :: String+ , submitter :: Contributor+ , want :: Int+ } deriving (Show, Eq, Generic)++instance FromJSON Community++data Contributor+ = Contributor { + resource_url :: String+ , username :: String+ } deriving (Show, Generic, Eq)++instance FromJSON Contributor++data Rating+ = Rating { + average :: Double+ , count :: Int+ } deriving (Show, Generic, Eq)++instance FromJSON Rating+
+ test/Discogs/Types/ArtistSpec.hs view
@@ -0,0 +1,37 @@+module Discogs.Types.ArtistSpec where++import Discogs.Types.Artist++import Data.Aeson (eitherDecode)+import Test.Hspec+import qualified Data.ByteString.Lazy.Char8 as ByteString++isRight :: Either a b -> Bool+isRight = const False `either` const True++main :: IO ()+main = hspec spec++spec :: Spec+spec =+ describe "Discogs.Types.Artist" $ do+ getArtistExample <- runIO $ ByteString.readFile "test/data/getArtist_example.json"+ getArtistReleasesExample <- runIO $ ByteString.readFile "test/data/getArtistReleases_example.json"++ it "can read the fixtures" $ do+ getArtistExample `shouldSatisfy` not . ByteString.null+ getArtistReleasesExample `shouldSatisfy` not . ByteString.null++ --it "can parse an artist from json" $ do+ -- let decoded = eitherDecode getArtistExample :: Either String Artist+ -- decoded `shouldSatisfy` isRight++ -- case decoded of+ -- Left _ -> expectationFailure "json parse failed"+ -- Right artist -> do+ --artist_id artist `shouldBe` 108713+ --releases_url artist `shouldBe` "https://api.discogs.com/artists/108713/releases"+ --resource_url artist `shouldBe` "https://api.discogs.com/artists/108713"+ --uri artist `shouldBe` Just "https://www.discogs.com/artist/108713-Nickelback"+ --data_quality artist `shouldBe` "Needs Vote"+ --namevariations artist `shouldBe` Just ["Nickleback","\12491\12483\12465\12523\12496\12483\12463"]
+ test/Discogs/Types/ReleaseSpec.hs view
@@ -0,0 +1,37 @@+module Discogs.Types.ReleaseSpec where++import Discogs.Types.Release++import Data.Aeson (eitherDecode)+import Test.Hspec+import qualified Data.ByteString.Lazy.Char8 as ByteString++isRight :: Either a b -> Bool+isRight = const False `either` const True++main :: IO ()+main = hspec spec++spec :: Spec+spec =+ describe "Discogs.Types.Release" $ do+ getReleaseExample <- runIO $ ByteString.readFile "test/data/getRelease_example.json"++ it "can read the fixtures" $ do+ getReleaseExample `shouldSatisfy` not . ByteString.null++ --it "can parse a release from json" $ do+ -- let decoded = eitherDecode getReleaseExample :: Either String Release+ -- decoded `shouldSatisfy` isRight++ -- case decoded of+ -- Left _ -> expectationFailure "json parse failed"+ -- Right release -> do+ -- title release `shouldBe` "Never Gonna Give You Up"+ -- --id release `shouldBe` 249504+ -- resource_url release `shouldBe` Just "https://api.discogs.com/artists/72872"+ -- country release `shouldBe` Just "UK"+ --estimated_weight release `shouldBe` "60"+ --date_added release `shouldBe` "2004-04-30T08:10:05-07:00"+ --date_changed release `shouldBe` "2012-12-03T02:50:12-07:00"+ --year release `shouldBe` 1987
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}