diff --git a/liblastfm.cabal b/liblastfm.cabal --- a/liblastfm.cabal +++ b/liblastfm.cabal @@ -1,5 +1,5 @@ name: liblastfm -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Lastfm API interface license: MIT license-file: LICENSE @@ -13,74 +13,46 @@ library default-language: Haskell2010 - build-depends: base >= 3 && < 5, - bytestring, - containers >= 0.5, - text, - cereal, - http-conduit >= 1.9, - http-types, - pureMD5, - crypto-api, - network, - contravariant, - void, - aeson + build-depends: + aeson, + base >= 3 && < 5, + bytestring, + cereal, + containers >= 0.5, + contravariant, + crypto-api, + http-conduit >= 1.9, + http-types, + network, + pureMD5, + semigroups, + text, + void hs-source-dirs: src - exposed-modules: Network.Lastfm - Network.Lastfm.Authentication - Network.Lastfm.Album - Network.Lastfm.Artist - Network.Lastfm.Chart - Network.Lastfm.Event - Network.Lastfm.Geo - Network.Lastfm.Group - Network.Lastfm.Library - Network.Lastfm.Playlist - Network.Lastfm.Radio - Network.Lastfm.Tag - Network.Lastfm.Tasteometer - Network.Lastfm.Track - Network.Lastfm.User - Network.Lastfm.Venue - Network.Lastfm.Request - Network.Lastfm.Response - Network.Lastfm.Internal - ghc-options: -Wall - -fno-warn-unused-do-bind - -funbox-strict-fields - - -test-suite json - build-depends: base >= 3 && < 5, - bytestring >= 0.9 && < 0.11, - attoparsec >= 0.10, - aeson == 0.6.*, - HUnit, - test-framework, - test-framework-hunit, - text, - liblastfm - type: exitcode-stdio-1.0 - hs-source-dirs: tests - main-is: json.hs - other-modules: Common - Venue - User - Track - Tasteometer - Tag - Playlist - Library - Group - Geo - Event - Chart - Artist - Album - ghc-options: -Wall - -fno-warn-unused-do-bind - -fno-warn-orphans + exposed-modules: + Network.Lastfm + Network.Lastfm.Album + Network.Lastfm.Artist + Network.Lastfm.Authentication + Network.Lastfm.Chart + Network.Lastfm.Event + Network.Lastfm.Geo + Network.Lastfm.Group + Network.Lastfm.Internal + Network.Lastfm.Library + Network.Lastfm.Playlist + Network.Lastfm.Radio + Network.Lastfm.Request + Network.Lastfm.Response + Network.Lastfm.Tag + Network.Lastfm.Tasteometer + Network.Lastfm.Track + Network.Lastfm.User + Network.Lastfm.Venue + ghc-options: + -Wall + -fno-warn-unused-do-bind + -funbox-strict-fields source-repository head diff --git a/src/Network/Lastfm.hs b/src/Network/Lastfm.hs --- a/src/Network/Lastfm.hs +++ b/src/Network/Lastfm.hs @@ -1,3 +1,4 @@ +-- | Lastfm API interface module Network.Lastfm ( -- * Utilities for constructing requests module Network.Lastfm.Request diff --git a/src/Network/Lastfm/Authentication.hs b/src/Network/Lastfm/Authentication.hs --- a/src/Network/Lastfm/Authentication.hs +++ b/src/Network/Lastfm/Authentication.hs @@ -12,6 +12,19 @@ -- -- Note that you can use any of them in your -- application despite their names +-- +-- How to get session key for yourself for debug with GHCi: +-- +-- >>> import Network.Lastfm +-- >>> import Network.Lastfm.Authentication +-- >>> :set -XOverloadedStrings +-- >>> lastfm $ getToken <*> apiKey "__API_KEY__" <* json +-- Just (Object fromList [("token",String "__TOKEN__")]) +-- >>> putStrLn . link $ apiKey "__API_KEY__" <* token "__TOKEN__" +-- http://www.last.fm/api/auth/?api_key=__API_KEY__&token=__TOKEN__ +-- >>> -- Click that link ^^^ +-- >>> lastfm . sign "__SECRET__" $ getSession <*> token "__TOKEN__" <*> apiKey "__API_KEY__" <* json +-- Just (Object fromList [("session",Object fromList [("name",String "__USER__"),("subscriber",String "0"),("key",String "__SESSION_KEY__")])]) module Network.Lastfm.Authentication ( -- * Helpers getToken, getSession, getMobileSession diff --git a/src/Network/Lastfm/Internal.hs b/src/Network/Lastfm/Internal.hs --- a/src/Network/Lastfm/Internal.hs +++ b/src/Network/Lastfm/Internal.hs @@ -7,6 +7,7 @@ module Network.Lastfm.Internal ( Request(..), Format(..), Ready, Sign , R(..), wrap, unwrap, render, coerce + , absorbQuery, indexedWith -- * Lenses , host, method, query ) where @@ -99,11 +100,28 @@ wrap = Request . Const . Dual . Endo {-# INLINE wrap #-} - -- | Unwrapping from interesting 'Monoid' ('R' -> 'R') instance unwrap :: Request f a -> R f -> R f unwrap = appEndo . getDual . getConst . unRequest {-# INLINE unwrap #-} + + +-- | Absorbing a bunch of queries, useful in batch operations +absorbQuery :: Foldable t => t (Request f b) -> Request f a +absorbQuery rs = wrap $ \r -> + r { _query = _query r <> foldMap (_query . ($ rempty) . unwrap) rs } +{-# INLINE absorbQuery #-} + +-- | Transforming Request to the "array notation" +indexedWith :: Int -> Request f a -> Request f a +indexedWith n r = r <* wrap (\s -> + s { _query = M.mapKeys (\k -> k <> "[" <> T.pack (show n) <> "]") (_query s) }) +{-# INLINE indexedWith #-} + +-- | Empty request +rempty :: R f +rempty = R mempty mempty mempty +{-# INLINE rempty #-} -- Miscellaneous instances diff --git a/src/Network/Lastfm/Library.hs b/src/Network/Lastfm/Library.hs --- a/src/Network/Lastfm/Library.hs +++ b/src/Network/Lastfm/Library.hs @@ -8,30 +8,51 @@ -- import qualified Network.Lastfm.Library as Library -- @ module Network.Lastfm.Library - ( addAlbum, addArtist, addTrack + ( addAlbum, albumItem, addArtist, artistItem, addTrack , getAlbums, getArtists, getTracks , removeAlbum, removeArtist, removeScrobble, removeTrack ) where import Control.Applicative +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as N +import Network.Lastfm.Internal (absorbQuery, indexedWith, wrap) import Network.Lastfm.Request + + -- | Add an album or collection of albums to a user's Last.fm library -- -- -addAlbum :: Request f (Artist -> Album -> APIKey -> SessionKey -> Sign) -addAlbum = api "library.addAlbum" <* post +addAlbum :: NonEmpty (Request f LibraryAlbum) -> Request f (APIKey -> SessionKey -> Sign) +addAlbum batch = api "library.addAlbum" <* items <* post + where + items = absorbQuery (N.zipWith indexedWith (N.fromList [0..]) batch) + {-# INLINE items #-} {-# INLINE addAlbum #-} +-- | What artist to add to library? +albumItem :: Request f (Artist -> Album -> LibraryAlbum) +albumItem = wrap id +{-# INLINE albumItem #-} + -- | Add an artist to a user's Last.fm library -- -- -addArtist :: Request f (Artist -> APIKey -> SessionKey -> Sign) -addArtist = api "library.addArtist" <* post +addArtist :: NonEmpty (Request f LibraryArtist) -> Request f (APIKey -> SessionKey -> Sign) +addArtist batch = api "library.addArtist" <* items <* post + where + items = absorbQuery (N.zipWith indexedWith (N.fromList [0..]) batch) + {-# INLINE items #-} {-# INLINE addArtist #-} + +-- | What album to add to library? +artistItem :: Request f (Artist -> LibraryArtist) +artistItem = wrap id +{-# INLINE artistItem #-} -- | Add a track to a user's Last.fm library diff --git a/src/Network/Lastfm/Request.hs b/src/Network/Lastfm/Request.hs --- a/src/Network/Lastfm/Request.hs +++ b/src/Network/Lastfm/Request.hs @@ -27,7 +27,7 @@ , TaggingType, taggingType, UseRecs, useRecs, Venue, venue, VenueName, venueName , Discovery, discovery, RTP, rtp, BuyLinks, buyLinks, Multiplier(..), multiplier , Bitrate(..), bitrate, Name, name, Station, station - , Targeted, comparison + , Targeted, comparison, Scrobble, LibraryAlbum, LibraryArtist ) where import Control.Applicative @@ -173,6 +173,7 @@ data TaggingType data RecentTracks data UseRecs +data Scrobble data Group data Venue data VenueName @@ -183,6 +184,8 @@ data Discovery data RTP data BuyLinks +data LibraryAlbum +data LibraryArtist -- | Add artist parameter @@ -190,12 +193,12 @@ artist = add "artist" {-# INLINE artist #-} --- | Add artist parameter +-- | Add artists parameter artists :: [Text] -> Request f [Artist] artists = add "artists" {-# INLINE artists #-} --- | Add artist parameter +-- | Add album parameter album :: Text -> Request f Album album = add "album" {-# INLINE album #-} diff --git a/src/Network/Lastfm/Track.hs b/src/Network/Lastfm/Track.hs --- a/src/Network/Lastfm/Track.hs +++ b/src/Network/Lastfm/Track.hs @@ -12,12 +12,15 @@ ( ArtistTrackOrMBID , addTags, ban, getBuyLinks, getCorrection, getFingerprintMetadata , getInfo, getShouts, getSimilar, getTags, getTopFans - , getTopTags, love, removeTag, scrobble + , getTopTags, love, removeTag, scrobble, item , search, share, unban, unlove, updateNowPlaying ) where -import Control.Applicative +import Control.Applicative +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as N +import Network.Lastfm.Internal (absorbQuery, indexedWith, wrap) import Network.Lastfm.Request @@ -149,15 +152,25 @@ {-# INLINE removeTag #-} --- | Used to add a track-play to a user's profile. +-- | Add played tracks to the user profile. -- --- Optional: 'album', 'albumArtist', 'chosenByUser', 'context', --- 'duration', 'mbid', 'streamId', 'trackNumber' +-- Scrobbles 50 first list elements -- -- -scrobble :: Request f (Artist -> Track -> Timestamp -> APIKey -> SessionKey -> Sign) -scrobble = api "track.scrobble" <* post +scrobble :: NonEmpty (Request f Scrobble) -> Request f (APIKey -> SessionKey -> Sign) +scrobble batch = api "track.scrobble" <* items <* post + where + items = absorbQuery (N.zipWith indexedWith (N.fromList [0..49]) batch) + {-# INLINE items #-} {-# INLINE scrobble #-} + +-- | What track to scrobble? +-- +-- Optional: 'album', 'albumArtist', 'chosenByUser', 'context', +-- 'duration', 'mbid', 'streamId', 'trackNumber' +item :: Request f (Artist -> Track -> Timestamp -> Scrobble) +item = wrap id +{-# INLINE item #-} -- | Search for a track by track name. Returns track matches sorted by relevance. diff --git a/tests/Album.hs b/tests/Album.hs deleted file mode 100644 --- a/tests/Album.hs +++ /dev/null @@ -1,90 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE UnicodeSyntax #-} -module Album (auth, noauth) where - -import Data.Aeson.Types -import Network.Lastfm -import Network.Lastfm.Album -import Test.Framework -import Test.Framework.Providers.HUnit - -import Common - - -auth ∷ Request JSON APIKey → Request JSON SessionKey → Secret → [Test] -auth ak sk s = - [ testCase "Album.addTags" testAddTags - , testCase "Album.getTags-authenticated" testGetTagsAuth - , testCase "Album.removeTag" testRemoveTag - , testCase "Album.share" testShare - ] - where - testAddTags = check ok . sign s $ - addTags <*> artist "Pink Floyd" <*> album "The Wall" <*> tags ["70s", "awesome", "classic"] - <*> ak <*> sk - - testGetTagsAuth = check gt . sign s $ - getTags <*> artist "Pink Floyd" <*> album "The Wall" - <*> ak <* sk - - testRemoveTag = check ok . sign s $ - removeTag <*> artist "Pink Floyd" <*> album "The Wall" <*> tag "awesome" - <*> ak <*> sk - - testShare = check ok . sign s $ - share <*> album "Jerusalem" <*> artist "Sleep" <*> recipient "liblastfm" <* message "Just listen!" - <*> ak <*> sk - - -noauth ∷ Request JSON APIKey → [Test] -noauth ak = - [ testCase "Album.getBuyLinks" testGetBuylinks - , testCase "Album.getBuyLinks_mbid" testGetBuylinks_mbid - , testCase "Album.getInfo" testGetInfo - , testCase "Album.getInfo_mbid" testGetInfo_mbid - , testCase "Album.getShouts" testGetShouts - , testCase "Album.getShouts_mbid" testGetShouts_mbid - , testCase "Album.getTags" testGetTags - , testCase "Album.getTags_mbid" testGetTags_mbid - , testCase "Album.getTopTags" testGetTopTags - , testCase "Album.getTopTags_mbid" testGetTopTags_mbid - , testCase "Album.search" testSearch - ] - where - testGetBuylinks = check gbl $ - getBuyLinks <*> country "United Kingdom" <*> artist "Pink Floyd" <*> album "The Wall" <*> ak - testGetBuylinks_mbid = check gbl $ - getBuyLinks <*> country "United Kingdom" <*> mbid "816abcd3-924a-3565-92b9-7ab750688f34" <*> ak - - testGetInfo = check gi $ - getInfo <*> artist "Pink Floyd" <*> album "The Wall" <*> ak - testGetInfo_mbid = check gi $ - getInfo <*> mbid "816abcd3-924a-3565-92b9-7ab750688f34" <*> ak - - testGetShouts = check gs $ - getShouts <*> artist "Pink Floyd" <*> album "The Wall" <* limit 7 <*> ak - testGetShouts_mbid = check gs $ - getShouts <*> mbid "816abcd3-924a-3565-92b9-7ab750688f34" <* limit 7 <*> ak - - testGetTags = check gt $ - getTags <*> artist "Pink Floyd" <*> album "The Wall" <* user "liblastfm" <*> ak - testGetTags_mbid = check gt $ - getTags <*> mbid "816abcd3-924a-3565-92b9-7ab750688f34" <* user "liblastfm" <*> ak - - testGetTopTags = check gtt $ - getTopTags <*> artist "Pink Floyd" <*> album "The Wall" <*> ak - testGetTopTags_mbid = check gtt $ - getTopTags <*> mbid "816abcd3-924a-3565-92b9-7ab750688f34" <*> ak - - testSearch = check se $ - search <*> album "wall" <* limit 5 <*> ak - - -gbl, gi, gs, gt, gtt, se ∷ Value → Parser [String] -gbl o = parseJSON o >>= (.: "affiliations") >>= (.: "physicals") >>= (.: "affiliation") >>= mapM (.: "supplierName") -gi o = parseJSON o >>= (.: "album") >>= (.: "toptags") >>= (.: "tag") >>= mapM (.: "name") -gs o = parseJSON o >>= (.: "shouts") >>= (.: "shout") >>= mapM (.: "body") -gt o = parseJSON o >>= (.: "tags") >>= (.: "tag") >>= mapM (.: "name") -gtt o = parseJSON o >>= (.: "toptags") >>= (.: "tag") >>= mapM (.: "count") -se o = parseJSON o >>= (.: "results") >>= (.: "albummatches") >>= (.: "album") >>= mapM (.: "name") diff --git a/tests/Artist.hs b/tests/Artist.hs deleted file mode 100644 --- a/tests/Artist.hs +++ /dev/null @@ -1,140 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE UnicodeSyntax #-} -module Artist (auth, noauth) where - -import Data.Aeson.Types -import Network.Lastfm -import Network.Lastfm.Artist -import Test.Framework -import Test.Framework.Providers.HUnit - -import Common - - -auth ∷ Request JSON APIKey → Request JSON SessionKey → Secret → [Test] -auth ak sk s = -  [ testCase "Artist.addTags" testAddTags -  , testCase "Artist.getTags-authenticated" testGetTagsAuth -  , testCase "Artist.removeTag" testRemoveTag -  , testCase "Artist.share" testShare -  ] - where -  testAddTags = check ok . sign s $ -    addTags <*> artist "Егор Летов" <*> tags ["russian", "black metal"] <*> ak <*> sk - -  testGetTagsAuth = check gt . sign s $ -    getTags <*> artist "Егор Летов" <*> ak <* sk - -  testRemoveTag = check ok . sign s $ - removeTag <*> artist "Егор Летов" <*> tag "russian" <*> ak <*> sk - -  testShare = check ok . sign s $ - share <*> artist "Sleep" <*> recipient "liblastfm" <* message "Just listen!" <*> ak <*> sk - - -noauth ∷ Request JSON APIKey → [Test] -noauth ak = -  [ testCase "Artist.getCorrection" testGetCorrection -  , testCase "Artist.getEvents" testGetEvents -  , testCase "Artist.getEvents_mbid" testGetEvents_mbid -  , testCase "Artist.getInfo" testGetInfo -  , testCase "Artist.getInfo_mbid" testGetInfo_mbid -  , testCase "Artist.getPastEvents" testGetPastEvents -  , testCase "Artist.getPastEvents_mbid" testGetPastEvents_mbid -  , testCase "Artist.getPodcast" testGetPodcast -  , testCase "Artist.getPodcast_mbid" testGetPodcast_mbid -  , testCase "Artist.getShouts" testGetShouts -  , testCase "Artist.getShouts_mbid" testGetShouts_mbid -  , testCase "Artist.getSimilar" testGetSimilar -  , testCase "Artist.getSimilar_mbid" testGetSimilar_mbid -  , testCase "Artist.getTags" testGetTags -  , testCase "Artist.getTags_mbid" testGetTags_mbid -  , testCase "Artist.getTopAlbums" testGetTopAlbums -  , testCase "Artist.getTopAlbums_mbid" testGetTopAlbums_mbid -  , testCase "Artist.getTopFans" testGetTopFans -  , testCase "Artist.getTopFans_mbid" testGetTopFans_mbid -  , testCase "Artist.getTopTags" testGetTopTags -  , testCase "Artist.getTopTags_mbid" testGetTopTags_mbid -  , testCase "Artist.getTopTracks" testGetTopTracks -  , testCase "Artist.getTopTracks_mbid" testGetTopTracks_mbid -  , testCase "Artist.search" testSearch -  ] - where -  testGetCorrection = check gc $ -    getCorrection <*> artist "Meshugah" <*> ak - -  testGetEvents = check ge $ -    getEvents <*> artist "Meshuggah" <* limit 2 <*> ak -  testGetEvents_mbid = check ge $ -    getEvents <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <* limit 2 <*> ak - -  testGetInfo = check gin $ -    getInfo <*> artist "Meshuggah" <*> ak -  testGetInfo_mbid = check gin $ -    getInfo <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <*> ak - -  testGetPastEvents = check gpe $ - getPastEvents <*> artist "Meshuggah" <* autocorrect True <*> ak -  testGetPastEvents_mbid = check gpe $ - getPastEvents <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <* autocorrect True <*> ak - -  testGetPodcast = check gp $ -    getPodcast <*> artist "Meshuggah" <*> ak -  testGetPodcast_mbid = check gp $ -    getPodcast <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <*> ak - -  testGetShouts = check gs $ -    getShouts <*> artist "Meshuggah" <* limit 5 <*> ak -  testGetShouts_mbid = check gs $ -    getShouts <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <* limit 5 <*> ak - -  testGetSimilar = check gsi $ -    getSimilar <*> artist "Meshuggah" <* limit 3 <*> ak -  testGetSimilar_mbid = check gsi $ -    getSimilar <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <* limit 3 <*> ak - -  testGetTags = check gt $ -    getTags <*> artist "Егор Летов" <* user "liblastfm" <*> ak -  testGetTags_mbid = check gt $ -    getTags <*> mbid "cfb3d32e-d095-4d63-946d-9daf06932180" <* user "liblastfm" <*> ak - -  testGetTopAlbums = check gta $ -    getTopAlbums <*> artist "Meshuggah" <* limit 3 <*> ak -  testGetTopAlbums_mbid = check gta $ -    getTopAlbums <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <* limit 3 <*> ak - -  testGetTopFans = check gtf $ -    getTopFans <*> artist "Meshuggah" <*> ak -  testGetTopFans_mbid = check gtf $ -    getTopFans <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <*> ak - -  testGetTopTags = check gtt $ -    getTopTags <*> artist "Meshuggah" <*> ak -  testGetTopTags_mbid = check gtt $ -    getTopTags <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <*> ak - -  testGetTopTracks = check gttr $ -    getTopTracks <*> artist "Meshuggah" <* limit 3 <*> ak -  testGetTopTracks_mbid = check gttr $ -    getTopTracks <*> mbid "cf8b3b8c-118e-4136-8d1d-c37091173413" <* limit 3 <*> ak - -  testSearch = check se $ - search <*> artist "Mesh" <* limit 3 <*> ak - - -gc, gin, gp ∷ Value → Parser String -ge, gpe, gs, gsi, gt, gta, gtf, gtt, gttr, se ∷ Value → Parser [String] -gc o = parseJSON o >>= (.: "corrections") >>= (.: "correction") >>= (.: "artist") >>= (.: "name") -ge o = parseJSON o >>= (.: "events") >>= (.: "event") >>= mapM (\o' → (o' .: "venue") >>= (.: "name")) -gin o = parseJSON o >>= (.: "artist") >>= (.: "stats") >>= (.: "listeners") -gp o = parseJSON o >>= (.: "rss") >>= (.: "channel") >>= (.: "description") -gpe o = parseJSON o >>= (.: "events") >>= (.: "event") >>= mapM (.: "title") -gs o = parseJSON o >>= (.: "shouts") >>= (.: "shout") >>= mapM (.: "author") -gsi o = parseJSON o >>= (.: "similarartists") >>= (.: "artist") >>= mapM (.: "name") -gt o = parseJSON o >>= (.: "tags") >>= (.: "tag") >>= mapM (.: "name") -gta o = parseJSON o >>= (.: "topalbums") >>= (.: "album") >>= mapM (.: "name") -gtf o = parseJSON o >>= (.: "topfans") >>= (.: "user") >>= mapM (.: "name") -gtt o = parseJSON o >>= (.: "toptags") >>= (.: "tag") >>= mapM (.: "name") -gttr o = parseJSON o >>= (.: "toptracks") >>= (.: "track") >>= mapM (.: "name") -se o = parseJSON o >>= (.: "results") >>= (.: "artistmatches") >>= (.: "artist") >>= mapM (.: "name") diff --git a/tests/Chart.hs b/tests/Chart.hs deleted file mode 100644 --- a/tests/Chart.hs +++ /dev/null @@ -1,47 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE UnicodeSyntax #-} -module Chart (noauth) where - -import Data.Aeson.Types -import Network.Lastfm -import Network.Lastfm.Chart -import Test.Framework -import Test.Framework.Providers.HUnit - -import Common - - -noauth ∷ Request JSON APIKey → [Test] -noauth ak = - [ testCase "Chart.getHypedArtists" testGetHypedArtists - , testCase "Chart.getHypedTracks" testGetHypedTracks - , testCase "Chart.getLovedTracks" testGetLovedTracks - , testCase "Chart.getTopArtists" testGetTopArtists - , testCase "Chart.getTopTags" testGetTopTags - , testCase "Chart.getTopTracks" testGetTopTracks - ] - where - testGetHypedArtists = check ga $ - getHypedArtists <* limit 3 <*> ak - - testGetHypedTracks = check gt $ - getHypedTracks <* limit 2 <*> ak - - testGetLovedTracks = check gt $ - getLovedTracks <* limit 3 <*> ak - - testGetTopArtists = check ga $ - getTopArtists <* limit 4 <*> ak - - testGetTopTags = check gta $ - getTopTags <* limit 5 <*> ak - - testGetTopTracks = check gt $ - getTopTracks <* limit 2 <*> ak - - -ga, gt, gta ∷ Value → Parser [String] -ga o = parseJSON o >>= (.: "artists") >>= (.: "artist") >>= mapM (.: "name") -gt o = parseJSON o >>= (.: "tracks") >>= (.: "track") >>= mapM (.: "name") -gta o = parseJSON o >>= (.: "tags") >>= (.: "tag") >>= mapM (.: "name") diff --git a/tests/Common.hs b/tests/Common.hs deleted file mode 100644 --- a/tests/Common.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE UnicodeSyntax #-} -module Common where - -import Data.Aeson.Types -import Network.Lastfm -import Test.HUnit - - -check ∷ (Value → Parser a) → Request JSON Ready → Assertion -check p q = do - r ← lastfm q - case parse p `fmap` r of - Just (Success _) → assertBool "success" True - _ → assertFailure $ "Got: " ++ show r - - -ok ∷ Value → Parser String -ok o = parseJSON o >>= (.: "status") diff --git a/tests/Event.hs b/tests/Event.hs deleted file mode 100644 --- a/tests/Event.hs +++ /dev/null @@ -1,49 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE UnicodeSyntax #-} -module Event (auth, noauth) where - -import Data.Aeson.Types -import Network.Lastfm -import Network.Lastfm.Event -import Test.Framework -import Test.Framework.Providers.HUnit - -import Common - - -auth ∷ Request JSON APIKey → Request JSON SessionKey → Secret → [Test] -auth ak sk s = - [ testCase "Event.attend" testAttend - , testCase "Event.share" testShare - ] - where - testAttend = check ok . sign s $ - attend <*> event 3142549 <*> status Attending <*> ak <*> sk - - testShare = check ok . sign s $ - share <*> event 3142549 <*> recipient "liblastfm" <* message "Just listen!" <*> ak <*> sk - - -noauth ∷ Request JSON APIKey → [Test] -noauth ak = - [ testCase "Event.getAttendees" testGetAttendees - , testCase "Event.getInfo" testGetInfo - , testCase "Event.getShouts" testGetShouts - ] - where - testGetAttendees = check ga $ - getAttendees <*> event 3142549 <* limit 2 <*> ak - - testGetInfo = check gi $ - getInfo <*> event 3142549 <*> ak - - testGetShouts = check gs $ - getShouts <*> event 3142549 <* limit 1 <*> ak - - -gi, gs ∷ Value → Parser String -ga ∷ Value → Parser [String] -ga o = parseJSON o >>= (.: "attendees") >>= (.: "user") >>= mapM (.: "name") -gi o = parseJSON o >>= (.: "event") >>= (.: "venue") >>= (.: "location") >>= (.: "city") -gs o = parseJSON o >>= (.: "shouts") >>= (.: "shout") >>= (.: "body") diff --git a/tests/Geo.hs b/tests/Geo.hs deleted file mode 100644 --- a/tests/Geo.hs +++ /dev/null @@ -1,70 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE UnicodeSyntax #-} -module Geo (noauth) where - -import Data.Aeson.Types -import Network.Lastfm -import Network.Lastfm.Geo -import Test.Framework -import Test.Framework.Providers.HUnit - -import Common - - -noauth ∷ Request JSON APIKey → [Test] -noauth ak = - [ testCase "Geo.getEvents" testGetEvents - , testCase "Geo.getMetroArtistChart" testGetMetroArtistChart - , testCase "Geo.getMetroHypeArtistChart" testGetMetroHypeArtistChart - , testCase "Geo.getMetroHypeTrackChart" testGetMetroHypeTrackChart - , testCase "Geo.getMetroTrackChart" testGetMetroTrackChart - , testCase "Geo.getMetroUniqueArtistChart" testGetMetroUniqueArtistChart - , testCase "Geo.getMetroUniqueTrackChart" testGetMetroUniqueTrackChart - , testCase "Geo.getMetroWeeklyChartlist" testGetMetroWeeklyChartlist - , testCase "Geo.getMetros" testGetMetros - , testCase "Geo.getTopArtists" testGetTopArtists - , testCase "Geo.getTopTracks" testGetTopTracks - ] - where - testGetEvents = check ge $ - getEvents <* location "Moscow" <* limit 5 <*> ak - - testGetMetroArtistChart = check ga $ - getMetroArtistChart <*> metro "Saint Petersburg" <*> country "Russia" <*> ak - - testGetMetroHypeArtistChart = check ga $ - getMetroHypeArtistChart <*> metro "New York" <*> country "United States" <*> ak - - testGetMetroHypeTrackChart = check gt $ - getMetroHypeTrackChart <*> metro "Moscow" <*> country "Russia" <*> ak - - testGetMetroTrackChart = check gt $ - getMetroTrackChart <*> metro "Boston" <*> country "United States" <*> ak - - testGetMetroUniqueArtistChart = check ga $ - getMetroUniqueArtistChart <*> metro "Minsk" <*> country "Belarus" <*> ak - - testGetMetroUniqueTrackChart = check gt $ - getMetroUniqueTrackChart <*> metro "Moscow" <*> country "Russia" <*> ak - - testGetMetroWeeklyChartlist = check gc $ - getMetroWeeklyChartlist <*> metro "Moscow" <*> ak - - testGetMetros = check gm $ - getMetros <* country "Russia" <*> ak - - testGetTopArtists = check ga $ - getTopArtists <*> country "Belarus" <* limit 3 <*> ak - - testGetTopTracks = check gt $ - getTopTracks <*> country "Ukraine" <* limit 2 <*> ak - - -ga, ge, gm, gt ∷ Value → Parser [String] -gc ∷ Value → Parser [(String, String)] -ga o = parseJSON o >>= (.: "topartists") >>= (.: "artist") >>= mapM (.: "name") -gc o = parseJSON o >>= (.: "weeklychartlist") >>= (.: "chart") >>= mapM (\t → (,) <$> (t .: "from") <*> (t .: "to")) -ge o = parseJSON o >>= (.: "events") >>= (.: "event") >>= mapM (.: "id") -gm o = parseJSON o >>= (.: "metros") >>= (.: "metro") >>= mapM (.: "name") -gt o = parseJSON o >>= (.: "toptracks") >>= (.: "track") >>= mapM (.: "name") diff --git a/tests/Group.hs b/tests/Group.hs deleted file mode 100644 --- a/tests/Group.hs +++ /dev/null @@ -1,53 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE UnicodeSyntax #-} -module Group (noauth) where - -import Data.Aeson.Types -import Network.Lastfm -import Network.Lastfm.Group -import Test.Framework -import Test.Framework.Providers.HUnit - -import Common - - -noauth ∷ Request JSON APIKey → [Test] -noauth ak = - [ testCase "Group.getHype" testGetHype - , testCase "Group.getMembers" testGetMembers - , testCase "Group.getWeeklyAlbumChart" testGetWeeklyAlbumChart - , testCase "Group.getWeeklyArtistChart" testGetWeeklyArtistChart - , testCase "Group.getWeeklyChartList" testGetWeeklyChartList - , testCase "Group.getWeeklyTrackChart" testGetWeeklyTrackChart - ] - where - g = "People with no social lives that listen to more music than is healthy who are slightly scared of spiders and can never seem to find a pen" - - testGetHype = check gh $ - getHype <*> group g <*> ak - - testGetMembers = check gm $ - getMembers <*> group g <* limit 10 <*> ak - - testGetWeeklyAlbumChart = check ga $ - getWeeklyAlbumChart <*> group g <*> ak - - testGetWeeklyArtistChart = check gar $ - getWeeklyArtistChart <*> group g <*> ak - - testGetWeeklyChartList = check gc $ - getWeeklyChartList <*> group g <*> ak - - testGetWeeklyTrackChart = check gt $ - getWeeklyTrackChart <*> group g <*> ak - - -ga, gar, gh, gm, gt ∷ Value → Parser [String] -gc ∷ Value → Parser [(String, String)] -ga o = parseJSON o >>= (.: "weeklyalbumchart") >>= (.: "album") >>= mapM (.: "playcount") -gar o = parseJSON o >>= (.: "weeklyartistchart") >>= (.: "artist") >>= mapM (.: "name") -gc o = parseJSON o >>= (.: "weeklychartlist") >>= (.: "chart") >>= mapM (\t → (,) <$> (t .: "from") <*> (t .: "to")) -gh o = parseJSON o >>= (.: "weeklyartistchart") >>= (.: "artist") >>= mapM (.: "mbid") -gm o = parseJSON o >>= (.: "members") >>= (.: "user") >>= mapM (.: "name") -gt o = parseJSON o >>= (.: "weeklytrackchart") >>= (.: "track") >>= mapM (.: "url") diff --git a/tests/Library.hs b/tests/Library.hs deleted file mode 100644 --- a/tests/Library.hs +++ /dev/null @@ -1,68 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE UnicodeSyntax #-} -module Library (auth, noauth) where - -import Data.Aeson.Types -import Network.Lastfm -import Network.Lastfm.Library -import Test.Framework -import Test.Framework.Providers.HUnit - -import Common - - -auth ∷ Request JSON APIKey → Request JSON SessionKey → Secret → [Test] -auth ak sk s = - [ testCase "Library.addAlbum" testAddAlbum - , testCase "Library.addArtist" testAddArtist - , testCase "Library.addTrack" testAddTrack - , testCase "Library.removeAlbum" testRemoveAlbum - , testCase "Library.removeArtist" testRemoveArtist - , testCase "Library.removeTrack" testRemoveTrack - , testCase "Library.removeScrobble" testRemoveScrobble - ] - where - testAddAlbum = check ok . sign s $ - addAlbum <*> artist "Franz Ferdinand" <*> album "Franz Ferdinand" <*> ak <*> sk - - testAddArtist = check ok . sign s $ - addArtist <*> artist "Mobthrow" <*> ak <*> sk - - testAddTrack = check ok . sign s $ - addTrack <*> artist "Eminem" <*> track "Kim" <*> ak <*> sk - - testRemoveAlbum = check ok . sign s $ - removeAlbum <*> artist "Franz Ferdinand" <*> album "Franz Ferdinand" <*> ak <*> sk - - testRemoveArtist = check ok . sign s $ - removeArtist <*> artist "Burzum" <*> ak <*> sk - - testRemoveTrack = check ok . sign s $ - removeTrack <*> artist "Eminem" <*> track "Kim" <*> ak <*> sk - - testRemoveScrobble = check ok . sign s $ - removeScrobble <*> artist "Gojira" <*> track "Ocean" <*> timestamp 1328905590 <*> ak <*> sk - - -noauth ∷ Request JSON APIKey → [Test] -noauth ak = - [ testCase "Library.getAlbums" testGetAlbums - , testCase "Library.getArtists" testGetArtists - , testCase "Library.getTracks" testGetTracks - ] - where - testGetAlbums = check ga $ - getAlbums <*> user "smpcln" <* artist "Burzum" <* limit 5 <*> ak - - testGetArtists = check gar $ - getArtists <*> user "smpcln" <* limit 7 <*> ak - - testGetTracks = check gt $ - getTracks <*> user "smpcln" <* artist "Burzum" <* limit 4 <*> ak - - -ga, gar, gt ∷ Value → Parser [String] -ga o = parseJSON o >>= (.: "albums") >>= (.: "album") >>= mapM (.: "name") -gar o = parseJSON o >>= (.: "artists") >>= (.: "artist") >>= mapM (.: "name") -gt o = parseJSON o >>= (.: "tracks") >>= (.: "track") >>= mapM (.: "name") diff --git a/tests/Playlist.hs b/tests/Playlist.hs deleted file mode 100644 --- a/tests/Playlist.hs +++ /dev/null @@ -1,39 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE UnicodeSyntax #-} -module Playlist (auth) where - -import Data.Aeson.Types -import Network.Lastfm -import Network.Lastfm.Playlist -import Network.Lastfm.User -import Test.Framework -import Test.Framework.Providers.HUnit - -import Common - - -auth ∷ Request JSON APIKey → Request JSON SessionKey → Secret → [Test] -auth ak sk s = - [ testCase "Playlist.create" testCreate -- Order matters. - , testCase "Playlist.addTrack" testAddTrack - ] - where - ak' = "29effec263316a1f8a97f753caaa83e0" - - testAddTrack = - do r ← lastfm $ getPlaylists <*> user "liblastfm" <*> apiKey ak' <* json - case parseMaybe pl =<< r of - Nothing → error "M" - Just r' → let pid = read $ head r' in check ok . sign s $ - addTrack <*> playlist pid <*> artist "Ruby my dear" <*> track "Chazz" <*> ak <*> sk - - testCreate = check pn . sign s $ - create <* title "Awesome playlist" <*> ak <*> sk - - -pl ∷ Value → Parser [String] -pl o = parseJSON o >>= (.: "playlists") >>= (.: "playlist") >>= mapM (.: "id") - -pn ∷ Value → Parser String -pn o = parseJSON o >>= (.: "playlists") >>= (.: "playlist") >>= (.: "title") diff --git a/tests/Tag.hs b/tests/Tag.hs deleted file mode 100644 --- a/tests/Tag.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE UnicodeSyntax #-} -module Tag (noauth) where - -import Data.Aeson.Types -import Network.Lastfm -import Network.Lastfm.Tag -import Test.Framework -import Test.Framework.Providers.HUnit - -import Common - - -noauth ∷ Request JSON APIKey → [Test] -noauth ak = - [ testCase "Tag.getInfo" testGetInfo - , testCase "Tag.getSimilar" testGetSimilar - , testCase "Tag.getTopAlbums" testGetTopAlbums - , testCase "Tag.getTopArtists" testGetTopArtists - , testCase "Tag.getTopTags" testGetTopTags - , testCase "Tag.getTopTracks" testGetTopTracks - , testCase "Tag.getWeeklyArtistChart" testGetWeeklyArtistChart - , testCase "Tag.getWeeklyChartList" testGetWeeklyChartList - , testCase "Tag.search" testSearch - ] - where - testGetInfo = check gi $ - getInfo <*> tag "depressive" <*> ak - - testGetSimilar = check gs $ - getSimilar <*> tag "depressive" <*> ak - - testGetTopAlbums = check gta $ - getTopAlbums <*> tag "depressive" <* limit 2 <*> ak - - testGetTopArtists = check gtar $ - getTopArtists <*> tag "depressive" <* limit 3 <*> ak - - testGetTopTags = check gtt $ - getTopTags <*> ak - - testGetTopTracks = check gttr $ - getTopTracks <*> tag "depressive" <* limit 2 <*> ak - - testGetWeeklyArtistChart = check gwac $ - getWeeklyArtistChart <*> tag "depressive" <* limit 3 <*> ak - - testGetWeeklyChartList = check gc $ - getWeeklyChartList <*> tag "depressive" <*> ak - - testSearch = check se $ - search <*> tag "depressive" <* limit 3 <*> ak - - -gi ∷ Value → Parser String -gs, gta, gtar, gtt, gttr, gwac, se ∷ Value → Parser [String] -gc ∷ Value → Parser [(String, String)] -gi o = parseJSON o >>= (.: "tag") >>= (.: "taggings") -gc o = parseJSON o >>= (.: "weeklychartlist") >>= (.: "chart") >>= mapM (\t → (,) <$> (t .: "from") <*> (t .: "to")) -gs o = parseJSON o >>= (.: "similartags") >>= (.: "tag") >>= mapM (.: "name") -gta o = parseJSON o >>= (.: "topalbums") >>= (.: "album") >>= mapM (.: "url") -gtar o = parseJSON o >>= (.: "topartists") >>= (.: "artist") >>= mapM (.: "url") -gtt o = parseJSON o >>= (.: "toptags") >>= (.: "tag") >>= mapM (.: "name") -gttr o = parseJSON o >>= (.: "toptracks") >>= (.: "track") >>= mapM (.: "url") -gwac o = parseJSON o >>= (.: "weeklyartistchart") >>= (.: "artist") >>= mapM (.: "name") -se o = parseJSON o >>= (.: "results") >>= (.: "tagmatches") >>= (.: "tag") >>= mapM (.: "name") diff --git a/tests/Tasteometer.hs b/tests/Tasteometer.hs deleted file mode 100644 --- a/tests/Tasteometer.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE UnicodeSyntax #-} -module Tasteometer (noauth) where - -import Data.Aeson.Types -import Network.Lastfm -import qualified Network.Lastfm.Tasteometer as T -import Test.Framework -import Test.Framework.Providers.HUnit - -import Common - - -noauth ∷ Request JSON APIKey → [Test] -noauth ak = - [ testCase "Tasteometer.compare" testCompare - , testCase "Tasteometer.compare'" testCompare' - , testCase "Tasteometer.compare''" testCompare'' - , testCase "Tasteometer.compare'''" testCompare''' - ] - where - testCompare = check cs $ - T.compare (user "smpcln") (user "MCDOOMDESTROYER") <*> ak - testCompare' = check cs $ - T.compare (user "smpcln") (artists ["enduser", "venetian snares"]) <*> ak - testCompare'' = check cs $ - T.compare (artists ["enduser", "venetian snares"]) (user "smpcln") <*> ak - testCompare''' = check cs $ - T.compare (artists ["enduser", "venetian snares"]) (artists ["enduser", "venetian snares"]) <*> ak - - -cs ∷ Value → Parser String -cs o = parseJSON o >>= (.: "comparison") >>= (.: "result") >>= (.: "score") diff --git a/tests/Track.hs b/tests/Track.hs deleted file mode 100644 --- a/tests/Track.hs +++ /dev/null @@ -1,132 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE UnicodeSyntax #-} -module Track (auth, noauth) where - -import Data.Aeson.Types -import Network.Lastfm -import Network.Lastfm.Track -import Test.Framework -import Test.Framework.Providers.HUnit - -import Common - - -auth ∷ Request JSON APIKey → Request JSON SessionKey → Secret → [Test] -auth ak sk s = - [ testCase "Track.addTags" testAddTags - , testCase "Track.ban" testBan - , testCase "Track.love" testLove - , testCase "Track.removeTag" testRemoveTag - , testCase "Track.share" testShare - , testCase "Track.unban" testUnban - , testCase "Track.unlove" testUnlove - , testCase "Track.scrobble" testScrobble - , testCase "Track.updateNowPlaying" testUpdateNowPlaying - ] - where - testAddTags = check ok . sign s $ - addTags <*> artist "Jefferson Airplane" <*> track "White rabbit" <*> tags ["60s", "awesome"] <*> ak <*> sk - - testBan = check ok . sign s $ - ban <*> artist "Eminem" <*> track "Kim" <*> ak <*> sk - - testLove = check ok . sign s $ - love <*> artist "Gojira" <*> track "Ocean" <*> ak <*> sk - - testRemoveTag = check ok . sign s $ - removeTag <*> artist "Jefferson Airplane" <*> track "White rabbit" <*> tag "awesome" <*> ak <*> sk - - testShare = check ok . sign s $ - share <*> artist "Led Zeppelin" <*> track "When the Levee Breaks" <*> recipient "liblastfm" <* message "Just listen!" <*> ak <*> sk - - testUnban = check ok . sign s $ - unban <*> artist "Eminem" <*> track "Kim" <*> ak <*> sk - - testUnlove = check ok . sign s $ - unlove <*> artist "Gojira" <*> track "Ocean" <*> ak <*> sk - - testScrobble = check ss . sign s $ - scrobble <*> artist "Gojira" <*> track "Ocean" <*> timestamp 1300000000 <*> ak <*> sk - - testUpdateNowPlaying = check np . sign s $ - updateNowPlaying <*> artist "Gojira" <*> track "Ocean" <*> ak <*> sk - - -noauth ∷ Request JSON APIKey → [Test] -noauth ak = - [ testCase "Track.getBuylinks" testGetBuylinks - , testCase "Track.getCorrection" testGetCorrection - , testCase "Track.getFingerprintMetadata" testGetFingerprintMetadata - , testCase "Track.getInfo" testGetInfo - , testCase "Track.getInfo_mbid" testGetInfo_mbid - , testCase "Track.getShouts" testGetShouts - , testCase "Track.getShouts_mbid" testGetShouts_mbid - , testCase "Track.getSimilar" testGetSimilar - , testCase "Track.getSimilar_mbid" testGetSimilar_mbid - , testCase "Track.getTags" testGetTags - , testCase "Track.getTags_mbid" testGetTags_mbid - , testCase "Track.getTopFans" testGetTopFans - , testCase "Track.getTopFans_mbid" testGetTopFans_mbid - , testCase "Track.getTopTags" testGetTopTags - , testCase "Track.getTopTags_mbid" testGetTopTags_mbid - , testCase "Track.search" testSearch - ] - where - testGetBuylinks = check gbl $ - getBuyLinks <*> country "United Kingdom" <*> artist "Pink Floyd" <*> track "Brain Damage" <*> ak - - testGetCorrection = check gc $ - getCorrection <*> artist "Pink Ployd" <*> track "Brain Damage" <*> ak - - testGetFingerprintMetadata = check gfm $ - getFingerprintMetadata <*> fingerprint 1234 <*> ak - - testGetInfo = check gi $ - getInfo <*> artist "Pink Floyd" <*> track "Comfortably Numb" <* username "aswalrus" <*> ak - testGetInfo_mbid = check gi $ - getInfo <*> mbid "52d7c9ff-6ae4-48a6-acec-4c1a486f8c92" <* username "aswalrus" <*> ak - - testGetShouts = check gsh $ - getShouts <*> artist "Pink Floyd" <*> track "Comfortably Numb" <* limit 7 <*> ak - testGetShouts_mbid = check gsh $ - getShouts <*> mbid "52d7c9ff-6ae4-48a6-acec-4c1a486f8c92" <* limit 7 <*> ak - - testGetSimilar = check gsi $ - getSimilar <*> artist "Pink Floyd" <*> track "Comfortably Numb" <* limit 4 <*> ak - testGetSimilar_mbid = check gsi $ - getSimilar <*> mbid "52d7c9ff-6ae4-48a6-acec-4c1a486f8c92" <* limit 4 <*> ak - - testGetTags = check gt $ - getTags <*> artist "Jefferson Airplane" <*> track "White Rabbit" <* user "liblastfm" <*> ak - testGetTags_mbid = check gt $ - getTags <*> mbid "001b3337-faf4-421a-a11f-45e0b60a7703" <* user "liblastfm" <*> ak - - testGetTopFans = check gtf $ - getTopFans <*> artist "Pink Floyd" <*> track "Comfortably Numb" <*> ak - testGetTopFans_mbid = check gtf $ - getTopFans <*> mbid "52d7c9ff-6ae4-48a6-acec-4c1a486f8c92" <*> ak - - testGetTopTags = check gtt $ - getTopTags <*> artist "Pink Floyd" <*> track "Comfortably Numb" <*> ak - testGetTopTags_mbid = check gtt $ - getTopTags <*> mbid "52d7c9ff-6ae4-48a6-acec-4c1a486f8c92" <*> ak - - testSearch = check s' $ - search <*> track "Believe" <* limit 12 <*> ak - - -gc, gi, gt, ss, np ∷ Value → Parser String -gbl, gfm, gsh, gsi{-, gta-}, gtf, gtt, s' ∷ Value → Parser [String] -gbl o = parseJSON o >>= (.: "affiliations") >>= (.: "downloads") >>= (.: "affiliation") >>= mapM (.: "supplierName") -gc o = parseJSON o >>= (.: "corrections") >>= (.: "correction") >>= (.: "track") >>= (.: "artist") >>= (.: "name") -gfm o = parseJSON o >>= (.: "tracks") >>= (.: "track") >>= mapM (.: "name") -gi o = parseJSON o >>= (.: "track") >>= (.: "userplaycount") -gsh o = parseJSON o >>= (.: "shouts") >>= (.: "shout") >>= mapM (.: "author") -gsi o = parseJSON o >>= (.: "similartracks") >>= (.: "track") >>= mapM (.: "name") -gt o = parseJSON o >>= (.: "tags") >>= (.: "@attr") >>= (.: "track") -gtf o = parseJSON o >>= (.: "topfans") >>= (.: "user") >>= mapM (.: "name") -gtt o = parseJSON o >>= (.: "toptags") >>= (.: "tag") >>= mapM (.: "name") -s' o = parseJSON o >>= (.: "results") >>= (.: "trackmatches") >>= (.: "track") >>= mapM (.: "name") -ss o = parseJSON o >>= (.: "scrobbles") >>= (.: "scrobble") >>= (.: "track") >>= (.: "#text") -np o = parseJSON o >>= (.: "nowplaying") >>= (.: "track") >>= (.: "#text") diff --git a/tests/User.hs b/tests/User.hs deleted file mode 100644 --- a/tests/User.hs +++ /dev/null @@ -1,152 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE UnicodeSyntax #-} -module User (auth, noauth) where - -import Data.Aeson.Types -import Network.Lastfm -import Network.Lastfm.User -import Test.Framework -import Test.Framework.Providers.HUnit - -import Common - - -auth ∷ Request JSON APIKey → Request JSON SessionKey → Secret → [Test] -auth ak sk s = - [ testCase "User.getRecentStations" testGetRecentStations - , testCase "User.getRecommendedArtists" testGetRecommendedArtists - , testCase "User.getRecommendedEvents" testGetRecommendedEvents - , testCase "User.shout" testShout - ] - where - testGetRecentStations = check grs . sign s $ - getRecentStations <*> user "liblastfm" <* limit 10 <*> ak <*> sk - - testGetRecommendedArtists = check gra . sign s $ - getRecommendedArtists <* limit 10 <*> ak <*> sk - - testGetRecommendedEvents = check gre . sign s $ - getRecommendedEvents <* limit 10 <*> ak <*> sk - - testShout = check ok . sign s $ - shout <*> user "liblastfm" <*> message "test message" <*> ak <*> sk - - -noauth ∷ Request JSON APIKey → [Test] -noauth ak = - [ testCase "User.getArtistTracks" testGetArtistTracks - , testCase "User.getBannedTracks" testGetBannedTracks - , testCase "User.getEvents" testGetEvents - , testCase "User.getFriends" testGetFriends - , testCase "User.getPlayCount" testGetPlayCount - , testCase "User.getGetLovedTracks" testGetLovedTracks - , testCase "User.getNeighbours" testGetNeighbours - , testCase "User.getNewReleases" testGetNewReleases - , testCase "User.getPastEvents" testGetPastEvents - , testCase "User.getPersonalTags" testGetPersonalTags - , testCase "User.getPlaylists" testGetPlaylists - , testCase "User.getRecentTracks" testGetRecentTracks - , testCase "User.getShouts" testGetShouts - , testCase "User.getTopAlbums" testGetTopAlbums - , testCase "User.getTopArtists" testGetTopArtists - , testCase "User.getTopTags" testGetTopTags - , testCase "User.getTopTracks" testGetTopTracks - , testCase "User.getWeeklyAlbumChart" testGetWeeklyAlbumChart - , testCase "User.getWeeklyArtistChart" testGetWeeklyArtistChart - , testCase "User.getWeeklyChartList" testGetWeeklyChartList - , testCase "User.getWeeklyTrackChart" testGetWeeklyTrackChart - ] - where - testGetArtistTracks = check gat $ - getArtistTracks <*> user "smpcln" <*> artist "Dvar" <*> ak - - testGetBannedTracks = check gbt $ - getBannedTracks <*> user "smpcln" <* limit 10 <*> ak - - testGetEvents = check ge $ - getEvents <*> user "chansonnier" <* limit 5 <*> ak - - testGetFriends = check gf $ - getFriends <*> user "smpcln" <* limit 10 <*> ak - - testGetPlayCount = check gpc $ - getInfo <*> user "smpcln" <*> ak - - testGetLovedTracks = check glt $ - getLovedTracks <*> user "smpcln" <* limit 10 <*> ak - - testGetNeighbours = check gn $ - getNeighbours <*> user "smpcln" <* limit 10 <*> ak - - testGetNewReleases = check gnr $ - getNewReleases <*> user "rj" <*> ak - - testGetPastEvents = check gpe $ - getPastEvents <*> user "mokele" <* limit 5 <*> ak - - testGetPersonalTags = check gpt $ - getPersonalTags <*> user "crackedcore" <*> tag "rhythmic noise" <*> taggingType "artist" <* limit 10 <*> ak - - testGetPlaylists = check gp $ - getPlaylists <*> user "mokele" <*> ak - - testGetRecentTracks = check grt $ - getRecentTracks <*> user "smpcln" <* limit 10 <*> ak - - testGetShouts = check gs $ - getShouts <*> user "smpcln" <* limit 2 <*> ak - - testGetTopAlbums = check gtal $ - getTopAlbums <*> user "smpcln" <* limit 5 <*> ak - - testGetTopArtists = check gtar $ - getTopArtists <*> user "smpcln" <* limit 5 <*> ak - - testGetTopTags = check gtta $ - getTopTags <*> user "smpcln" <* limit 10 <*> ak - - testGetTopTracks = check gttr $ - getTopTracks <*> user "smpcln" <* limit 10 <*> ak - - testGetWeeklyAlbumChart = check gwalc $ - getWeeklyAlbumChart <*> user "smpcln" <*> ak - - testGetWeeklyArtistChart = check gwarc $ - getWeeklyArtistChart <*> user "smpcln" <*> ak - - testGetWeeklyChartList = check gwcl $ - getWeeklyChartList <*> user "smpcln" <*> ak - - testGetWeeklyTrackChart = check gwtc $ - getWeeklyTrackChart <*> user "smpcln" <*> ak - - -gpc ∷ Value → Parser String -gat, gbt, ge, gf, glt, gn, gnr, gp, gpe, gpt, gra, gre, grs, grt, gs, gtal, gtar, gtta, gttr, gwalc, gwarc, gwcl, gwtc ∷ Value → Parser [String] -gat o = parseJSON o >>= (.: "artisttracks") >>= (.: "track") >>= mapM (.: "name") -gbt o = parseJSON o >>= (.: "bannedtracks") >>= (.: "track") >>= mapM (.: "name") -ge o = parseJSON o >>= (.: "events") >>= (.: "event") >>= mapM (.: "venue") >>= mapM (.: "url") -gf o = parseJSON o >>= (.: "friends") >>= (.: "user") >>= mapM (.: "name") -glt o = parseJSON o >>= (.: "lovedtracks") >>= (.: "track") >>= mapM (.: "name") -gn o = parseJSON o >>= (.: "neighbours") >>= (.: "user") >>= mapM (.: "name") -gnr o = parseJSON o >>= (.: "albums") >>= (.: "album") >>= mapM (.: "url") -gp o = parseJSON o >>= (.: "playlists") >>= (.: "playlist") >>= mapM (.: "title") -gpc o = parseJSON o >>= (.: "user") >>= (.: "playcount") -gpe o = parseJSON o >>= (.: "events") >>= (.: "event") >>= mapM (.: "url") -gpt o = parseJSON o >>= (.: "taggings") >>= (.: "artists") >>= (.: "artist") >>= mapM (.: "name") -gra o = parseJSON o >>= (.: "recommendations") >>= (.: "artist") >>= mapM (.: "name") -gre o = do - m <- parseJSON o >>= (.: "events") - (m .: "event" >>= mapM (.: "url")) <|> (m .: "event" >>= fmap return . (.: "url")) -grs o = parseJSON o >>= (.: "recentstations") >>= (.: "station") >>= mapM (.: "name") -grt o = parseJSON o >>= (.: "recenttracks") >>= (.: "track") >>= mapM (.: "name") -gs o = parseJSON o >>= (.: "shouts") >>= (.: "shout") >>= mapM (.: "body") -gtal o = parseJSON o >>= (.: "topalbums") >>= (.: "album") >>= mapM (.: "artist") >>= mapM (.: "name") -gtar o = parseJSON o >>= (.: "topartists") >>= (.: "artist") >>= mapM (.: "name") -gtta o = parseJSON o >>= (.: "toptags") >>= (.: "tag") >>= mapM (.: "name") -gttr o = parseJSON o >>= (.: "toptracks") >>= (.: "track") >>= mapM (.: "url") -gwalc o = parseJSON o >>= (.: "weeklyalbumchart") >>= (.: "album") >>= mapM (.: "url") -gwarc o = parseJSON o >>= (.: "weeklyartistchart") >>= (.: "artist") >>= mapM (.: "url") -gwcl o = take 5 `fmap` (parseJSON o >>= (.: "weeklychartlist") >>= (.: "chart") >>= mapM (.: "from")) -gwtc o = parseJSON o >>= (.: "weeklytrackchart") >>= (.: "track") >>= mapM (.: "url") diff --git a/tests/Venue.hs b/tests/Venue.hs deleted file mode 100644 --- a/tests/Venue.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE UnicodeSyntax #-} -module Venue (noauth) where - -import Data.Aeson.Types -import Network.Lastfm -import Network.Lastfm.Venue -import Test.Framework -import Test.Framework.Providers.HUnit - -import Common - - -noauth ∷ Request JSON APIKey → [Test] -noauth ak = - [ testCase "Venue.getEvents" testGetEvents - , testCase "Venue.getPastEvents" testGetPastEvents - , testCase "Venue.search" testSearch - ] - where - testGetEvents = check ge $ - getEvents <*> venue 9163107 <*> ak - - testGetPastEvents = check gpe $ - getPastEvents <*> venue 9163107 <* limit 2 <*> ak - - testSearch = check se $ - search <*> venueName "Arena" <*> ak - - -ge, gpe, se ∷ Value → Parser [String] -ge o = parseJSON o >>= (.: "events") >>= (.: "event") >>= mapM (\t → (t .: "venue") >>= (.: "name")) -gpe o = parseJSON o >>= (.: "events") >>= (.: "event") >>= mapM (.: "title") -se o = parseJSON o >>= (.: "results") >>= (.: "venuematches") >>= (.: "venue") >>= mapM (.: "id") diff --git a/tests/json.hs b/tests/json.hs deleted file mode 100644 --- a/tests/json.hs +++ /dev/null @@ -1,68 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE UnicodeSyntax #-} -module Main where - -import Control.Applicative -import Data.Monoid -import System.Exit (ExitCode(ExitFailure), exitWith) - -import qualified Data.ByteString.Lazy as B -import Data.Aeson -import Data.Text (Text) -import Network.Lastfm -import Test.Framework - -import qualified Album as Album -import qualified Artist as Artist -import qualified Chart as Chart -import qualified Event as Event -import qualified Geo as Geo -import qualified Group as Group -import qualified Library as Library -import qualified Playlist as Playlist -import qualified Tag as Tag -import qualified Tasteometer as Tasteometer -import qualified Track as Track -import qualified User as User -import qualified Venue as Venue - - -main ∷ IO () -main = - do keys ← B.readFile "tests/lastfm-keys.json" - case decode keys of - Just (Keys ak sk s) → - defaultMainWithOpts (auth <> noauth) (mempty { ropt_threads = Just 20 }) - where - auth = mconcat . map (\f → f (apiKey ak) (sessionKey sk) (Secret s)) $ - [ Album.auth - , Artist.auth - , Event.auth - , Library.auth - , Playlist.auth - , Track.auth - , User.auth - ] - noauth = mconcat . map (\f → f (apiKey ak)) $ - [ Album.noauth - , Artist.noauth - , Chart.noauth - , Event.noauth - , Geo.noauth - , Group.noauth - , Library.noauth - , Tag.noauth - , Tasteometer.noauth - , Track.noauth - , User.noauth - , Venue.noauth - ] - Nothing → exitWith (ExitFailure 1) - - -data Keys = Keys Text Text Text - - -instance FromJSON Keys where - parseJSON (Object o) = Keys <$> (o .: "APIKey") <*> (o .: "SessionKey") <*> (o .: "Secret") - parseJSON _ = empty