diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,14 @@ +0.6.0 +===== + + * Stopped using the deprecated stuff from http-client. + + * Removed `N.L.Response.closeConnection` as it's become a no-op. + + * Removed the "Network" prefix from the modules' names. + + * Set default schema to 'http', since ws.audioscrobbler.com has no proper SSL support (issue #27). + 0.5.1 ===== diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -45,10 +45,10 @@ First find it in liblastfm: `Tag` would be the name of the module and `search` would be the name of function. [Here it is][liblastfm/haddocks-usage]. So import a couple of modules: - >>> import Network.Lastfm -- a bunch of useful utilities - >>> import qualified Network.Lastfm.Tag as Tag -- for Tag.search + >>> import Lastfm -- a bunch of useful utilities + >>> import qualified Lastfm.Tag as Tag -- for Tag.search -Now you may you applicative `<*>` for required and `<*` or `*>` for optional parameters to construct +Now you may use applicative `<*>` for required and `<*` or `*>` for optional parameters to construct desired request: Tag.search <*> tag "russian-folk" <* limit 3 <*> apiKey "29effec263316a1f8a97f753caaa83e0" <* json @@ -114,7 +114,7 @@ export HASKELL_LIBLASTFM_SECRET="__SECRET__" ``` -Please, consult Lastfm API documentation and `examples/*-authentication.hs` +Please, consult Lastfm API documentation and `example/*-authentication.hs` examples if you don't know where to get your credentials. [last.fm]: http://www.last.fm/ diff --git a/example/desktop-authentication.hs b/example/desktop-authentication.hs --- a/example/desktop-authentication.hs +++ b/example/desktop-authentication.hs @@ -3,12 +3,12 @@ -- -- Please remember to substitute __YOUR_API_KEY__ -- and __YOUR_SECRET__ for real values -import Control.Lens -- lens -import Data.Aeson.Lens -- lens-aeson -import Data.Foldable (for_) -- base -import Data.Text (unpack) -- text -import Network.Lastfm -- liblastfm -import Network.Lastfm.Authentication -- liblastfm +import Control.Lens -- lens +import Data.Aeson.Lens -- lens-aeson +import Data.Foldable (for_) -- base +import Data.Text (unpack) -- text +import Lastfm -- liblastfm +import Lastfm.Authentication -- liblastfm main :: IO () diff --git a/example/liblastfm-examples.cabal b/example/liblastfm-examples.cabal --- a/example/liblastfm-examples.cabal +++ b/example/liblastfm-examples.cabal @@ -1,5 +1,5 @@ name: liblastfm-examples -version: 0.5.0 +version: 0.6.0 synopsis: Liblastfm examples license: MIT license-file: LICENSE @@ -25,7 +25,7 @@ sort-friends.hs ghc-options: -Wall - -fno-warn-unused-do-bind + -Werror -threaded executable multitag-search @@ -41,7 +41,7 @@ multitag-search.hs ghc-options: -Wall - -fno-warn-unused-do-bind + -Werror executable web-authentication default-language: @@ -57,7 +57,7 @@ web-authentication.hs ghc-options: -Wall - -fno-warn-unused-do-bind + -Werror executable desktop-authentication default-language: @@ -72,7 +72,7 @@ desktop-authentication.hs ghc-options: -Wall - -fno-warn-unused-do-bind + -Werror executable mobile-authentication default-language: @@ -87,6 +87,7 @@ mobile-authentication.hs ghc-options: -Wall + -Werror executable playcount default-language: @@ -101,7 +102,7 @@ playcount.hs ghc-options: -Wall - -fno-warn-unused-do-bind + -Werror executable recommendations default-language: @@ -117,4 +118,4 @@ recommendations.hs ghc-options: -Wall - -fno-warn-unused-do-bind + -Werror diff --git a/example/mobile-authentication.hs b/example/mobile-authentication.hs --- a/example/mobile-authentication.hs +++ b/example/mobile-authentication.hs @@ -4,12 +4,12 @@ -- Please remember to substitute __YOUR_API_KEY__, -- __YOUR_SECRET__, __USERNAME__ and __PASSWORD__ -- for real values -import Control.Lens -- lens -import Data.Aeson.Lens -- lens-aeson -import qualified Data.Text as Text -- text -import qualified Data.Text.IO as Text -- text -import Network.Lastfm -- liblastfm -import Network.Lastfm.Authentication -- liblastfm +import Control.Lens -- lens +import Data.Aeson.Lens -- lens-aeson +import qualified Data.Text as Text -- text +import qualified Data.Text.IO as Text -- text +import Lastfm -- liblastfm +import Lastfm.Authentication -- liblastfm main :: IO () main = withConnection $ \conn -> do diff --git a/example/multitag-search.hs b/example/multitag-search.hs --- a/example/multitag-search.hs +++ b/example/multitag-search.hs @@ -16,8 +16,8 @@ import Data.Text (Text) -- text import qualified Data.Text as Text -- text import qualified Data.Text.IO as Text -- text -import Network.Lastfm -- liblastfm -import qualified Network.Lastfm.Tag as Tag -- liblastfm +import Lastfm -- liblastfm +import qualified Lastfm.Tag as Tag -- liblastfm import System.Environment (getArgs) -- base {-# ANN module ("HLint: ignore Use camelCase" :: String) #-} diff --git a/example/playcount.hs b/example/playcount.hs --- a/example/playcount.hs +++ b/example/playcount.hs @@ -11,14 +11,14 @@ -- >>> ^C -- $> --} -import Control.Lens -- lens -import Data.Aeson.Lens -- lens-aeson -import Control.Monad -- base -import Data.Text (Text) -- text -import qualified Data.Text.IO as Text -- text -import Network.Lastfm -- liblastfm -import qualified Network.Lastfm.User as User -- liblastfm -import qualified System.IO as IO -- base +import Control.Lens -- lens +import Data.Aeson.Lens -- lens-aeson +import Control.Monad -- base +import Data.Text (Text) -- text +import qualified Data.Text.IO as Text -- text +import Lastfm -- liblastfm +import qualified Lastfm.User as User -- liblastfm +import qualified System.IO as IO -- base main :: IO () diff --git a/example/recommendations.hs b/example/recommendations.hs --- a/example/recommendations.hs +++ b/example/recommendations.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {- This example shows how to use signed queries @@ -13,16 +14,18 @@ - Mouth of the Architect -} -import Control.Lens -- lens -import Data.Aeson.Lens -- lens-aeson -import Data.Traversable (for) -- base -import Data.Aeson (Value) -- aeson -import Data.Foldable (Foldable) -- base -import Data.Int (Int64) -- base -import Data.Text (Text) -- text -import qualified Data.Text.IO as Text -- text -import Network.Lastfm -- liblastfm -import qualified Network.Lastfm.User as User -- liblastfm +import Control.Lens -- lens +import Data.Aeson.Lens -- lens-aeson +import Data.Traversable (for) -- base +import Data.Aeson (Value) -- aeson +#if __GLASGOW_HASKELL__ < 710 +import Data.Foldable (Foldable) -- base +#endif +import Data.Int (Int64) -- base +import Data.Text (Text) -- text +import qualified Data.Text.IO as Text -- text +import Lastfm -- liblastfm +import qualified Lastfm.User as User -- liblastfm main :: IO () @@ -31,7 +34,7 @@ mapM_ Text.putStrLn (concat r) -- Construct signed query -query :: Connection -> Request JSON (APIKey -> SessionKey -> Sign) -> IO (Either LastfmError Value) +query :: Connection -> Request 'JSON (APIKey -> SessionKey -> Sign) -> IO (Either LastfmError Value) query conn r = lastfm conn $ sign secret (r <*> ak <*> sk <* json) where ak = apiKey "__YOUR_API_KEY__" diff --git a/example/sort-friends.hs b/example/sort-friends.hs --- a/example/sort-friends.hs +++ b/example/sort-friends.hs @@ -20,21 +20,21 @@ - Notice: you may want to adjust maximum open files limit - if testing on users with relatively large friends count -} -import Control.Concurrent.Async -- async -import Control.Lens -- lens -import Data.Aeson.Lens -- lens-aeson -import Data.Aeson (Value) -- aeson -import Data.Function (on) -- base -import Data.List (sortBy) -- base -import Data.Maybe (fromMaybe) -- base -import Data.Monoid ((<>)) -- base -import Data.Text (Text) -- text -import Data.Text.Lens (unpacked) -- lens -import qualified Data.Text.IO as Text -- text -import Network.Lastfm hiding (to) -- liblastfm -import qualified Network.Lastfm.User as User -- liblastfm -import qualified Network.Lastfm.Tasteometer as Tasteometer -- liblastfm -import Text.Read (readMaybe) -- base +import Control.Concurrent.Async -- async +import Control.Lens -- lens +import Data.Aeson.Lens -- lens-aeson +import Data.Aeson (Value) -- aeson +import Data.Function (on) -- base +import Data.List (sortBy) -- base +import Data.Maybe (fromMaybe) -- base +import Data.Monoid ((<>)) -- base +import Data.Text (Text) -- text +import Data.Text.Lens (unpacked) -- lens +import qualified Data.Text.IO as Text -- text +import Lastfm hiding (to) -- liblastfm +import qualified Lastfm.User as User -- liblastfm +import qualified Lastfm.Tasteometer as Tasteometer -- liblastfm +import Text.Read (readMaybe) -- base type Score = Text @@ -67,7 +67,7 @@ pretty :: [(Text, Score)] -> IO () pretty = mapM_ (\(n,s) -> Text.putStrLn $ n <> ": " <> s) . take 5 . sortBy (flip compare `on` snd) -query :: Connection -> Request JSON (APIKey -> Ready) -> IO (Either LastfmError Value) +query :: Connection -> Request 'JSON (APIKey -> Ready) -> IO (Either LastfmError Value) query conn r = lastfm conn (r <*> apiKey "234fc6e0f41f6ef99b7bd62ebaf8d318" <* json) target :: Text diff --git a/example/web-authentication.hs b/example/web-authentication.hs --- a/example/web-authentication.hs +++ b/example/web-authentication.hs @@ -9,8 +9,8 @@ import Control.Monad.IO.Class (liftIO) -- transformers import Data.IORef -- base import Happstack.Server -- happstack-server -import Network.Lastfm -- liblastfm -import Network.Lastfm.Authentication -- liblastfm +import Lastfm -- liblastfm +import Lastfm.Authentication -- liblastfm main :: IO () diff --git a/liblastfm.cabal b/liblastfm.cabal --- a/liblastfm.cabal +++ b/liblastfm.cabal @@ -1,5 +1,5 @@ name: liblastfm -version: 0.5.1 +version: 0.6.0 synopsis: Lastfm API interface license: MIT license-file: LICENSE @@ -27,6 +27,12 @@ type: git location: https://github.com/supki/liblastfm +source-repository this + type: git + location: https://github.com/supki/liblastfm + tag: 0.6.0 + + flag test-api description: a real API test default: False @@ -41,40 +47,39 @@ , bytestring , cereal , containers >= 0.5 - , crypto-api - , http-client >= 0.3 + , cryptonite >= 0.7 + , http-client >= 0.4.19 , http-client-tls >= 0.2 , network-uri , profunctors - , pureMD5 , semigroups + , transformers , text , xml-conduit >= 1.1 hs-source-dirs: src 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 + Lastfm + Lastfm.Album + Lastfm.Artist + Lastfm.Authentication + Lastfm.Chart + Lastfm.Event + Lastfm.Geo + Lastfm.Group + Lastfm.Internal + Lastfm.Library + Lastfm.Playlist + Lastfm.Radio + Lastfm.Request + Lastfm.Response + Lastfm.Tag + Lastfm.Tasteometer + Lastfm.Track + Lastfm.User + Lastfm.Venue ghc-options: -Wall - -fno-warn-unused-do-bind -funbox-strict-fields test-suite api @@ -132,7 +137,6 @@ ghc-options: -Wall -fno-warn-orphans - -fno-warn-unused-do-bind test-suite spec default-language: @@ -145,7 +149,7 @@ , bytestring , cereal , containers - , crypto-api + , cryptonite , hspec , hspec-expectations-lens >= 0.3.0.0 , http-client @@ -154,8 +158,8 @@ , lens-aeson >= 1.0.0.1 , network-uri , profunctors - , pureMD5 , text + , transformers , xml-conduit , xml-html-conduit-lens >= 0.3 hs-source-dirs: @@ -164,7 +168,7 @@ main-is: Spec.hs other-modules: - Network.Lastfm.ResponseSpec + Lastfm.ResponseSpec ghc-options: -Wall cpp-options: diff --git a/src/Lastfm.hs b/src/Lastfm.hs new file mode 100644 --- /dev/null +++ b/src/Lastfm.hs @@ -0,0 +1,14 @@ +-- | Lastfm API interface +module Lastfm + ( -- * Utilities for constructing requests + module Lastfm.Request + -- * Utilities for signing and sending requests + , module Lastfm.Response + -- * Control.Applicative is re-exported for convenience + , module Control.Applicative + ) where + +import Control.Applicative + +import Lastfm.Request +import Lastfm.Response diff --git a/src/Lastfm/Album.hs b/src/Lastfm/Album.hs new file mode 100644 --- /dev/null +++ b/src/Lastfm/Album.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Lastfm album API +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Lastfm.Album as Album +-- @ +module Lastfm.Album + ( ArtistAlbumOrMBID + , addTags, getBuyLinks, getInfo, getShouts + , getTags, getTopTags, removeTag, search, share + ) where + +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative +#endif + +import Lastfm.Request + + +-- | Unify ('Artist' -> 'Album' -> …) and ('MBID' -> …) +class ArtistAlbumOrMBID r a | a -> r + +instance ArtistAlbumOrMBID r (MBID -> APIKey -> r) +instance ArtistAlbumOrMBID r (Artist -> Album -> APIKey -> r) + + +-- | Tag an album using a list of user supplied tags. +-- +-- +addTags :: Request f (Artist -> Album -> [Tag] -> APIKey -> SessionKey -> Sign) +addTags = api "album.addTags" <* post + + +-- | Get a list of Buy Links for a particular Album. It is +-- required that you supply either the artist and track params or the mbid parameter. +-- +-- Optional: 'autocorrect' +-- +-- +getBuyLinks :: ArtistAlbumOrMBID Ready a => Request f (Country -> a) +getBuyLinks = api "album.getBuyLinks" + + +-- | Get the metadata for an album on Last.fm using the album name or +-- a musicbrainz id. See playlist.fetch on how to get the album playlist. +-- +-- Optional: 'autocorrect', 'username', 'language' +-- +-- +getInfo :: ArtistAlbumOrMBID Ready a => Request f a +getInfo = api "album.getInfo" + + +-- | Get shouts for this album. +-- +-- Optional: 'autocorrect', 'limit', 'page' +-- +-- +getShouts :: ArtistAlbumOrMBID Ready a => Request f a +getShouts = api "album.getShouts" + + +-- | Get the tags applied by an individual user to an album on Last.fm. +-- +-- Optional: 'autocorrect', 'user' +-- +-- +getTags :: ArtistAlbumOrMBID r a => Request f a +getTags = api "album.getTags" + + +-- | Get the top tags for an album on Last.fm, ordered by popularity. +-- +-- Optional: 'autocorrect' +-- +-- +getTopTags :: ArtistAlbumOrMBID Ready a => Request f a +getTopTags = api "album.getTopTags" + + +-- | Remove a user's tag from an album. +-- +-- +removeTag :: Request f (Artist -> Album -> Tag -> APIKey -> SessionKey -> Sign) +removeTag = api "album.removeTag" <* post + + +-- | Search for an album by name. Returns album matches sorted by relevance. +-- +-- Optional: 'limit', 'page' +-- +-- +search :: Request f (Album -> APIKey -> Ready) +search = api "album.search" + + +-- | Share an album with one or more Last.fm users or other friends. +-- +-- Optional: 'public', 'message', 'recipient' +-- +-- +share :: Request f (Album -> Artist -> Recipient -> APIKey -> SessionKey -> Sign) +share = api "album.share" <* post diff --git a/src/Lastfm/Artist.hs b/src/Lastfm/Artist.hs new file mode 100644 --- /dev/null +++ b/src/Lastfm/Artist.hs @@ -0,0 +1,184 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Lastfm artist API +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Lastfm.Artist as Artist +-- @ +module Lastfm.Artist + ( ArtistOrMBID + , addTags, getCorrection, getEvents, getInfo + , getPastEvents, getPodcast, getShouts + , getSimilar, getTags, getTopAlbums + , getTopFans, getTopTags, getTopTracks + , removeTag, search, share, shout + ) where + +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative +#endif + +import Lastfm.Request + +-- | Unify ('Artist' -> …) and ('MBID' -> …) +class ArtistOrMBID r a + +instance ArtistOrMBID r MBID +instance ArtistOrMBID r Artist + + +-- | Tag an artist with one or more user supplied tags. +-- +-- +addTags :: Request f (Artist -> [Tag] -> APIKey -> SessionKey -> Sign) +addTags = api "artist.addTags" <* post + + +-- | Use the last.fm corrections data to check whether the +-- supplied artist has a correction to a canonical artist +-- +-- +getCorrection :: Request f (Artist -> APIKey -> Ready) +getCorrection = api "artist.getCorrection" + + +-- | Get a list of upcoming events for this artist. Easily +-- integratable into calendars, using the ical standard (see feeds section below). +-- +-- Optional: 'autocorrect', 'limit', 'pages', 'festivalsonly' +-- +-- +getEvents :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) +getEvents = api "artist.getEvents" + + +-- | Get the metadata for an artist. Includes biography. +-- +-- Optional: 'language', 'autocorrect', 'username' +-- +-- +getInfo :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) +getInfo = api "artist.getInfo" + + +-- | Get a paginated list of all the events this artist has played at in the past. +-- +-- Optional: 'page', 'autocorrect', 'limit' +-- +-- +getPastEvents :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) +getPastEvents = api "artist.getPastEvents" + + +-- | Get a podcast of free mp3s based on an artist +-- +-- Optional: 'autocorrect' +-- +-- +getPodcast :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) +getPodcast = api "artist.getPodcast" + + +-- | Get shouts for this artist. Also available as an rss feed. +-- +-- Optional:'autocorrect', 'limit', 'page' +-- +-- +getShouts :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) +getShouts = api "artist.getShouts" + + +-- | Get all the artists similar to this artist +-- +-- Optional: 'limit', 'autocorrect' +-- +-- +getSimilar :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) +getSimilar = api "artist.getSimilar" + + +-- | Get the tags applied by an individual user to an artist on Last.fm. +-- If accessed as an authenticated service /and/ you don't supply a +-- user parameter then this service will return tags for +-- the authenticated user. To retrieve the list of top tags applied +-- to an artist by all users use 'Lastfm.Artist.getTopTags'. +-- +-- Optional: 'user', 'autocorrect' +-- +-- +getTags :: ArtistOrMBID r a => Request f (a -> APIKey -> r) +getTags = api "artist.getTags" + + +-- | Get the top albums for an artist on Last.fm, ordered by popularity. +-- +-- Optional: 'autocorrect', 'page', 'limit' +-- +-- +getTopAlbums :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) +getTopAlbums = api "artist.getTopAlbums" + + +-- | Get the top fans for an artist on Last.fm, based on listening data. +-- +-- Optional: 'autocorrect' +-- +-- +getTopFans :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) +getTopFans = api "artist.getTopFans" + + +-- | Get the top tags for an artist on Last.fm, ordered by popularity. +-- +-- Optional: 'autocorrect' +-- +-- +getTopTags :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) +getTopTags = api "artist.getTopTags" + + +-- | Get the top tracks by an artist on Last.fm, ordered by popularity +-- +-- Optional: 'autocorrect', 'page', 'limit' +-- +-- +getTopTracks :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) +getTopTracks = api "artist.getTopTracks" + + +-- | Remove a user's tag from an artist. +-- +-- +removeTag :: Request f (Artist -> Tag -> APIKey -> SessionKey -> Sign) +removeTag = api "artist.removeTag" <* post + + +-- | Search for an artist by name. Returns artist matches sorted by relevance. +-- +-- Optional: 'limit', 'page' +-- +-- +search :: Request f (Artist -> APIKey -> Ready) +search = api "artist.search" + + +-- | Share an artist with Last.fm users or other friends. +-- +-- Optional: 'message', 'public' +-- +-- +share :: Request f (Artist -> Recipient -> APIKey -> SessionKey -> Sign) +share = api "artist.share" <* post + + +-- | Shout in this artist's shoutbox +-- +-- +shout :: Request f (Artist -> Message -> APIKey -> SessionKey -> Sign) +shout = api "artist.shout" <* post diff --git a/src/Lastfm/Authentication.hs b/src/Lastfm/Authentication.hs new file mode 100644 --- /dev/null +++ b/src/Lastfm/Authentication.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Lastfm authentication procedure helpers +-- +-- Basically, lastfm provides 3 ways to authenticate user: +-- +-- - web application - +-- +-- - desktop application - +-- +-- - modile application - +-- +-- 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 Lastfm +-- >>> import Lastfm.Authentication +-- >>> :set -XOverloadedStrings +-- >>> con <- newConnection +-- >>> lastfm con $ getToken <*> apiKey "__API_KEY__" <* json +-- Right (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 con $ sign "__SECRET__" $ getSession <*> token "__TOKEN__" <*> apiKey "__API_KEY__" <* json +-- Right (Object (fromList [("session",Object (fromList [("subscriber",String "0"),("key",String "__SESSION_KEY__"),("name",String "__USER__")]))])) +module Lastfm.Authentication + ( -- * Helpers + getToken, getSession, getMobileSession + , link + ) where + +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative +import Data.Monoid +#endif + +import Lastfm.Internal +import Lastfm.Request + + +-- | Get authorization token +getToken :: Request f (APIKey -> Ready) +getToken = api "auth.getToken" + + +-- | Get session key +getMobileSession :: Request f (Username -> Password -> APIKey -> Sign) +getMobileSession = api "auth.getMobileSession" <* post + + +-- | Get session key +getSession :: Request f (Token -> APIKey -> Sign) +getSession = api "auth.getSession" + + +-- | Construct link user should follow to approve application +link :: Request f a -> String +link q = render . unwrap q $ R + { _host = "http://www.last.fm/api/auth/" + , _method = mempty + , _query = mempty + } diff --git a/src/Lastfm/Chart.hs b/src/Lastfm/Chart.hs new file mode 100644 --- /dev/null +++ b/src/Lastfm/Chart.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Lastfm chart API +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Lastfm.Chart as Chart +-- @ +module Lastfm.Chart + ( getHypedArtists, getHypedTracks, getLovedTracks + , getTopArtists, getTopTags, getTopTracks + ) where + +import Lastfm.Request + + +-- | Get the hyped artists chart +-- +-- Optional: 'page', 'limit' +-- +-- +getHypedArtists :: Request f (APIKey -> Ready) +getHypedArtists = api "chart.getHypedArtists" + + +-- | Get the top artists chart +-- +-- Optional: 'page', 'limit' +-- +-- +getHypedTracks :: Request f (APIKey -> Ready) +getHypedTracks = api "chart.getHypedTracks" + + +-- | Get the most loved tracks chart +-- +-- Optional: 'page', 'limit' +-- +-- +getLovedTracks :: Request f (APIKey -> Ready) +getLovedTracks = api "chart.getLovedTracks" + + +-- | Get the top artists chart +-- +-- Optional: 'page', 'limit' +-- +-- +getTopArtists :: Request f (APIKey -> Ready) +getTopArtists = api "chart.getTopArtists" + + +-- | Get the top artists chart +-- +-- Optional: 'page', 'limit' +-- +-- +getTopTags :: Request f (APIKey -> Ready) +getTopTags = api "chart.getTopTags" + + +-- | Get the top tracks chart +-- +-- Optional: 'page', 'limit' +-- +-- +getTopTracks :: Request f (APIKey -> Ready) +getTopTracks = api "chart.getTopTracks" diff --git a/src/Lastfm/Event.hs b/src/Lastfm/Event.hs new file mode 100644 --- /dev/null +++ b/src/Lastfm/Event.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Lastfm event API +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Lastfm.Event as Event +-- @ +module Lastfm.Event + ( attend, getAttendees, getInfo, getShouts, share, shout + ) where + +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative +#endif + +import Lastfm.Request + + +-- | Set a user's attendance status for an event. +-- +-- +attend :: Request f (Event -> Status -> APIKey -> SessionKey -> Sign) +attend = api "event.attend" <* post + + +-- | Get a list of attendees for an event. +-- +-- Optional: 'page', 'limit' +-- +-- +getAttendees :: Request f (Event -> APIKey -> Ready) +getAttendees = api "event.getAttendees" + + +-- | Get the metadata for an event on Last.fm. Includes attendance and lineup information. +-- +-- +getInfo :: Request f (Event -> APIKey -> Ready) +getInfo = api "event.getInfo" + + +-- | Get shouts for this event. Also available as an rss feed. +-- +-- Optional: 'page', 'limit' +-- +-- +getShouts :: Request f (Event -> APIKey -> Ready) +getShouts = api "event.getShouts" + + +-- | Share an event with one or more Last.fm users or other friends. +-- +-- Optional: 'public', 'message' +-- +-- +share :: Request f (Event -> Recipient -> APIKey -> SessionKey -> Sign) +share = api "event.share" <* post + + +-- | Shout in this event's shoutbox +-- +-- +shout :: Request f (Event -> Message -> APIKey -> SessionKey -> Sign) +shout = api "event.shout" <* post diff --git a/src/Lastfm/Geo.hs b/src/Lastfm/Geo.hs new file mode 100644 --- /dev/null +++ b/src/Lastfm/Geo.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Lastfm geo API +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Lastfm.Geo as Geo +-- @ +module Lastfm.Geo + ( getEvents, getMetroArtistChart, getMetroHypeArtistChart + , getMetroHypeTrackChart, getMetroTrackChart, getMetroUniqueArtistChart + , getMetroUniqueTrackChart, getMetroWeeklyChartlist, getMetros + , getTopArtists, getTopTracks + ) where + +import Lastfm.Request + + +-- | Get all events in a specific location by country or city name. +-- +-- Optional: 'longitude', 'latitude', 'location', 'distance', 'page', 'tag', 'festivalsonly', 'limit' +-- +-- +getEvents :: Request f (APIKey -> Ready) +getEvents = api "geo.getEvents" + + +-- | Get a chart of artists for a metro +-- +-- Optional: 'start', 'end', 'page', 'limit' +-- +-- +getMetroArtistChart :: Request f (Metro -> Country -> APIKey -> Ready) +getMetroArtistChart = api "geo.getMetroArtistChart" + + +-- | Get a chart of hyped (up and coming) artists for a metro +-- +-- Optional: 'start', 'end', 'page', 'limit' +-- +-- +getMetroHypeArtistChart :: Request f (Metro -> Country -> APIKey -> Ready) +getMetroHypeArtistChart = api "geo.getMetroHypeArtistChart" + + +-- | Get a chart of tracks for a metro +-- +-- Optional: 'start', 'end', 'page', 'limit' +-- +-- +getMetroHypeTrackChart :: Request f (Metro -> Country -> APIKey -> Ready) +getMetroHypeTrackChart = api "geo.getMetroHypeTrackChart" + + +-- | Get a chart of tracks for a metro +-- +-- Optional: 'start', 'end', 'page', 'limit' +-- +-- +getMetroTrackChart :: Request f (Metro -> Country -> APIKey -> Ready) +getMetroTrackChart = api "geo.getMetroTrackChart" + + +-- | Get a chart of the artists which make that metro unique +-- +-- Optional: 'start', 'end', 'page', 'limit' +-- +-- +getMetroUniqueArtistChart :: Request f (Metro -> Country -> APIKey -> Ready) +getMetroUniqueArtistChart = api "geo.getMetroUniqueArtistChart" + + +-- | Get a chart of tracks for a metro +-- +-- Optional: 'start', 'end', 'page', 'limit' +-- +-- +getMetroUniqueTrackChart :: Request f (Metro -> Country -> APIKey -> Ready) +getMetroUniqueTrackChart = api "geo.getMetroUniqueTrackChart" + + +-- | Get a list of available chart periods for this metro, +-- expressed as date ranges which can be sent to the chart services. +-- +-- +getMetroWeeklyChartlist :: Request f (Metro -> APIKey -> Ready) +getMetroWeeklyChartlist = api "geo.getMetroWeeklyChartlist" + + +-- | Get a list of valid countries and metros for use in the other webservices +-- +-- Optional: 'country' +-- +-- +getMetros :: Request f (APIKey -> Ready) +getMetros = api "geo.getMetros" + + +-- | Get the most popular artists on Last.fm by country +-- +-- Optional: 'limit', 'page' +-- +-- +getTopArtists :: Request f (Country -> APIKey -> Ready) +getTopArtists = api "geo.getTopArtists" + + +-- | Get the most popular tracks on Last.fm last week by country +-- +-- Optional: 'limit', 'page' +-- +-- +getTopTracks :: Request f (Country -> APIKey -> Ready) +getTopTracks = api "geo.getTopTracks" diff --git a/src/Lastfm/Group.hs b/src/Lastfm/Group.hs new file mode 100644 --- /dev/null +++ b/src/Lastfm/Group.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Lastfm group API +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Lastfm.Group as Group +-- @ +module Lastfm.Group + ( getHype, getMembers, getWeeklyAlbumChart, getWeeklyArtistChart, getWeeklyChartList, getWeeklyTrackChart + ) where + +import Lastfm.Request + + +-- | Get the hype list for a group +-- +-- +getHype :: Request f (Group -> APIKey -> Ready) +getHype = api "group.getHype" + + +-- | Get a list of members for this group. +-- +-- Optional: 'page', 'limit' +-- +-- +getMembers :: Request f (Group -> APIKey -> Ready) +getMembers = api "group.getMembers" + + +-- | Get an album chart for a group, for a given date range. +-- If no date range is supplied, it will return the most recent album chart for this group. +-- +-- Optional: 'from', 'to' +-- +-- +getWeeklyAlbumChart :: Request f (Group -> APIKey -> Ready) +getWeeklyAlbumChart = api "group.getWeeklyAlbumChart" + + +-- | Get an artist chart for a group, for a given date range. +-- If no date range is supplied, it will return the most recent album chart for this group. +-- +-- Optional: 'from', 'to' +-- +-- +getWeeklyArtistChart :: Request f (Group -> APIKey -> Ready) +getWeeklyArtistChart = api "group.getWeeklyArtistChart" + + +-- | Get a list of available charts for this group, expressed as +-- date ranges which can be sent to the chart services. +-- +-- +getWeeklyChartList :: Request f (Group -> APIKey -> Ready) +getWeeklyChartList = api "group.getWeeklyChartList" + + +-- | Get a track chart for a group, for a given date range. +-- If no date range is supplied, it will return the most recent album chart for this group. +-- +-- Optional: 'from', 'to' +-- +-- +getWeeklyTrackChart :: Request f (Group -> APIKey -> Ready) +getWeeklyTrackChart = api "group.getWeeklyTrackChart" diff --git a/src/Lastfm/Internal.hs b/src/Lastfm/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Lastfm/Internal.hs @@ -0,0 +1,136 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 708 +{-# LANGUAGE AutoDeriveTypeable #-} +#endif +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE KindSignatures #-} +-- | liblastfm internals +-- +-- You shouldn't need to import this module unless you are doing something interesting. +module Lastfm.Internal + ( Request(..) + , Format(..) + , Ready + , Sign + , R(..) + , wrap + , unwrap + , render + , coerce + , absorbQuery + , indexedWith + ) where + +import Control.Applicative +import Data.ByteString (ByteString) +#if __GLASGOW_HASKELL__ < 710 +import Data.Foldable (Foldable(..)) +#endif +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as M +import Data.Monoid +import Data.Serialize (Serialize(..)) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +#if __GLASGOW_HASKELL__ < 710 +import Data.Traversable (Traversable(..)) +#endif +import Network.URI (escapeURIChar, isUnreserved) + + +-- | Lastfm API request data type +-- +-- low-level representation +data R (f :: Format) = R + { _host :: {-# UNPACK #-} !Text + , _method :: {-# UNPACK #-} !ByteString + , _query :: !(Map Text Text) + } + +-- | Response format: either JSON or XML +data Format = JSON | XML + +-- | Request that is ready to be sent +data Ready + +-- | Request that requires signing procedure +data Sign + + +-- | Lastfm API request data type +-- +-- @a@ is the authentication state. Can be 'Ready', which means this 'Request' is +-- ready to be sent, or 'Sign', if the request signature hasn't been computed yet +-- +-- @f@ is the response format (liblastfm supports both 'JSON' and 'XML') +newtype Request f a = Request { unRequest :: Const (Dual (Endo (R f))) a } + +instance Functor (Request f) where + fmap f (Request x) = Request (fmap f x) + +instance Applicative (Request f) where + pure x = Request (pure x) + Request f <*> Request x = Request (f <*> x) + +instance Foldable (Request f) where + foldMap _ (Request _) = mempty -- not sure why this instance isn't in base + +instance Traversable (Request f) where + traverse _ (Request (Const x)) = pure (Request (Const x)) -- and that + + +coerce :: Request f a -> Request f b +coerce (Request (Const x)) = Request (Const x) + + +-- | Construct String from request for networking +render :: R f -> String +render R { _host = h, _query = q } = + T.unpack $ mconcat [h, "?", argie q] + where + argie = T.intercalate "&" . M.foldrWithKey (\k v m -> T.concat [escape k, "=", escape v] : m) [] + + escape = T.concatMap (T.pack . escapeURIChar isUnreserved) + + +-- | Wrapping to interesting 'Monoid' ('R' -> 'R') instance +wrap :: (R f -> R f) -> Request f a +wrap = Request . Const . Dual . Endo + +-- | Unwrapping from interesting 'Monoid' ('R' -> 'R') instance +unwrap :: Request f a -> R f -> R f +unwrap = appEndo . getDual . getConst . unRequest + + +-- | 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 } + +-- | 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) }) + +-- | Empty request +rempty :: R f +rempty = R mempty mempty mempty + + +-- Miscellaneous instances + +instance Serialize (R f) where + put r = do + put $ T.encodeUtf8 (_host r) + put $ _method r + put $ bimap T.encodeUtf8 T.encodeUtf8 (_query r) + get = do + h <- T.decodeUtf8 <$> get + m <- get + q <- bimap T.decodeUtf8 T.decodeUtf8 <$> get + return R { _host = h, _method = m, _query = q } + +bimap :: (Ord s, Ord t) => (s -> t) -> (a -> b) -> Map s a -> Map t b +bimap f g = M.mapKeys f . M.map g diff --git a/src/Lastfm/Library.hs b/src/Lastfm/Library.hs new file mode 100644 --- /dev/null +++ b/src/Lastfm/Library.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Lastfm library API +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Lastfm.Library as Library +-- @ +module Lastfm.Library + ( addAlbum, albumItem, addArtist, artistItem, addTrack + , getAlbums, getArtists, getTracks + , removeAlbum, removeArtist, removeScrobble, removeTrack + ) where + +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative +#endif +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as N + +import Lastfm.Internal (absorbQuery, indexedWith, wrap) +import Lastfm.Request + + +-- | Add an album or collection of albums to a user's Last.fm library +-- +-- +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) + +-- | What artist to add to library? +albumItem :: Request f (Artist -> Album -> LibraryAlbum) +albumItem = wrap id + + +-- | Add an artist to a user's Last.fm library +-- +-- +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) + +-- | What album to add to library? +artistItem :: Request f (Artist -> LibraryArtist) +artistItem = wrap id + + +-- | Add a track to a user's Last.fm library +-- +-- +addTrack :: Request f (Artist -> Track -> APIKey -> SessionKey -> Sign) +addTrack = api "library.addTrack" <* post + + +-- | A paginated list of all the albums in a user's library, with play counts and tag counts. +-- +-- Optional: 'artist', 'limit', 'page' +-- +-- +getAlbums :: Request f (User -> APIKey -> Ready) +getAlbums = api "library.getAlbums" + + +-- | A paginated list of all the artists in a user's library, with play counts and tag counts. +-- +-- Optional: 'limit', 'page' +-- +-- +getArtists :: Request f (User -> APIKey -> Ready) +getArtists = api "library.getArtists" + + +-- | A paginated list of all the tracks in a user's library, with play counts and tag counts. +-- +-- Optional: 'artist', 'album', 'page', 'limit' +-- +-- +getTracks :: Request f (User -> APIKey -> Ready) +getTracks = api "library.getTracks" + + +-- | Remove an album from a user's Last.fm library +-- +-- +removeAlbum :: Request f (Artist -> Album -> APIKey -> SessionKey -> Sign) +removeAlbum = api "library.removeAlbum" <* post + + +-- | Remove an artist from a user's Last.fm library +-- +-- +removeArtist :: Request f (Artist -> APIKey -> SessionKey -> Sign) +removeArtist = api "library.removeArtist" <* post + + +-- | Remove a scrobble from a user's Last.fm library +-- +-- +removeScrobble :: Request f (Artist -> Track -> Timestamp -> APIKey -> SessionKey -> Sign) +removeScrobble = api "library.removeScrobble" <* post + + +-- | Remove a track from a user's Last.fm library +-- +-- +removeTrack :: Request f (Artist -> Track -> APIKey -> SessionKey -> Sign) +removeTrack = api "library.removeTrack" <* post diff --git a/src/Lastfm/Playlist.hs b/src/Lastfm/Playlist.hs new file mode 100644 --- /dev/null +++ b/src/Lastfm/Playlist.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Lastfm playlist API +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Lastfm.Playlist as Playlist +-- @ +module Lastfm.Playlist + ( addTrack, create + ) where + +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative +#endif + +import Lastfm.Request + + +-- | Add a track to a Last.fm user's playlist +-- +-- +addTrack :: Request f (Playlist -> Artist -> Track -> APIKey -> SessionKey -> Sign) +addTrack = api "playlist.addTrack" <* post + + +-- | Create a Last.fm playlist on behalf of a user +-- +-- Optional: 'title', 'description' +-- +-- +create :: Request f (APIKey -> SessionKey -> Sign) +create = api "playlist.create" <* post diff --git a/src/Lastfm/Radio.hs b/src/Lastfm/Radio.hs new file mode 100644 --- /dev/null +++ b/src/Lastfm/Radio.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Lastfm radio API +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Lastfm.Radio as Radio +-- @ +module Lastfm.Radio + ( getPlaylist, search, tune + ) where + +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative +#endif + +import Lastfm.Request + + +-- | Fetch new radio content periodically in an XSPF format. +-- +-- Optional: 'discovery', 'rtp', 'buyLinks' +-- +-- +getPlaylist :: Request f (Multiplier -> Bitrate -> APIKey -> SessionKey -> Sign) +getPlaylist = api "radio.getPlaylist" + + +-- | Resolve the name of a resource into a station depending on which resource +-- it is most likely to represent. +-- +-- +search :: Request f (Name -> APIKey -> Ready) +search = api "radio.search" + + +-- | Tune in to a Last.fm radio station. +-- +-- Optional: 'language' +-- +-- +tune :: Request f (Station -> APIKey -> SessionKey -> Sign) +tune = api "radio.tune" <* post diff --git a/src/Lastfm/Request.hs b/src/Lastfm/Request.hs new file mode 100644 --- /dev/null +++ b/src/Lastfm/Request.hs @@ -0,0 +1,430 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Request construction +module Lastfm.Request + ( -- * Request + Request, R, Ready, Sign, Format(..) + -- * Request major parameters + , api, https, post, get, json, xml, APIKey, apiKey, SessionKey, sessionKey + -- * Request minor parameters + , Token, token, Callback, callback + , Artist, artist, artists, Album, album, MBID, mbid + , Country, country, Autocorrect, autocorrect + , Event, event, Status(..), status + , From, from, To, to, Group, group + , Language, language, Distance, distance + , Longitude, longitude, Latitude, latitude, Location, location + , Start, start, End, end, Festivals, festivalsonly + , StartTimestamp, startTimestamp, EndTimestamp, endTimestamp + , Metro, metro, Tag, tags, tag, Track, track, Timestamp , timestamp, Fingerprint, fingerprint + , AlbumArtist, albumArtist, Duration, duration, TrackNumber, trackNumber + , Playlist, playlist, Title, title, Description, description + , ChosenByUser, chosenByUser, Context, context, StreamId, streamId + , RecentTracks, recentTracks + , Recipient, recipient, Username, username, User, user, Password, password + , Public, public, Message, message, Page, page, Limit, limit + , TaggingType, taggingType, UseRecs, useRecs, Venue, venue, VenueName, venueName + , Discovery, discovery, RTP, rtp, BuyLinks, buyLinks, Multiplier(..), multiplier + , Bitrate(..), bitrate, Name, name, Station, station + , Targeted, comparison, Scrobble, LibraryAlbum, LibraryArtist + ) where + +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative +#endif +import Data.Int (Int64) +#if __GLASGOW_HASKELL__ < 710 +import Data.Monoid (mempty) +#endif +import Data.Monoid ((<>)) +import qualified Data.Map.Strict as M +import Data.Text (Text) +import qualified Data.Text as T + +import Lastfm.Internal + + +class Argument a where + add :: Text -> a -> Request f b + add k v = wrap $ \r@R { _query = q } -> r { _query = M.insert k (toText v) q } + + toText :: a -> Text + +instance Argument Text where + toText = id + +instance Argument Bool where + toText b = if b then "1" else "0" + +instance Argument Int64 where + toText = T.pack . show + +instance Argument a => Argument [a] where + toText = T.intercalate "," . map toText + + +data APIKey +data SessionKey +data Token +data Callback + + +-- | Change request API method +-- +-- Primarily used in API call wrappers, not intended for usage by library user +api :: Text -> Request f a +api = add "method" + +-- | Change API scheme to https ('http' is the default one) +https :: Request f a +https = wrap $ \r -> r { _host = "https://ws.audioscrobbler.com/2.0/" } + +-- | Change html _method to GET +-- +-- Primarily used in API call wrappers, not intended for usage by library user +get :: Request f a +get = wrap $ \r -> r { _method = "GET" } + +-- | Change html _method to POST +-- +-- Primarily used in API call wrappers, not intended for usage by library user +post :: Request f a +post = wrap $ \r -> r { _method = "POST" } + +-- | Change API response format to JSON +-- +-- This is a little helper. It's actually enough +-- to specialize Format manually +json :: Request 'JSON a +json = wrap id + +-- | Change API response format to XML +-- +-- This is a little helper. It's actually enough +-- to specialize Format manually +xml :: Request 'XML a +xml = wrap id + +-- | Change request API key +apiKey :: Text -> Request f APIKey +apiKey = add "api_key" + +-- | Change request session key +sessionKey :: Text -> Request f SessionKey +sessionKey = add "sk" + +-- | Add token parameter +token :: Text -> Request f Token +token = add "token" + +-- | Add callback link parameter +callback :: Text -> Request f Callback +callback = add "cb" + + +data Artist +data Album +data MBID +data Country +data Language +data Tag +data Autocorrect +data Page +data Limit +data Message +data Public +data Recipient +data Username +data User +data Password +data Status = Attending | Maybe | NotAttending +data Event +data Festivals +data Longitude +data Latitude +data Location +data Distance +data Metro +data Start +data End +data StartTimestamp +data EndTimestamp +data From +data To +data Playlist +data Title +data Description +data Track +data Timestamp +data Fingerprint +data AlbumArtist +data Context +data StreamId +data Duration +data TrackNumber +data ChosenByUser +data TaggingType +data RecentTracks +data UseRecs +data Scrobble +data Group +data Venue +data VenueName +data Multiplier = M1 | M2 +data Bitrate = B64 | B128 +data Name +data Station +data Discovery +data RTP +data BuyLinks +data LibraryAlbum +data LibraryArtist + + +-- | Add artist parameter +artist :: Text -> Request f Artist +artist = add "artist" + +-- | Add artists parameter +artists :: [Text] -> Request f [Artist] +artists = add "artists" + +-- | Add album parameter +album :: Text -> Request f Album +album = add "album" + +-- | Add MBID parameter +mbid :: Text -> Request f MBID +mbid = add "mbid" + +-- | Add country parameter +country :: Text -> Request f Country +country = add "country" + +-- | Add language parameter +language :: Text -> Request f Language +language = add "lang" + +-- | Add tags parameter +tags :: [Text] -> Request f [Tag] +tags = add "tags" + +-- | Add tag parameter +tag :: Text -> Request f Tag +tag = add "tag" + +-- | Add autocorrect parameter +autocorrect :: Bool -> Request f Autocorrect +autocorrect = add "tags" + +-- | Add page parameter +page :: Int64 -> Request f Page +page = add "page" + +-- | Add limit parameter +limit :: Int64 -> Request f Limit +limit = add "limit" + +-- | Add message parameter +message :: Text -> Request f Message +message = add "message" + +-- | Add public parameter +public :: Bool -> Request f Public +public = add "public" + +-- | Add recipient parameter +recipient :: Text -> Request f Recipient +recipient = add "recipient" + +-- | Add username parameter +username :: Text -> Request f Username +username = add "username" + +-- | Add user parameter +user :: Text -> Request f User +user = add "user" + +-- | Add password parameter +password :: Text -> Request f Password +password = add "password" + +-- | Add status parameter +status :: Status -> Request f Status +status = add "status" . T.pack . \s -> case s of + Attending -> "0" + Maybe -> "1" + _ -> "2" + +-- | Add event parameter +event :: Int64 -> Request f Event +event = add "event" + +-- | Add festivalsonly parameter +festivalsonly :: Bool -> Request f Festivals +festivalsonly = add "festivalsonly" + +-- | Add longitude parameter +longitude :: Text -> Request f Longitude +longitude = add "longitude" + +-- | Add latitude parameter +latitude :: Text -> Request f Latitude +latitude = add "latitude" + +-- | Add location parameter +location :: Text -> Request f Location +location = add "location" + +-- | Add distance parameter +distance :: Int64 -> Request f Distance +distance = add "distance" + +-- | Add venue parameter +venue :: Int64 -> Request f Venue +venue = add "venue" + +-- | Add venue parameter +venueName :: Text -> Request f VenueName +venueName = add "venue" + +-- | Add metro parameter +metro :: Text -> Request f Metro +metro = add "metro" + +-- | Add start parameter +start :: Int64 -> Request f Start +start = add "start" + +-- | Add end parameter +end :: Int64 -> Request f End +end = add "end" + +-- | Add startTimestamp parameter +startTimestamp :: Int64 -> Request f StartTimestamp +startTimestamp = add "startTimestamp" + +-- | Add endTimestamp parameter +endTimestamp :: Int64 -> Request f EndTimestamp +endTimestamp = add "endTimestamp" + +-- | Add from parameter +from :: Int64 -> Request f From +from = add "from" + +-- | Add to parameter +to :: Int64 -> Request f To +to = add "to" + +-- | Add track parameter +track :: Text -> Request f Track +track = add "track" + +-- | Add timestamp parameter +timestamp :: Int64 -> Request f Timestamp +timestamp = add "timestamp" + +-- | Add playlistID parameter +playlist :: Int64 -> Request f Playlist +playlist = add "playlistID" + +-- | Add title parameter +title :: Text -> Request f Title +title = add "title" + +-- | Add description parameter +description :: Text -> Request f Description +description = add "description" + +-- | Add fingerprint parameter +fingerprint :: Int64 -> Request f Fingerprint +fingerprint = add "fingerprintid" + +-- | Add albumArtist parameter +albumArtist :: Text -> Request f AlbumArtist +albumArtist = add "albumArtist" + +-- | Add context parameter +context :: Text -> Request f Context +context = add "context" + +-- | Add streamId parameter +streamId :: Int64 -> Request f StreamId +streamId = add "streamId" + +-- | Add duration parameter +duration :: Int64 -> Request f Duration +duration = add "duration" + +-- | Add trackNumber parameter +trackNumber :: Int64 -> Request f TrackNumber +trackNumber = add "trackNumber" + +-- | Add chosenByUser parameter +chosenByUser :: Bool -> Request f ChosenByUser +chosenByUser = add "chosenByUser" + +-- | Add taggingType parameter +taggingType :: Text -> Request f TaggingType +taggingType = add "taggingtype" + +-- | Add recentTracks parameter +recentTracks :: Bool -> Request f RecentTracks +recentTracks = add "recentTracks" + +-- | Add useRecs parameter +useRecs :: Bool -> Request f UseRecs +useRecs = add "useRecs" + +-- | Add group parameter +group :: Text -> Request f Group +group = add "group" + +-- | Add multiplier parameter +multiplier :: Multiplier -> Request f Multiplier +multiplier m = case m of + M1 -> add "speed_multiplier" (T.pack "1.0") + M2 -> add "speed_multiplier" (T.pack "2.0") + +-- | Add bitrate parameter +bitrate :: Bitrate -> Request f Bitrate +bitrate b = case b of + B64 -> add "bitrate" (64 :: Int64) + B128 -> add "bitrate" (128 :: Int64) + +-- | Add name parameter +name :: Text -> Request f Name +name = add "name" + +-- | Add station parameter +station :: Text -> Request f Station +station = add "station" + +-- | Add group parameter +discovery :: Bool -> Request f Discovery +discovery = add "discovery" + +-- | Add rtp parameter +rtp :: Bool -> Request f RTP +rtp = add "rtp" + +-- | Add buyLinks parameter +buyLinks :: Bool -> Request f BuyLinks +buyLinks = add "buyLinks" + + +class Targeted a where + target :: Request f a -> Text + +instance Targeted [Artist] where + target _ = "artists" + +instance Targeted User where + target _ = "user" + +-- | Add comparison parameter +comparison :: Targeted a => Int64 -> Request f a -> Request f a +comparison n t = let z = target t in + add ("type" <> toText n) z <*> add ("value" <> toText n) (_query (unwrap t (R mempty mempty mempty)) M.! z) diff --git a/src/Lastfm/Response.hs b/src/Lastfm/Response.hs new file mode 100644 --- /dev/null +++ b/src/Lastfm/Response.hs @@ -0,0 +1,248 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Request sending and Response parsing +module Lastfm.Response + ( -- * Compute request signature + -- $sign + Secret(..) + , sign + -- * Perform requests + , Connection + , withConnection + , newConnection + , lastfm + , lastfm_ + , Supported + , Format(..) + -- ** Errors + , LastfmError(..) + , _LastfmBadResponse + , _LastfmEncodedError + , _LastfmHttpError +#ifdef TEST + , parse + , md5 +#endif + ) where + +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative +#endif +import Control.Exception (SomeException(..), Exception(..), catch) +import Control.Monad.IO.Class (MonadIO(liftIO)) +import Crypto.Hash (Digest, MD5, hash) +import Data.Aeson ((.:), Value(..), decode) +import Data.Aeson.Types (parseMaybe) +import qualified Data.ByteString.Lazy as Lazy +import qualified Data.ByteString as Strict +import Data.Map (Map) +import qualified Data.Map as M +import Data.Monoid +import Data.Profunctor (Choice, dimap, right') +import Data.String (IsString(..)) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.Read as T +import Data.Typeable (Typeable, cast) +import qualified Network.HTTP.Client as Http +import qualified Network.HTTP.Client.TLS as Http +import Text.XML (Document, parseLBS, def) +import Text.XML.Cursor + +import Lastfm.Internal + + +-- $sign +-- +-- The signature is required for every +-- authenticated API request. Basically, +-- every such request appends the md5 footprint +-- of its arguments to the query as +-- described at + + +-- | 'Supported' provides parsing for the chosen 'Format' +-- +-- 'JSON' is parsed to 'Value' type from aeson, while 'XML' +-- is parsed to 'Document' from xml-conduit +class Supported f r | f -> r, r -> f where + prepareRequest :: R f -> R f + parseResponseBody :: Lazy.ByteString -> Maybe r + parseResponseEncodedError :: r -> Maybe LastfmError + +instance Supported 'JSON Value where + prepareRequest r = r { _query = M.singleton "format" "json" `M.union` _query r } + parseResponseBody = decode + parseResponseEncodedError = parseMaybe $ \(Object o) -> do + code <- o .: "error" + msg <- o .: "message" + return (LastfmEncodedError code msg) + +instance Supported 'XML Document where + prepareRequest = id + parseResponseBody = either (const Nothing) Just . parseLBS def + parseResponseEncodedError doc = case fromDocument doc of + cur + | [mcode] <- cur $| element "lfm" >=> child >=> element "error" >=> attribute "code" + , Right (code, _) <- T.decimal mcode + , [msg] <- cur $| element "lfm" >=> child >=> element "error" >=> child >=> content + -> Just (LastfmEncodedError code (T.strip msg)) + | + otherwise -> Nothing + +parse :: Supported f r => Lazy.ByteString -> Either LastfmError r +parse body = case parseResponseBody body of + Just v + | Just e <- parseResponseEncodedError v -> Left e + | otherwise -> Right v + Nothing -> Left (LastfmBadResponse body) + +base :: R f +base = R + { _host = "http://ws.audioscrobbler.com/2.0/" + , _method = "GET" + , _query = mempty + } + + +-- | Different ways last.fm response can be unusable +data LastfmError = + -- | last.fm thinks it responded with something legible, but it really isn't + LastfmBadResponse Lazy.ByteString + -- | last.fm error code and message string + | LastfmEncodedError Int Text + -- | wrapped http-conduit exception + | LastfmHttpError Http.HttpException + deriving (Show, Typeable) + +-- | Admittedly, this isn't the best 'Eq' instance ever +-- but not having 'Eq' 'C.HttpException' does not leave much a choice +instance Eq LastfmError where + LastfmBadResponse bs == LastfmBadResponse bs' = bs == bs' + LastfmEncodedError e s == LastfmEncodedError e' t = e == e' && s == t + LastfmHttpError _ == LastfmHttpError _ = True + _ == _ = False + +instance Exception LastfmError where + fromException e@(SomeException se) + | Just e' <- fromException e = Just (LastfmHttpError e') + | otherwise = cast se + +class AsLastfmError t where + _LastfmError :: (Choice p, Applicative m) => p LastfmError (m LastfmError) -> p t (m t) + +instance AsLastfmError LastfmError where + _LastfmError = id + {-# INLINE _LastfmError #-} + +instance AsLastfmError SomeException where + _LastfmError = dimap (\e -> maybe (Left e) Right (fromException e)) (either pure (fmap toException)) . right' + {-# INLINE _LastfmError #-} + +-- | This is a @ Prism' 'LastfmError' 'Lazy.ByteString' @ in disguise +_LastfmBadResponse + :: (Choice p, Applicative m, AsLastfmError e) + => p Lazy.ByteString (m Lazy.ByteString) -> p e (m e) +_LastfmBadResponse = _LastfmError . dimap go (either pure (fmap LastfmBadResponse)) . right' where + go (LastfmBadResponse bs) = Right bs + go x = Left x + {-# INLINE go #-} +{-# INLINE _LastfmBadResponse #-} + +-- | This is a @ Prism' 'LastfmError' ('Int', 'String') @ in disguise +_LastfmEncodedError + :: (Choice p, Applicative m, AsLastfmError e) + => p (Int, Text) (m (Int, Text)) -> p e (m e) +_LastfmEncodedError = _LastfmError . dimap go (either pure (fmap (uncurry LastfmEncodedError))) . right' where + go (LastfmEncodedError n v) = Right (n, v) + go x = Left x + {-# INLINE go #-} +{-# INLINE _LastfmEncodedError #-} + +-- | This is a @ Prism' 'LastfmError' 'C.HttpException' @ in disguise +_LastfmHttpError + :: (Choice p, Applicative m, AsLastfmError e) + => p Http.HttpException (m Http.HttpException) -> p e (m e) +_LastfmHttpError = _LastfmError . dimap go (either pure (fmap LastfmHttpError)) . right' where + go (LastfmHttpError e) = Right e + go x = Left x + {-# INLINE go #-} +{-# INLINE _LastfmHttpError #-} + + +-- | Application secret +newtype Secret = Secret Text deriving (Show, Eq, Typeable) + +instance IsString Secret where + fromString = Secret . fromString + +-- | Sign the 'Request' with the 'Secret' so it's ready to be sent +sign :: Secret -> Request f Sign -> Request f Ready +sign s = coerce . (<* signature) + where + signature = wrap $ + \r@R { _query = q } -> r { _query = apiSig s . authToken $ q } + +authToken :: Map Text Text -> Map Text Text +authToken q = maybe q (M.delete "password") $ do + password <- M.lookup "password" q + username <- M.lookup "username" q + return (M.insert "authToken" (md5 (username <> md5 password)) q) + +apiSig :: Secret -> Map Text Text -> Map Text Text +apiSig (Secret s) q = M.insert "api_sig" (signer (foldr M.delete q ["format", "callback"])) q + where + signer = md5 . M.foldrWithKey (\k v xs -> k <> v <> xs) s + +-- | Get supplied string md5 hash hex representation +md5 :: Text -> Text +md5 = T.pack . show . (hash :: Strict.ByteString -> Digest MD5) . T.encodeUtf8 + + +-- | Lastfm connection manager +newtype Connection = Connection Http.Manager + +-- | Creating an HTTPS connection manager is expensive; it's advised to use +-- a single 'Connection' for all communications with last.fm +withConnection :: MonadIO m => (Connection -> m a) -> m a +withConnection f = f =<< newConnection + +-- | Create a 'Connection'. Note that there's no need to close the connection manually, +-- as it will be closed automatically when no longer in use, that is, all the requests have +-- been processed and it's about to be garbage collected. +newConnection :: MonadIO m => m Connection +newConnection = liftIO (fmap Connection (Http.newManager Http.tlsManagerSettings)) + +-- | Perform the 'Request' and parse the response +lastfm :: Supported f r => Connection -> Request f Ready -> IO (Either LastfmError r) +lastfm man = lastfmWith man parse . finalize + +-- | Perform the 'Request' ignoring any responses +lastfm_ :: Supported f r => Connection -> Request f Ready -> IO (Either LastfmError ()) +lastfm_ man = lastfmWith man (\_ -> Right ()) . finalize + +-- | Send the 'R' and parse the 'Response' with the supplied parser +lastfmWith + :: Supported f r + => Connection + -> (Lazy.ByteString -> Either LastfmError a) + -> R f + -> IO (Either LastfmError a) +lastfmWith (Connection man) p r = do + req <- Http.parseUrl (render r) + let req' = req + { Http.method = _method r + , Http.responseTimeout = Just 10000000 + } + p . Http.responseBody <$> Http.httpLbs req' man + `catch` + (return . Left) + +-- | Get the 'R' from the 'Request' +finalize :: Supported f r => Request f Ready -> R f +finalize x = (prepareRequest . unwrap x) base diff --git a/src/Lastfm/Tag.hs b/src/Lastfm/Tag.hs new file mode 100644 --- /dev/null +++ b/src/Lastfm/Tag.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Lastfm tag API +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Lastfm.Tag as Tag +-- @ +module Lastfm.Tag + ( getInfo, getSimilar, getTopAlbums, getTopArtists, getTopTags, getTopTracks + , getWeeklyArtistChart, getWeeklyChartList, search + ) where + +import Lastfm.Request + + +-- | Get the metadata for a tag +-- +-- Optional: language +-- +-- +getInfo :: Request f (Tag -> APIKey -> Ready) +getInfo = api "tag.getInfo" + + +-- | Search for tags similar to this one. Returns tags ranked by similarity, based on listening data. +-- +-- +getSimilar :: Request f (Tag -> APIKey -> Ready) +getSimilar = api "tag.getSimilar" + + +-- | Get the top albums tagged by this tag, ordered by tag count. +-- +-- Optional: 'limit', 'page' +-- +-- +getTopAlbums :: Request f (Tag -> APIKey -> Ready) +getTopAlbums = api "tag.getTopAlbums" + + +-- | Get the top artists tagged by this tag, ordered by tag count. +-- +-- Optional: 'limit', 'page' +-- +-- +getTopArtists :: Request f (Tag -> APIKey -> Ready) +getTopArtists = api "tag.getTopArtists" + + +-- | Fetches the top global tags on Last.fm, sorted by popularity (number of times used) +-- +-- +getTopTags :: Request f (APIKey -> Ready) +getTopTags = api "tag.getTopTags" + + +-- | Get the top tracks tagged by this tag, ordered by tag count. +-- +-- Optional: 'limit', 'page' +-- +-- +getTopTracks :: Request f (Tag -> APIKey -> Ready) +getTopTracks = api "tag.getTopTracks" + + +-- | Get an artist chart for a tag, for a given date range. +-- If no date range is supplied, it will return the most recent artist chart for this tag. +-- +-- Optional: 'from', 'to', 'limit' +-- +-- +getWeeklyArtistChart :: Request f (Tag -> APIKey -> Ready) +getWeeklyArtistChart = api "tag.getWeeklyArtistChart" + + +-- | Get a list of available charts for this tag, expressed as +-- date ranges which can be sent to the chart services. +-- +-- +getWeeklyChartList :: Request f (Tag -> APIKey -> Ready) +getWeeklyChartList = api "tag.getWeeklyChartList" + + +-- | Search for a tag by name. Returns matches sorted by relevance. +-- +-- Optional: 'limit', 'page' +-- +-- +search :: Request f (Tag -> APIKey -> Ready) +search = api "tag.search" diff --git a/src/Lastfm/Tasteometer.hs b/src/Lastfm/Tasteometer.hs new file mode 100644 --- /dev/null +++ b/src/Lastfm/Tasteometer.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Lastfm tasteometer API +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Lastfm.Tasteometer as Tasteometer +-- @ +module Lastfm.Tasteometer where + +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative +#endif + +import Lastfm.Request + + +-- | Get a Tasteometer score from two inputs, along with a list of shared artists. +-- If the input is a user some additional information is returned. +-- +-- Optional: 'limit' +-- +-- +compare :: (Targeted u, Targeted v) => Request f u -> Request f v -> Request f (APIKey -> Ready) +compare u v = api "tasteometer.compare" <* comparison 1 u <* comparison 2 v diff --git a/src/Lastfm/Track.hs b/src/Lastfm/Track.hs new file mode 100644 --- /dev/null +++ b/src/Lastfm/Track.hs @@ -0,0 +1,203 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Lastfm track API +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Lastfm.Track as Track +-- @ +module Lastfm.Track + ( ArtistTrackOrMBID + , addTags, ban, getBuyLinks, getCorrection, getFingerprintMetadata + , getInfo, getShouts, getSimilar, getTags, getTopFans + , getTopTags, love, removeTag, scrobble, item + , search, share, unban, unlove, updateNowPlaying + ) where + +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative +#endif +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as N + +import Lastfm.Internal (absorbQuery, indexedWith, wrap) +import Lastfm.Request + + +-- | Unify ('Artist' -> 'Track' -> …) and ('MBID' -> …) +class ArtistTrackOrMBID a + +instance ArtistTrackOrMBID (MBID -> APIKey -> Ready) +instance ArtistTrackOrMBID (Artist -> Track -> APIKey -> Ready) + + +-- | Tag a track using a list of user supplied tags. +-- +-- +addTags :: Request f (Artist -> Track -> [Tag] -> APIKey -> SessionKey -> Sign) +addTags = api "track.addTags" <* post + + +-- | Ban a track for a given user profile. +-- +-- +ban :: Request f (Artist -> Track -> APIKey -> SessionKey -> Sign) +ban = api "track.ban" <* post + + +-- | Get a list of Buy Links for a particular track. +-- +-- Optional: 'autocorrect' +-- +-- +getBuyLinks :: ArtistTrackOrMBID t => Request f (Country -> t) +getBuyLinks = api "track.getBuyLinks" + + +-- | Use the last.fm corrections data to check whether +-- the supplied track has a correction to a canonical track. +-- +-- +getCorrection :: Request f (Artist -> Track -> APIKey -> Ready) +getCorrection = api "track.getCorrection" + + +-- | Retrieve track metadata associated with a fingerprint id +-- generated by the Last.fm Fingerprinter. Returns track +-- elements, along with a 'rank' value between 0 and 1 reflecting the confidence for each match. +-- +-- +getFingerprintMetadata :: Request f (Fingerprint -> APIKey -> Ready) +getFingerprintMetadata = api "track.getFingerprintMetadata" + + +-- | Get the metadata for a track on Last.fm. +-- +-- Optional: 'autocorrect', 'username' +-- +-- +getInfo :: ArtistTrackOrMBID t => Request f t +getInfo = api "track.getInfo" + + +-- | Get shouts for this track. Also available as an rss feed. +-- +-- Optional: 'autocorrect', 'limit', 'page' +-- +-- +getShouts :: ArtistTrackOrMBID t => Request f t +getShouts = api "track.getShouts" + + +-- | Get the similar tracks for this track on Last.fm, based on listening data. +-- +-- Optional: 'autocorrect', 'limit' +-- +-- +getSimilar :: ArtistTrackOrMBID t => Request f t +getSimilar = api "track.getSimilar" + + +-- | Get the tags applied by an individual user to a track on Last.fm. +-- +-- Optional: 'autocorrect', 'user' +-- +-- +getTags :: ArtistTrackOrMBID t => Request f t +getTags = api "track.getTags" + + +-- | Get the top fans for this track on Last.fm, based on listening data. +-- +-- Optional: 'autocorrect' +-- +-- +getTopFans :: ArtistTrackOrMBID t => Request f t +getTopFans = api "track.getTopFans" + + +-- | Get the top tags for this track on Last.fm, ordered by tag count. +-- +-- Optional: 'autocorrect' +-- +-- +getTopTags :: ArtistTrackOrMBID t => Request f t +getTopTags = api "track.getTopTags" + + +-- | Love a track for a user profile. +-- +-- +love :: Request f (Artist -> Track -> APIKey -> SessionKey -> Sign) +love = api "track.love" <* post + + +-- | Remove a user's tag from a track. +-- +-- +removeTag :: Request f (Artist -> Track -> Tag -> APIKey -> SessionKey -> Sign) +removeTag = api "track.removeTag" <* post + + +-- | Add played tracks to the user profile. +-- +-- Scrobbles 50 first list elements +-- +-- +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) + +-- | What track to scrobble? +-- +-- Optional: 'album', 'albumArtist', 'chosenByUser', 'context', +-- 'duration', 'mbid', 'streamId', 'trackNumber' +item :: Request f (Artist -> Track -> Timestamp -> Scrobble) +item = wrap id + + +-- | Search for a track by track name. Returns track matches sorted by relevance. +-- +-- Optional: 'artist', 'limit', 'page' +-- +-- +search :: Request f (Track -> APIKey -> Ready) +search = api "track.search" + + +-- | Share a track twith one or more Last.fm users or other friends. +-- +-- Optional: 'public', 'message', 'recipient' +-- +-- +share :: Request f (Artist -> Track -> Recipient -> APIKey -> SessionKey -> Sign) +share = api "track.share" <* post + + +-- | Unban a track for a user profile. +-- +-- +unban :: Request f (Artist -> Track -> APIKey -> SessionKey -> Sign) +unban = api "track.unban" <* post + + +-- | Unlove a track for a user profile. +-- +-- +unlove :: Request f (Artist -> Track -> APIKey -> SessionKey -> Sign) +unlove = api "track.unlove" <* post + + +-- | Used to notify Last.fm that a user has started listening +-- to a track. Parameter names are case sensitive. +-- +-- Optional: 'album', 'albumArtist', 'context', +-- 'duration', 'mbid', 'trackNumber' +-- +-- +updateNowPlaying :: Request f (Artist -> Track -> APIKey -> SessionKey -> Sign) +updateNowPlaying = api "track.updateNowPlaying" <* post diff --git a/src/Lastfm/User.hs b/src/Lastfm/User.hs new file mode 100644 --- /dev/null +++ b/src/Lastfm/User.hs @@ -0,0 +1,253 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Lastfm user API +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Lastfm.User as User +-- @ +module Lastfm.User + ( getArtistTracks, getBannedTracks, getEvents, getFriends + , getInfo, getLovedTracks, getNeighbours, getNewReleases + , getPastEvents, getPersonalTags, getPlaylists, getRecentStations + , getRecentTracks, getRecommendedArtists, getRecommendedEvents + , getShouts, getTopAlbums, getTopArtists, getTopTags + , getTopTracks, getWeeklyAlbumChart, getWeeklyArtistChart + , getWeeklyChartList, getWeeklyTrackChart, shout + ) where + +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative +#endif + +import Lastfm.Request + + +-- | Get a list of tracks by a given artist scrobbled by this user +-- , including scrobble time. Can be limited to specific timeranges, defaults to all time. +-- +-- Optional: 'startTimestamp', 'page', 'endTimestamp' +-- +-- +getArtistTracks :: Request f (User -> Artist -> APIKey -> Ready) +getArtistTracks = api "user.getArtistTracks" + + +-- | Returns the tracks banned by the user +-- +-- Optional: 'limit', 'page' +-- +-- +getBannedTracks :: Request f (User -> APIKey -> Ready) +getBannedTracks = api "user.getBannedTracks" + + +-- | Get a list of upcoming events that this user is attending. +-- Easily integratable into calendars, using the ical standard (see 'more formats' section below). +-- +-- Optional: 'page', 'festivalsonly', 'limit' +-- +-- +getEvents :: Request f (User -> APIKey -> Ready) +getEvents = api "user.getEvents" + + +-- | Get a list of the user's friends on Last.fm. +-- +-- Optional: 'recenttracks', 'limit', 'page' +-- +-- +getFriends :: Request f (User -> APIKey -> Ready) +getFriends = api "user.getFriends" + + +-- | Get information about a user profile. +-- +-- +getInfo :: Request f (User -> APIKey -> Ready) +getInfo = api "user.getInfo" + + +-- | Get the last 50 tracks loved by a user. +-- +-- Optional: 'limit', 'page' +-- +-- +getLovedTracks :: Request f (User -> APIKey -> Ready) +getLovedTracks = api "user.getLovedTracks" + + +-- | Get a list of a user's neighbours on Last.fm. +-- +-- Optional: 'limit' +-- +-- +getNeighbours :: Request f (User -> APIKey -> Ready) +getNeighbours = api "user.getNeighbours" + + +-- | Gets a list of forthcoming releases based on a user's musical taste. +-- +-- Optional: 'userecs' +-- +-- +getNewReleases :: Request f (User -> APIKey -> Ready) +getNewReleases = api "user.getNewReleases" + + +-- | Get a paginated list of all events a user has attended in the past. +-- +-- Optional: 'page', 'limit' +-- +-- +getPastEvents :: Request f (User -> APIKey -> Ready) +getPastEvents = api "user.getPastEvents" + + +-- | Get the user's personal tags +-- +-- Optional: 'taggingtype', 'limit', 'page' +-- +-- +getPersonalTags :: Request f (User -> Tag -> TaggingType -> APIKey -> Ready) +getPersonalTags = api "user.getPersonalTags" + + +-- | Get a list of a user's playlists on Last.fm. +-- +-- +getPlaylists :: Request f (User -> APIKey -> Ready) +getPlaylists = api "user.getPlaylists" + + +-- | Get a list of the recent Stations listened to by this user. +-- +-- Optional: 'limit', 'page' +-- +-- +getRecentStations :: Request f (User -> APIKey -> SessionKey -> Sign) +getRecentStations = api "user.getRecentStations" + + +-- | Get a list of the recent tracks listened to by this user. +-- Also includes the currently playing track with the nowplaying="true" +-- attribute if the user is currently listening. +-- +-- Optional: 'limit', 'page', 'from', 'extended', 'to' +-- +-- +getRecentTracks :: Request f (User -> APIKey -> Ready) +getRecentTracks = api "user.getRecentTracks" + + +-- | Get Last.fm artist recommendations for a user +-- +-- Optional: 'page', 'limit' +-- +-- +getRecommendedArtists :: Request f (APIKey -> SessionKey -> Sign) +getRecommendedArtists = api "user.getRecommendedArtists" + + +-- | Get a paginated list of all events recommended to a user by Last.fm, based on their listening profile. +-- +-- Optional: 'limit', 'page', 'latitude', 'longitude', 'festivalsonly', 'country' +-- +-- +getRecommendedEvents :: Request f (APIKey -> SessionKey -> Sign) +getRecommendedEvents = api "user.getRecommendedEvents" + + +-- | Get shouts for this user. Also available as an rss feed. +-- +-- Optional: 'page', 'limit' +-- +-- +getShouts :: Request f (User -> APIKey -> Ready) +getShouts = api "user.getShouts" + + +-- | Get the top albums listened to by a user. +-- You can stipulate a time period. Sends the overall chart by default. +-- +-- Optional: 'period', 'limit', 'page' +-- +-- +getTopAlbums :: Request f (User -> APIKey -> Ready) +getTopAlbums = api "user.getTopAlbums" + + +-- | Get the top artists listened to by a user. +-- You can stipulate a time period. Sends the overall chart by default. +-- +-- Optional: 'period', 'limit', 'page' +-- +-- +getTopArtists :: Request f (User -> APIKey -> Ready) +getTopArtists = api "user.getTopArtists" + + +-- | Get the top tags used by this user. +-- +-- Optional: 'limit' +-- +-- +getTopTags :: Request f (User -> APIKey -> Ready) +getTopTags = api "user.getTopTags" + + +-- | Get the top tracks listened to by a user. +-- You can stipulate a time period. Sends the overall chart by default. +-- +-- Optional: 'period', 'limit', 'page' +-- +-- +getTopTracks :: Request f (User -> APIKey -> Ready) +getTopTracks = api "user.getTopTracks" + + +-- | Get an album chart for a user profile, for a given date range. +-- If no date range is supplied, it will return the most recent album chart for this user. +-- +-- Optional: 'from', 'to' +-- +-- +getWeeklyAlbumChart :: Request f (User -> APIKey -> Ready) +getWeeklyAlbumChart = api "user.getWeeklyAlbumChart" + + +-- | Get an artist chart for a user profile, for a given date range. +-- If no date range is supplied, it will return the most recent artist chart for this user. +-- +-- Optional: 'from', 'to' +-- +-- +getWeeklyArtistChart :: Request f (User -> APIKey -> Ready) +getWeeklyArtistChart = api "user.getWeeklyArtistChart" + + +-- | Get a list of available charts for this user, expressed as +-- date ranges which can be sent to the chart services. +-- +-- +getWeeklyChartList :: Request f (User -> APIKey -> Ready) +getWeeklyChartList = api "user.getWeeklyChartList" + + +-- | Get a track chart for a user profile, for a given date range. +-- If no date range is supplied, it will return the most recent track chart for this user. +-- +-- Optional: 'from', 'to' +-- +-- +getWeeklyTrackChart :: Request f (User -> APIKey -> Ready) +getWeeklyTrackChart = api "user.getWeeklyTrackChart" + + +-- | Shout on this user's shoutbox +-- +-- +shout :: Request f (User -> Message -> APIKey -> SessionKey -> Sign) +shout = api "user.shout" <* post diff --git a/src/Lastfm/Venue.hs b/src/Lastfm/Venue.hs new file mode 100644 --- /dev/null +++ b/src/Lastfm/Venue.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Lastfm venue API +-- +-- This module is intended to be imported qualified: +-- +-- @ +-- import qualified Lastfm.Venue as Venue +-- @ +module Lastfm.Venue + ( getEvents, getPastEvents, search + ) where + +import Lastfm.Request + + +-- | Get a list of upcoming events at this venue. +-- +-- Optional: 'festivalsonly' +-- +-- +getEvents :: Request f (Venue -> APIKey -> Ready) +getEvents = api "venue.getEvents" + + +-- | Get a paginated list of all the events held at this venue in the past. +-- +-- Optional: 'festivalsonly', 'page', 'limit' +-- +-- +getPastEvents :: Request f (Venue -> APIKey -> Ready) +getPastEvents = api "venue.getPastEvents" + + +-- | Search for a venue by venue name +-- +-- Optional: 'page', 'limit', 'country' +-- +-- +search :: Request f (VenueName -> APIKey -> Ready) +search = api "venue.search" diff --git a/src/Network/Lastfm.hs b/src/Network/Lastfm.hs deleted file mode 100644 --- a/src/Network/Lastfm.hs +++ /dev/null @@ -1,14 +0,0 @@ --- | Lastfm API interface -module Network.Lastfm - ( -- * Utilities for constructing requests - module Network.Lastfm.Request - -- * Utilities for signing and sending requests - , module Network.Lastfm.Response - -- * Control.Applicative is re-exported for convenience - , module Control.Applicative - ) where - -import Control.Applicative - -import Network.Lastfm.Request -import Network.Lastfm.Response diff --git a/src/Network/Lastfm/Album.hs b/src/Network/Lastfm/Album.hs deleted file mode 100644 --- a/src/Network/Lastfm/Album.hs +++ /dev/null @@ -1,117 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} --- | Lastfm album API --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Network.Lastfm.Album as Album --- @ -module Network.Lastfm.Album - ( ArtistAlbumOrMBID - , addTags, getBuyLinks, getInfo, getShouts - , getTags, getTopTags, removeTag, search, share - ) where - -import Control.Applicative - -import Network.Lastfm.Request - - --- | Unify ('Artist' -> 'Album' -> …) and ('MBID' -> …) -class ArtistAlbumOrMBID r a | a -> r - -instance ArtistAlbumOrMBID r (MBID -> APIKey -> r) -instance ArtistAlbumOrMBID r (Artist -> Album -> APIKey -> r) - - --- | Tag an album using a list of user supplied tags. --- --- -addTags :: Request f (Artist -> Album -> [Tag] -> APIKey -> SessionKey -> Sign) -addTags = api "album.addTags" <* post -{-# INLINE addTags #-} - - --- | Get a list of Buy Links for a particular Album. It is --- required that you supply either the artist and track params or the mbid parameter. --- --- Optional: 'autocorrect' --- --- -getBuyLinks :: ArtistAlbumOrMBID Ready a => Request f (Country -> a) -getBuyLinks = api "album.getBuyLinks" -{-# INLINE getBuyLinks #-} - - --- | Get the metadata for an album on Last.fm using the album name or --- a musicbrainz id. See playlist.fetch on how to get the album playlist. --- --- Optional: 'autocorrect', 'username', 'language' --- --- -getInfo :: ArtistAlbumOrMBID Ready a => Request f a -getInfo = api "album.getInfo" -{-# INLINE getInfo #-} - - --- | Get shouts for this album. --- --- Optional: 'autocorrect', 'limit', 'page' --- --- -getShouts :: ArtistAlbumOrMBID Ready a => Request f a -getShouts = api "album.getShouts" -{-# INLINE getShouts #-} - - --- | Get the tags applied by an individual user to an album on Last.fm. --- --- Optional: 'autocorrect', 'user' --- --- -getTags :: ArtistAlbumOrMBID r a => Request f a -getTags = api "album.getTags" -{-# INLINE getTags #-} - - --- | Get the top tags for an album on Last.fm, ordered by popularity. --- --- Optional: 'autocorrect' --- --- -getTopTags :: ArtistAlbumOrMBID Ready a => Request f a -getTopTags = api "album.getTopTags" -{-# INLINE getTopTags #-} - - --- | Remove a user's tag from an album. --- --- -removeTag :: Request f (Artist -> Album -> Tag -> APIKey -> SessionKey -> Sign) -removeTag = api "album.removeTag" <* post -{-# INLINE removeTag #-} - - --- | Search for an album by name. Returns album matches sorted by relevance. --- --- Optional: 'limit', 'page' --- --- -search :: Request f (Album -> APIKey -> Ready) -search = api "album.search" -{-# INLINE search #-} - - --- | Share an album with one or more Last.fm users or other friends. --- --- Optional: 'public', 'message', 'recipient' --- --- -share :: Request f (Album -> Artist -> Recipient -> APIKey -> SessionKey -> Sign) -share = api "album.share" <* post -{-# INLINE share #-} diff --git a/src/Network/Lastfm/Artist.hs b/src/Network/Lastfm/Artist.hs deleted file mode 100644 --- a/src/Network/Lastfm/Artist.hs +++ /dev/null @@ -1,198 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} --- | Lastfm artist API --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Network.Lastfm.Artist as Artist --- @ -module Network.Lastfm.Artist - ( ArtistOrMBID - , addTags, getCorrection, getEvents, getInfo - , getPastEvents, getPodcast, getShouts - , getSimilar, getTags, getTopAlbums - , getTopFans, getTopTags, getTopTracks - , removeTag, search, share, shout - ) where - -import Control.Applicative - -import Network.Lastfm.Request - --- | Unify ('Artist' -> …) and ('MBID' -> …) -class ArtistOrMBID r a - -instance ArtistOrMBID r MBID -instance ArtistOrMBID r Artist - - --- | Tag an artist with one or more user supplied tags. --- --- -addTags :: Request f (Artist -> [Tag] -> APIKey -> SessionKey -> Sign) -addTags = api "artist.addTags" <* post -{-# INLINE addTags #-} - - --- | Use the last.fm corrections data to check whether the --- supplied artist has a correction to a canonical artist --- --- -getCorrection :: Request f (Artist -> APIKey -> Ready) -getCorrection = api "artist.getCorrection" -{-# INLINE getCorrection #-} - - --- | Get a list of upcoming events for this artist. Easily --- integratable into calendars, using the ical standard (see feeds section below). --- --- Optional: 'autocorrect', 'limit', 'pages', 'festivalsonly' --- --- -getEvents :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) -getEvents = api "artist.getEvents" -{-# INLINE getEvents #-} - - --- | Get the metadata for an artist. Includes biography. --- --- Optional: 'language', 'autocorrect', 'username' --- --- -getInfo :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) -getInfo = api "artist.getInfo" -{-# INLINE getInfo #-} - - --- | Get a paginated list of all the events this artist has played at in the past. --- --- Optional: 'page', 'autocorrect', 'limit' --- --- -getPastEvents :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) -getPastEvents = api "artist.getPastEvents" -{-# INLINE getPastEvents #-} - - --- | Get a podcast of free mp3s based on an artist --- --- Optional: 'autocorrect' --- --- -getPodcast :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) -getPodcast = api "artist.getPodcast" -{-# INLINE getPodcast #-} - - --- | Get shouts for this artist. Also available as an rss feed. --- --- Optional:'autocorrect', 'limit', 'page' --- --- -getShouts :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) -getShouts = api "artist.getShouts" -{-# INLINE getShouts #-} - - --- | Get all the artists similar to this artist --- --- Optional: 'limit', 'autocorrect' --- --- -getSimilar :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) -getSimilar = api "artist.getSimilar" -{-# INLINE getSimilar #-} - - --- | Get the tags applied by an individual user to an artist on Last.fm. --- If accessed as an authenticated service /and/ you don't supply a --- user parameter then this service will return tags for --- the authenticated user. To retrieve the list of top tags applied --- to an artist by all users use 'Network.Lastfm.Artist.getTopTags'. --- --- Optional: 'user', 'autocorrect' --- --- -getTags :: ArtistOrMBID r a => Request f (a -> APIKey -> r) -getTags = api "artist.getTags" -{-# INLINE getTags #-} - - --- | Get the top albums for an artist on Last.fm, ordered by popularity. --- --- Optional: 'autocorrect', 'page', 'limit' --- --- -getTopAlbums :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) -getTopAlbums = api "artist.getTopAlbums" -{-# INLINE getTopAlbums #-} - - --- | Get the top fans for an artist on Last.fm, based on listening data. --- --- Optional: 'autocorrect' --- --- -getTopFans :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) -getTopFans = api "artist.getTopFans" -{-# INLINE getTopFans #-} - - --- | Get the top tags for an artist on Last.fm, ordered by popularity. --- --- Optional: 'autocorrect' --- --- -getTopTags :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) -getTopTags = api "artist.getTopTags" -{-# INLINE getTopTags #-} - - --- | Get the top tracks by an artist on Last.fm, ordered by popularity --- --- Optional: 'autocorrect', 'page', 'limit' --- --- -getTopTracks :: ArtistOrMBID Ready a => Request f (a -> APIKey -> Ready) -getTopTracks = api "artist.getTopTracks" -{-# INLINE getTopTracks #-} - - --- | Remove a user's tag from an artist. --- --- -removeTag :: Request f (Artist -> Tag -> APIKey -> SessionKey -> Sign) -removeTag = api "artist.removeTag" <* post -{-# INLINE removeTag #-} - - --- | Search for an artist by name. Returns artist matches sorted by relevance. --- --- Optional: 'limit', 'page' --- --- -search :: Request f (Artist -> APIKey -> Ready) -search = api "artist.search" -{-# INLINE search #-} - - --- | Share an artist with Last.fm users or other friends. --- --- Optional: 'message', 'public' --- --- -share :: Request f (Artist -> Recipient -> APIKey -> SessionKey -> Sign) -share = api "artist.share" <* post -{-# INLINE share #-} - - --- | Shout in this artist's shoutbox --- --- -shout :: Request f (Artist -> Message -> APIKey -> SessionKey -> Sign) -shout = api "artist.shout" <* post -{-# INLINE shout #-} diff --git a/src/Network/Lastfm/Authentication.hs b/src/Network/Lastfm/Authentication.hs deleted file mode 100644 --- a/src/Network/Lastfm/Authentication.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} --- | Lastfm authentication procedure helpers --- --- Basically, lastfm provides 3 ways to authenticate user: --- --- - web application - --- --- - desktop application - --- --- - modile application - --- --- 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 --- >>> con <- newConnection --- >>> lastfm con $ getToken <*> apiKey "__API_KEY__" <* json --- Right (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 con $ sign "__SECRET__" $ getSession <*> token "__TOKEN__" <*> apiKey "__API_KEY__" <* json --- Right (Object (fromList [("session",Object (fromList [("subscriber",String "0"),("key",String "__SESSION_KEY__"),("name",String "__USER__")]))])) -module Network.Lastfm.Authentication - ( -- * Helpers - getToken, getSession, getMobileSession - , link - ) where - -import Control.Applicative ((<*)) -import Data.Monoid - -import Network.Lastfm.Internal -import Network.Lastfm.Request - - --- | Get authorization token -getToken :: Request f (APIKey -> Ready) -getToken = api "auth.getToken" -{-# INLINE getToken #-} - - --- | Get session key -getMobileSession :: Request f (Username -> Password -> APIKey -> Sign) -getMobileSession = api "auth.getMobileSession" <* post -{-# INLINE getMobileSession #-} - - --- | Get session key -getSession :: Request f (Token -> APIKey -> Sign) -getSession = api "auth.getSession" -{-# INLINE getSession #-} - - --- | Construct link user should follow to approve application -link :: Request f a -> String -link q = render . unwrap q $ R - { _host = "http://www.last.fm/api/auth/" - , _method = mempty - , _query = mempty - } -{-# INLINE link #-} diff --git a/src/Network/Lastfm/Chart.hs b/src/Network/Lastfm/Chart.hs deleted file mode 100644 --- a/src/Network/Lastfm/Chart.hs +++ /dev/null @@ -1,75 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} --- | Lastfm chart API --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Network.Lastfm.Chart as Chart --- @ -module Network.Lastfm.Chart - ( getHypedArtists, getHypedTracks, getLovedTracks - , getTopArtists, getTopTags, getTopTracks - ) where - -import Network.Lastfm.Request - - --- | Get the hyped artists chart --- --- Optional: 'page', 'limit' --- --- -getHypedArtists :: Request f (APIKey -> Ready) -getHypedArtists = api "chart.getHypedArtists" -{-# INLINE getHypedArtists #-} - - --- | Get the top artists chart --- --- Optional: 'page', 'limit' --- --- -getHypedTracks :: Request f (APIKey -> Ready) -getHypedTracks = api "chart.getHypedTracks" -{-# INLINE getHypedTracks #-} - - --- | Get the most loved tracks chart --- --- Optional: 'page', 'limit' --- --- -getLovedTracks :: Request f (APIKey -> Ready) -getLovedTracks = api "chart.getLovedTracks" -{-# INLINE getLovedTracks #-} - - --- | Get the top artists chart --- --- Optional: 'page', 'limit' --- --- -getTopArtists :: Request f (APIKey -> Ready) -getTopArtists = api "chart.getTopArtists" -{-# INLINE getTopArtists #-} - - --- | Get the top artists chart --- --- Optional: 'page', 'limit' --- --- -getTopTags :: Request f (APIKey -> Ready) -getTopTags = api "chart.getTopTags" -{-# INLINE getTopTags #-} - - --- | Get the top tracks chart --- --- Optional: 'page', 'limit' --- --- -getTopTracks :: Request f (APIKey -> Ready) -getTopTracks = api "chart.getTopTracks" -{-# INLINE getTopTracks #-} diff --git a/src/Network/Lastfm/Event.hs b/src/Network/Lastfm/Event.hs deleted file mode 100644 --- a/src/Network/Lastfm/Event.hs +++ /dev/null @@ -1,70 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} --- | Lastfm event API --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Network.Lastfm.Event as Event --- @ -module Network.Lastfm.Event - ( attend, getAttendees, getInfo, getShouts, share, shout - ) where - -import Control.Applicative - -import Network.Lastfm.Request - - --- | Set a user's attendance status for an event. --- --- -attend :: Request f (Event -> Status -> APIKey -> SessionKey -> Sign) -attend = api "event.attend" <* post -{-# INLINE attend #-} - - --- | Get a list of attendees for an event. --- --- Optional: 'page', 'limit' --- --- -getAttendees :: Request f (Event -> APIKey -> Ready) -getAttendees = api "event.getAttendees" -{-# INLINE getAttendees #-} - - --- | Get the metadata for an event on Last.fm. Includes attendance and lineup information. --- --- -getInfo :: Request f (Event -> APIKey -> Ready) -getInfo = api "event.getInfo" -{-# INLINE getInfo #-} - - --- | Get shouts for this event. Also available as an rss feed. --- --- Optional: 'page', 'limit' --- --- -getShouts :: Request f (Event -> APIKey -> Ready) -getShouts = api "event.getShouts" -{-# INLINE getShouts #-} - - --- | Share an event with one or more Last.fm users or other friends. --- --- Optional: 'public', 'message' --- --- -share :: Request f (Event -> Recipient -> APIKey -> SessionKey -> Sign) -share = api "event.share" <* post -{-# INLINE share #-} - - --- | Shout in this event's shoutbox --- --- -shout :: Request f (Event -> Message -> APIKey -> SessionKey -> Sign) -shout = api "event.shout" <* post -{-# INLINE shout #-} diff --git a/src/Network/Lastfm/Geo.hs b/src/Network/Lastfm/Geo.hs deleted file mode 100644 --- a/src/Network/Lastfm/Geo.hs +++ /dev/null @@ -1,126 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} --- | Lastfm geo API --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Network.Lastfm.Geo as Geo --- @ -module Network.Lastfm.Geo - ( getEvents, getMetroArtistChart, getMetroHypeArtistChart - , getMetroHypeTrackChart, getMetroTrackChart, getMetroUniqueArtistChart - , getMetroUniqueTrackChart, getMetroWeeklyChartlist, getMetros - , getTopArtists, getTopTracks - ) where - -import Network.Lastfm.Request - - --- | Get all events in a specific location by country or city name. --- --- Optional: 'longitude', 'latitude', 'location', 'distance', 'page', 'tag', 'festivalsonly', 'limit' --- --- -getEvents :: Request f (APIKey -> Ready) -getEvents = api "geo.getEvents" -{-# INLINE getEvents #-} - - --- | Get a chart of artists for a metro --- --- Optional: 'start', 'end', 'page', 'limit' --- --- -getMetroArtistChart :: Request f (Metro -> Country -> APIKey -> Ready) -getMetroArtistChart = api "geo.getMetroArtistChart" -{-# INLINE getMetroArtistChart #-} - - --- | Get a chart of hyped (up and coming) artists for a metro --- --- Optional: 'start', 'end', 'page', 'limit' --- --- -getMetroHypeArtistChart :: Request f (Metro -> Country -> APIKey -> Ready) -getMetroHypeArtistChart = api "geo.getMetroHypeArtistChart" -{-# INLINE getMetroHypeArtistChart #-} - - --- | Get a chart of tracks for a metro --- --- Optional: 'start', 'end', 'page', 'limit' --- --- -getMetroHypeTrackChart :: Request f (Metro -> Country -> APIKey -> Ready) -getMetroHypeTrackChart = api "geo.getMetroHypeTrackChart" -{-# INLINE getMetroHypeTrackChart #-} - - --- | Get a chart of tracks for a metro --- --- Optional: 'start', 'end', 'page', 'limit' --- --- -getMetroTrackChart :: Request f (Metro -> Country -> APIKey -> Ready) -getMetroTrackChart = api "geo.getMetroTrackChart" -{-# INLINE getMetroTrackChart #-} - - --- | Get a chart of the artists which make that metro unique --- --- Optional: 'start', 'end', 'page', 'limit' --- --- -getMetroUniqueArtistChart :: Request f (Metro -> Country -> APIKey -> Ready) -getMetroUniqueArtistChart = api "geo.getMetroUniqueArtistChart" -{-# INLINE getMetroUniqueArtistChart #-} - - --- | Get a chart of tracks for a metro --- --- Optional: 'start', 'end', 'page', 'limit' --- --- -getMetroUniqueTrackChart :: Request f (Metro -> Country -> APIKey -> Ready) -getMetroUniqueTrackChart = api "geo.getMetroUniqueTrackChart" -{-# INLINE getMetroUniqueTrackChart #-} - - --- | Get a list of available chart periods for this metro, --- expressed as date ranges which can be sent to the chart services. --- --- -getMetroWeeklyChartlist :: Request f (Metro -> APIKey -> Ready) -getMetroWeeklyChartlist = api "geo.getMetroWeeklyChartlist" -{-# INLINE getMetroWeeklyChartlist #-} - - --- | Get a list of valid countries and metros for use in the other webservices --- --- Optional: 'country' --- --- -getMetros :: Request f (APIKey -> Ready) -getMetros = api "geo.getMetros" -{-# INLINE getMetros #-} - - --- | Get the most popular artists on Last.fm by country --- --- Optional: 'limit', 'page' --- --- -getTopArtists :: Request f (Country -> APIKey -> Ready) -getTopArtists = api "geo.getTopArtists" -{-# INLINE getTopArtists #-} - - --- | Get the most popular tracks on Last.fm last week by country --- --- Optional: 'limit', 'page' --- --- -getTopTracks :: Request f (Country -> APIKey -> Ready) -getTopTracks = api "geo.getTopTracks" -{-# INLINE getTopTracks #-} diff --git a/src/Network/Lastfm/Group.hs b/src/Network/Lastfm/Group.hs deleted file mode 100644 --- a/src/Network/Lastfm/Group.hs +++ /dev/null @@ -1,74 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} --- | Lastfm group API --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Network.Lastfm.Group as Group --- @ -module Network.Lastfm.Group - ( getHype, getMembers, getWeeklyAlbumChart, getWeeklyArtistChart, getWeeklyChartList, getWeeklyTrackChart - ) where - -import Network.Lastfm.Request - - --- | Get the hype list for a group --- --- -getHype :: Request f (Group -> APIKey -> Ready) -getHype = api "group.getHype" -{-# INLINE getHype #-} - - --- | Get a list of members for this group. --- --- Optional: 'page', 'limit' --- --- -getMembers :: Request f (Group -> APIKey -> Ready) -getMembers = api "group.getMembers" -{-# INLINE getMembers #-} - - --- | Get an album chart for a group, for a given date range. --- If no date range is supplied, it will return the most recent album chart for this group. --- --- Optional: 'from', 'to' --- --- -getWeeklyAlbumChart :: Request f (Group -> APIKey -> Ready) -getWeeklyAlbumChart = api "group.getWeeklyAlbumChart" -{-# INLINE getWeeklyAlbumChart #-} - - --- | Get an artist chart for a group, for a given date range. --- If no date range is supplied, it will return the most recent album chart for this group. --- --- Optional: 'from', 'to' --- --- -getWeeklyArtistChart :: Request f (Group -> APIKey -> Ready) -getWeeklyArtistChart = api "group.getWeeklyArtistChart" -{-# INLINE getWeeklyArtistChart #-} - - --- | Get a list of available charts for this group, expressed as --- date ranges which can be sent to the chart services. --- --- -getWeeklyChartList :: Request f (Group -> APIKey -> Ready) -getWeeklyChartList = api "group.getWeeklyChartList" -{-# INLINE getWeeklyChartList #-} - - --- | Get a track chart for a group, for a given date range. --- If no date range is supplied, it will return the most recent album chart for this group. --- --- Optional: 'from', 'to' --- --- -getWeeklyTrackChart :: Request f (Group -> APIKey -> Ready) -getWeeklyTrackChart = api "group.getWeeklyTrackChart" -{-# INLINE getWeeklyTrackChart #-} diff --git a/src/Network/Lastfm/Internal.hs b/src/Network/Lastfm/Internal.hs deleted file mode 100644 --- a/src/Network/Lastfm/Internal.hs +++ /dev/null @@ -1,163 +0,0 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 708 -{-# LANGUAGE AutoDeriveTypeable #-} -#endif -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE KindSignatures #-} --- | liblastfm internals --- --- You shouldn't need to import this module unless you are doing something interesting. -module Network.Lastfm.Internal - ( Request(..) - , Format(..) - , Ready - , Sign - , R(..) - , wrap - , unwrap - , render - , coerce - , absorbQuery - , indexedWith - -- * Lenses - , host - , method - , query - ) where - -import Control.Applicative -import Data.ByteString (ByteString) -import Data.Foldable (Foldable(..)) -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as M -import Data.Monoid -import Data.Serialize (Serialize(..)) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import Data.Traversable (Traversable(..)) -import Network.URI (escapeURIChar, isUnreserved) - - --- | Lastfm API request data type --- --- low-level representation -data R (f :: Format) = R - { _host :: {-# UNPACK #-} !Text - , _method :: {-# UNPACK #-} !ByteString - , _query :: !(Map Text Text) - } - --- | Response format: either JSON or XML -data Format = JSON | XML - --- | Request that is ready to be sent -data Ready - --- | Request that requires signing procedure -data Sign - - --- | Lastfm API request data type --- --- @a@ is the authentication state. Can be 'Ready', which means this 'Request' is --- ready to be sent, or 'Sign', if the request signature hasn't been computed yet --- --- @f@ is the response format (liblastfm supports both 'JSON' and 'XML') -newtype Request f a = Request { unRequest :: Const (Dual (Endo (R f))) a } - -instance Functor (Request f) where - fmap f (Request x) = Request (fmap f x) - {-# INLINE fmap #-} - -instance Applicative (Request f) where - pure x = Request (pure x) - Request f <*> Request x = Request (f <*> x) - {-# INLINE (<*>) #-} - -instance Foldable (Request f) where - foldMap _ (Request _) = mempty -- not sure why this instance isn't in base - {-# INLINE foldMap #-} - -instance Traversable (Request f) where - traverse _ (Request (Const x)) = pure (Request (Const x)) -- and that - {-# INLINE traverse #-} - - -coerce :: Request f a -> Request f b -coerce (Request (Const x)) = Request (Const x) -{-# INLINE coerce #-} - - --- | Construct String from request for networking -render :: R f -> String -render R { _host = h, _query = q } = - T.unpack $ mconcat [h, "?", argie q] - where - argie = T.intercalate "&" . M.foldrWithKey (\k v m -> T.concat [escape k, "=", escape v] : m) [] - - escape = T.concatMap (T.pack . escapeURIChar isUnreserved) - - --- | Wrapping to interesting 'Monoid' ('R' -> 'R') instance -wrap :: (R f -> R f) -> Request f a -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 - -instance Serialize (R f) where - put r = do - put $ T.encodeUtf8 (_host r) - put $ _method r - put $ bimap T.encodeUtf8 T.encodeUtf8 (_query r) - get = do - h <- T.decodeUtf8 <$> get - m <- get - q <- bimap T.decodeUtf8 T.decodeUtf8 <$> get - return R { _host = h, _method = m, _query = q } - -bimap :: (Ord s, Ord t) => (s -> t) -> (a -> b) -> Map s a -> Map t b -bimap f g = M.mapKeys f . M.map g -{-# INLINE bimap #-} - - --- | 'Request' '_host' -host :: Functor f => (Text -> f Text) -> R h -> f (R h) -host f r@R { _host = h } = (\h' -> r { _host = h' }) <$> f h -{-# INLINE host #-} - --- | 'Request' HTTP '_method' -method :: Functor f => (ByteString -> f ByteString) -> R h -> f (R h) -method f r@R { _method = m } = (\m' -> r { _method = m' }) <$> f m -{-# INLINE method #-} - --- | 'Request' '_query' string -query :: Functor f => (Map Text Text -> f (Map Text Text)) -> R h -> f (R h) -query f r@R { _query = q } = (\q' -> r { _query = q' }) <$> f q -{-# INLINE query #-} diff --git a/src/Network/Lastfm/Library.hs b/src/Network/Lastfm/Library.hs deleted file mode 100644 --- a/src/Network/Lastfm/Library.hs +++ /dev/null @@ -1,125 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} --- | Lastfm library API --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Network.Lastfm.Library as Library --- @ -module Network.Lastfm.Library - ( 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 :: 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 :: 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 --- --- -addTrack :: Request f (Artist -> Track -> APIKey -> SessionKey -> Sign) -addTrack = api "library.addTrack" <* post -{-# INLINE addTrack #-} - - --- | A paginated list of all the albums in a user's library, with play counts and tag counts. --- --- Optional: 'artist', 'limit', 'page' --- --- -getAlbums :: Request f (User -> APIKey -> Ready) -getAlbums = api "library.getAlbums" -{-# INLINE getAlbums #-} - - --- | A paginated list of all the artists in a user's library, with play counts and tag counts. --- --- Optional: 'limit', 'page' --- --- -getArtists :: Request f (User -> APIKey -> Ready) -getArtists = api "library.getArtists" -{-# INLINE getArtists #-} - - --- | A paginated list of all the tracks in a user's library, with play counts and tag counts. --- --- Optional: 'artist', 'album', 'page', 'limit' --- --- -getTracks :: Request f (User -> APIKey -> Ready) -getTracks = api "library.getTracks" -{-# INLINE getTracks #-} - - --- | Remove an album from a user's Last.fm library --- --- -removeAlbum :: Request f (Artist -> Album -> APIKey -> SessionKey -> Sign) -removeAlbum = api "library.removeAlbum" <* post -{-# INLINE removeAlbum #-} - - --- | Remove an artist from a user's Last.fm library --- --- -removeArtist :: Request f (Artist -> APIKey -> SessionKey -> Sign) -removeArtist = api "library.removeArtist" <* post -{-# INLINE removeArtist #-} - - --- | Remove a scrobble from a user's Last.fm library --- --- -removeScrobble :: Request f (Artist -> Track -> Timestamp -> APIKey -> SessionKey -> Sign) -removeScrobble = api "library.removeScrobble" <* post -{-# INLINE removeScrobble #-} - - --- | Remove a track from a user's Last.fm library --- --- -removeTrack :: Request f (Artist -> Track -> APIKey -> SessionKey -> Sign) -removeTrack = api "library.removeTrack" <* post -{-# INLINE removeTrack #-} diff --git a/src/Network/Lastfm/Playlist.hs b/src/Network/Lastfm/Playlist.hs deleted file mode 100644 --- a/src/Network/Lastfm/Playlist.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} --- | Lastfm playlist API --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Network.Lastfm.Playlist as Playlist --- @ -module Network.Lastfm.Playlist - ( addTrack, create - ) where - -import Control.Applicative - -import Network.Lastfm.Request - - --- | Add a track to a Last.fm user's playlist --- --- -addTrack :: Request f (Playlist -> Artist -> Track -> APIKey -> SessionKey -> Sign) -addTrack = api "playlist.addTrack" <* post -{-# INLINE addTrack #-} - - --- | Create a Last.fm playlist on behalf of a user --- --- Optional: 'title', 'description' --- --- -create :: Request f (APIKey -> SessionKey -> Sign) -create = api "playlist.create" <* post -{-# INLINE create #-} diff --git a/src/Network/Lastfm/Radio.hs b/src/Network/Lastfm/Radio.hs deleted file mode 100644 --- a/src/Network/Lastfm/Radio.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} --- | Lastfm radio API --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Network.Lastfm.Radio as Radio --- @ -module Network.Lastfm.Radio - ( getPlaylist, search, tune - ) where - -import Control.Applicative - -import Network.Lastfm.Request - - --- | Fetch new radio content periodically in an XSPF format. --- --- Optional: 'discovery', 'rtp', 'buyLinks' --- --- -getPlaylist :: Request f (Multiplier -> Bitrate -> APIKey -> SessionKey -> Sign) -getPlaylist = api "radio.getPlaylist" -{-# INLINE getPlaylist #-} - - --- | Resolve the name of a resource into a station depending on which resource --- it is most likely to represent. --- --- -search :: Request f (Name -> APIKey -> Ready) -search = api "radio.search" -{-# INLINE search #-} - - --- | Tune in to a Last.fm radio station. --- --- Optional: 'language' --- --- -tune :: Request f (Station -> APIKey -> SessionKey -> Sign) -tune = api "radio.tune" <* post -{-# INLINE tune #-} diff --git a/src/Network/Lastfm/Request.hs b/src/Network/Lastfm/Request.hs deleted file mode 100644 --- a/src/Network/Lastfm/Request.hs +++ /dev/null @@ -1,494 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} --- | Request construction -module Network.Lastfm.Request - ( -- * Request - Request, R, Ready, Sign, Format(..) - -- * Request major parameters - , api, post, get, json, xml, APIKey, apiKey, SessionKey, sessionKey - -- * Request minor parameters - , Token, token, Callback, callback - , Artist, artist, artists, Album, album, MBID, mbid - , Country, country, Autocorrect, autocorrect - , Event, event, Status(..), status - , From, from, To, to, Group, group - , Language, language, Distance, distance - , Longitude, longitude, Latitude, latitude, Location, location - , Start, start, End, end, Festivals, festivalsonly - , StartTimestamp, startTimestamp, EndTimestamp, endTimestamp - , Metro, metro, Tag, tags, tag, Track, track, Timestamp , timestamp, Fingerprint, fingerprint - , AlbumArtist, albumArtist, Duration, duration, TrackNumber, trackNumber - , Playlist, playlist, Title, title, Description, description - , ChosenByUser, chosenByUser, Context, context, StreamId, streamId - , RecentTracks, recentTracks - , Recipient, recipient, Username, username, User, user, Password, password - , Public, public, Message, message, Page, page, Limit, limit - , TaggingType, taggingType, UseRecs, useRecs, Venue, venue, VenueName, venueName - , Discovery, discovery, RTP, rtp, BuyLinks, buyLinks, Multiplier(..), multiplier - , Bitrate(..), bitrate, Name, name, Station, station - , Targeted, comparison, Scrobble, LibraryAlbum, LibraryArtist - ) where - -import Control.Applicative -import Data.Int (Int64) -import Data.Monoid ((<>), mempty) - -import qualified Data.Map.Strict as M -import Data.Text (Text) -import qualified Data.Text as T - -import Network.Lastfm.Internal - - -class Argument a where - add :: Text -> a -> Request f b - add k v = wrap $ \r@R { _query = q } -> r { _query = M.insert k (toText v) q } - {-# INLINE add #-} - - toText :: a -> Text - -instance Argument Text where - toText = id - {-# INLINE toText #-} - -instance Argument Bool where - toText b = if b then "1" else "0" - {-# INLINE toText #-} - -instance Argument Int64 where - toText = T.pack . show - {-# INLINE toText #-} - -instance Argument a => Argument [a] where - toText = T.intercalate "," . map toText - {-# INLINE toText #-} - - -data APIKey -data SessionKey -data Token -data Callback - - --- | Change request API method --- --- Primarily used in API call wrappers, not intended for usage by library user -api :: Text -> Request f a -api = add "method" -{-# INLINE api #-} - --- | Change html _method to GET --- --- Primarily used in API call wrappers, not intended for usage by library user -get :: Request f a -get = wrap $ \r -> r { _method = "GET" } -{-# INLINE get #-} - --- | Change html _method to POST --- --- Primarily used in API call wrappers, not intended for usage by library user -post :: Request f a -post = wrap $ \r -> r { _method = "POST" } -{-# INLINE post #-} - --- | Change API response format to JSON --- --- This is a little helper. It's actually enough --- to specialize Format manually -json :: Request JSON a -json = wrap id -{-# INLINE json #-} - --- | Change API response format to XML --- --- This is a little helper. It's actually enough --- to specialize Format manually -xml :: Request XML a -xml = wrap id -{-# INLINE xml #-} - --- | Change request API key -apiKey :: Text -> Request f APIKey -apiKey = add "api_key" -{-# INLINE apiKey #-} - --- | Change request session key -sessionKey :: Text -> Request f SessionKey -sessionKey = add "sk" -{-# INLINE sessionKey #-} - --- | Add token parameter -token :: Text -> Request f Token -token = add "token" -{-# INLINE token #-} - --- | Add callback link parameter -callback :: Text -> Request f Callback -callback = add "cb" -{-# INLINE callback #-} - - -data Artist -data Album -data MBID -data Country -data Language -data Tag -data Autocorrect -data Page -data Limit -data Message -data Public -data Recipient -data Username -data User -data Password -data Status = Attending | Maybe | NotAttending -data Event -data Festivals -data Longitude -data Latitude -data Location -data Distance -data Metro -data Start -data End -data StartTimestamp -data EndTimestamp -data From -data To -data Playlist -data Title -data Description -data Track -data Timestamp -data Fingerprint -data AlbumArtist -data Context -data StreamId -data Duration -data TrackNumber -data ChosenByUser -data TaggingType -data RecentTracks -data UseRecs -data Scrobble -data Group -data Venue -data VenueName -data Multiplier = M1 | M2 -data Bitrate = B64 | B128 -data Name -data Station -data Discovery -data RTP -data BuyLinks -data LibraryAlbum -data LibraryArtist - - --- | Add artist parameter -artist :: Text -> Request f Artist -artist = add "artist" -{-# INLINE artist #-} - --- | Add artists parameter -artists :: [Text] -> Request f [Artist] -artists = add "artists" -{-# INLINE artists #-} - --- | Add album parameter -album :: Text -> Request f Album -album = add "album" -{-# INLINE album #-} - --- | Add MBID parameter -mbid :: Text -> Request f MBID -mbid = add "mbid" -{-# INLINE mbid #-} - --- | Add country parameter -country :: Text -> Request f Country -country = add "country" -{-# INLINE country #-} - --- | Add language parameter -language :: Text -> Request f Language -language = add "lang" -{-# INLINE language #-} - --- | Add tags parameter -tags :: [Text] -> Request f [Tag] -tags = add "tags" -{-# INLINE tags #-} - --- | Add tag parameter -tag :: Text -> Request f Tag -tag = add "tag" -{-# INLINE tag #-} - --- | Add autocorrect parameter -autocorrect :: Bool -> Request f Autocorrect -autocorrect = add "tags" -{-# INLINE autocorrect #-} - --- | Add page parameter -page :: Int64 -> Request f Page -page = add "page" -{-# INLINE page #-} - --- | Add limit parameter -limit :: Int64 -> Request f Limit -limit = add "limit" -{-# INLINE limit #-} - --- | Add message parameter -message :: Text -> Request f Message -message = add "message" -{-# INLINE message #-} - --- | Add public parameter -public :: Bool -> Request f Public -public = add "public" -{-# INLINE public #-} - --- | Add recipient parameter -recipient :: Text -> Request f Recipient -recipient = add "recipient" -{-# INLINE recipient #-} - --- | Add username parameter -username :: Text -> Request f Username -username = add "username" -{-# INLINE username #-} - --- | Add user parameter -user :: Text -> Request f User -user = add "user" -{-# INLINE user #-} - --- | Add password parameter -password :: Text -> Request f Password -password = add "password" -{-# INLINE password #-} - --- | Add status parameter -status :: Status -> Request f Status -status = add "status" . T.pack . \s -> case s of - Attending -> "0" - Maybe -> "1" - _ -> "2" -{-# INLINE status #-} - --- | Add event parameter -event :: Int64 -> Request f Event -event = add "event" -{-# INLINE event #-} - --- | Add festivalsonly parameter -festivalsonly :: Bool -> Request f Festivals -festivalsonly = add "festivalsonly" -{-# INLINE festivalsonly #-} - --- | Add longitude parameter -longitude :: Text -> Request f Longitude -longitude = add "longitude" -{-# INLINE longitude #-} - --- | Add latitude parameter -latitude :: Text -> Request f Latitude -latitude = add "latitude" -{-# INLINE latitude #-} - --- | Add location parameter -location :: Text -> Request f Location -location = add "location" -{-# INLINE location #-} - --- | Add distance parameter -distance :: Int64 -> Request f Distance -distance = add "distance" -{-# INLINE distance #-} - --- | Add venue parameter -venue :: Int64 -> Request f Venue -venue = add "venue" -{-# INLINE venue #-} - --- | Add venue parameter -venueName :: Text -> Request f VenueName -venueName = add "venue" -{-# INLINE venueName #-} - --- | Add metro parameter -metro :: Text -> Request f Metro -metro = add "metro" -{-# INLINE metro #-} - --- | Add start parameter -start :: Int64 -> Request f Start -start = add "start" -{-# INLINE start #-} - --- | Add end parameter -end :: Int64 -> Request f End -end = add "end" -{-# INLINE end #-} - --- | Add startTimestamp parameter -startTimestamp :: Int64 -> Request f StartTimestamp -startTimestamp = add "startTimestamp" -{-# INLINE startTimestamp #-} - --- | Add endTimestamp parameter -endTimestamp :: Int64 -> Request f EndTimestamp -endTimestamp = add "endTimestamp" -{-# INLINE endTimestamp #-} - --- | Add from parameter -from :: Int64 -> Request f From -from = add "from" -{-# INLINE from #-} - --- | Add to parameter -to :: Int64 -> Request f To -to = add "to" -{-# INLINE to #-} - --- | Add track parameter -track :: Text -> Request f Track -track = add "track" -{-# INLINE track #-} - --- | Add timestamp parameter -timestamp :: Int64 -> Request f Timestamp -timestamp = add "timestamp" -{-# INLINE timestamp #-} - --- | Add playlistID parameter -playlist :: Int64 -> Request f Playlist -playlist = add "playlistID" -{-# INLINE playlist #-} - --- | Add title parameter -title :: Text -> Request f Title -title = add "title" -{-# INLINE title #-} - --- | Add description parameter -description :: Text -> Request f Description -description = add "description" -{-# INLINE description #-} - --- | Add fingerprint parameter -fingerprint :: Int64 -> Request f Fingerprint -fingerprint = add "fingerprintid" -{-# INLINE fingerprint #-} - --- | Add albumArtist parameter -albumArtist :: Text -> Request f AlbumArtist -albumArtist = add "albumArtist" -{-# INLINE albumArtist #-} - --- | Add context parameter -context :: Text -> Request f Context -context = add "context" -{-# INLINE context #-} - --- | Add streamId parameter -streamId :: Int64 -> Request f StreamId -streamId = add "streamId" -{-# INLINE streamId #-} - --- | Add duration parameter -duration :: Int64 -> Request f Duration -duration = add "duration" -{-# INLINE duration #-} - --- | Add trackNumber parameter -trackNumber :: Int64 -> Request f TrackNumber -trackNumber = add "trackNumber" -{-# INLINE trackNumber #-} - --- | Add chosenByUser parameter -chosenByUser :: Bool -> Request f ChosenByUser -chosenByUser = add "chosenByUser" -{-# INLINE chosenByUser #-} - --- | Add taggingType parameter -taggingType :: Text -> Request f TaggingType -taggingType = add "taggingtype" -{-# INLINE taggingType #-} - --- | Add recentTracks parameter -recentTracks :: Bool -> Request f RecentTracks -recentTracks = add "recentTracks" -{-# INLINE recentTracks #-} - --- | Add useRecs parameter -useRecs :: Bool -> Request f UseRecs -useRecs = add "useRecs" -{-# INLINE useRecs #-} - --- | Add group parameter -group :: Text -> Request f Group -group = add "group" -{-# INLINE group #-} - --- | Add multiplier parameter -multiplier :: Multiplier -> Request f Multiplier -multiplier m = case m of - M1 -> add "speed_multiplier" (T.pack "1.0") - M2 -> add "speed_multiplier" (T.pack "2.0") -{-# INLINE multiplier #-} - --- | Add bitrate parameter -bitrate :: Bitrate -> Request f Bitrate -bitrate b = case b of - B64 -> add "bitrate" (64 :: Int64) - B128 -> add "bitrate" (128 :: Int64) -{-# INLINE bitrate #-} - --- | Add name parameter -name :: Text -> Request f Name -name = add "name" -{-# INLINE name #-} - --- | Add station parameter -station :: Text -> Request f Station -station = add "station" -{-# INLINE station #-} - --- | Add group parameter -discovery :: Bool -> Request f Discovery -discovery = add "discovery" -{-# INLINE discovery #-} - --- | Add rtp parameter -rtp :: Bool -> Request f RTP -rtp = add "rtp" -{-# INLINE rtp #-} - --- | Add buyLinks parameter -buyLinks :: Bool -> Request f BuyLinks -buyLinks = add "buyLinks" -{-# INLINE buyLinks #-} - - -class Targeted a where - target :: Request f a -> Text - -instance Targeted [Artist] where - target _ = "artists" - {-# INLINE target #-} - -instance Targeted User where - target _ = "user" - {-# INLINE target #-} - --- | Add comparison parameter -comparison :: Targeted a => Int64 -> Request f a -> Request f a -comparison n t = let z = target t in - add ("type" <> toText n) z <*> add ("value" <> toText n) (_query (unwrap t (R mempty mempty mempty)) M.! z) -{-# INLINE comparison #-} diff --git a/src/Network/Lastfm/Response.hs b/src/Network/Lastfm/Response.hs deleted file mode 100644 --- a/src/Network/Lastfm/Response.hs +++ /dev/null @@ -1,249 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} --- | Request sending and Response parsing -module Network.Lastfm.Response - ( -- * Compute request signature - -- $sign - Secret(..) - , sign - -- * Perform requests - , Connection - , withConnection - , newConnection - , closeConnection - , lastfm - , lastfm_ - , Supported - , Format(..) - -- ** Errors - , LastfmError(..) - , _LastfmBadResponse - , _LastfmEncodedError - , _LastfmHttpError -#ifdef TEST - , parse - , md5 -#endif - ) where - -import Control.Applicative -import Control.Exception (SomeException(..), Exception(..), bracket, catch) -import Crypto.Classes (hash') -import Data.Aeson ((.:), Value(..), decode) -import Data.Aeson.Types (parseMaybe) -import qualified Data.ByteString.Lazy as Lazy -import qualified Data.ByteString as Strict -import Data.Digest.Pure.MD5 (MD5Digest) -import Data.Map (Map) -import qualified Data.Map as M -import Data.Monoid -import Data.Profunctor (Choice, dimap, right') -import Data.String (IsString(..)) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.Text.Read as T -import Data.Typeable (Typeable, cast) -import qualified Network.HTTP.Client as Http -import qualified Network.HTTP.Client.TLS as Http -import Text.XML (Document, parseLBS, def) -import Text.XML.Cursor - -import Network.Lastfm.Internal - - --- $sign --- --- The signature is required for every --- authenticated API request. Basically, --- every such request appends the md5 footprint --- of its arguments to the query as --- described at - - --- | 'Supported' provides parsing for the chosen 'Format' --- --- 'JSON' is parsed to 'Value' type from aeson, while 'XML' --- is parsed to 'Document' from xml-conduit -class Supported f r | f -> r, r -> f where - prepareRequest :: R f -> R f - parseResponseBody :: Lazy.ByteString -> Maybe r - parseResponseEncodedError :: r -> Maybe LastfmError - -instance Supported JSON Value where - prepareRequest r = r { _query = M.singleton "format" "json" `M.union` _query r } - parseResponseBody = decode - parseResponseEncodedError = parseMaybe $ \(Object o) -> do - code <- o .: "error" - msg <- o .: "message" - return (LastfmEncodedError code msg) - -instance Supported XML Document where - prepareRequest = id - parseResponseBody = either (const Nothing) Just . parseLBS def - parseResponseEncodedError doc = case fromDocument doc of - cur - | [mcode] <- cur $| element "lfm" >=> child >=> element "error" >=> attribute "code" - , Right (code, _) <- T.decimal mcode - , [msg] <- cur $| element "lfm" >=> child >=> element "error" >=> child >=> content - -> Just (LastfmEncodedError code (T.strip msg)) - | - otherwise -> Nothing - -parse :: Supported f r => Lazy.ByteString -> Either LastfmError r -parse body = case parseResponseBody body of - Just v - | Just e <- parseResponseEncodedError v -> Left e - | otherwise -> Right v - Nothing -> Left (LastfmBadResponse body) - -base :: R f -base = R - { _host = "https://ws.audioscrobbler.com/2.0/" - , _method = "GET" - , _query = mempty - } - - --- | Different ways last.fm response can be unusable -data LastfmError = - -- | last.fm thinks it responded with something legible, but it really isn't - LastfmBadResponse Lazy.ByteString - -- | last.fm error code and message string - | LastfmEncodedError Int Text - -- | wrapped http-conduit exception - | LastfmHttpError Http.HttpException - deriving (Show, Typeable) - --- | Admittedly, this isn't the best 'Eq' instance ever --- but not having 'Eq' 'C.HttpException' does not leave much a choice -instance Eq LastfmError where - LastfmBadResponse bs == LastfmBadResponse bs' = bs == bs' - LastfmEncodedError e s == LastfmEncodedError e' t = e == e' && s == t - LastfmHttpError _ == LastfmHttpError _ = True - _ == _ = False - -instance Exception LastfmError where - fromException e@(SomeException se) - | Just e' <- fromException e = Just (LastfmHttpError e') - | otherwise = cast se - -class AsLastfmError t where - _LastfmError :: (Choice p, Applicative m) => p LastfmError (m LastfmError) -> p t (m t) - -instance AsLastfmError LastfmError where - _LastfmError = id - {-# INLINE _LastfmError #-} - -instance AsLastfmError SomeException where - _LastfmError = dimap (\e -> maybe (Left e) Right (fromException e)) (either pure (fmap toException)) . right' - {-# INLINE _LastfmError #-} - --- | This is a @ Prism' 'LastfmError' 'Lazy.ByteString' @ in disguise -_LastfmBadResponse - :: (Choice p, Applicative m, AsLastfmError e) - => p Lazy.ByteString (m Lazy.ByteString) -> p e (m e) -_LastfmBadResponse = _LastfmError . dimap go (either pure (fmap LastfmBadResponse)) . right' where - go (LastfmBadResponse bs) = Right bs - go x = Left x - {-# INLINE go #-} -{-# INLINE _LastfmBadResponse #-} - --- | This is a @ Prism' 'LastfmError' ('Int', 'String') @ in disguise -_LastfmEncodedError - :: (Choice p, Applicative m, AsLastfmError e) - => p (Int, Text) (m (Int, Text)) -> p e (m e) -_LastfmEncodedError = _LastfmError . dimap go (either pure (fmap (uncurry LastfmEncodedError))) . right' where - go (LastfmEncodedError n v) = Right (n, v) - go x = Left x - {-# INLINE go #-} -{-# INLINE _LastfmEncodedError #-} - --- | This is a @ Prism' 'LastfmError' 'C.HttpException' @ in disguise -_LastfmHttpError - :: (Choice p, Applicative m, AsLastfmError e) - => p Http.HttpException (m Http.HttpException) -> p e (m e) -_LastfmHttpError = _LastfmError . dimap go (either pure (fmap LastfmHttpError)) . right' where - go (LastfmHttpError e) = Right e - go x = Left x - {-# INLINE go #-} -{-# INLINE _LastfmHttpError #-} - - --- | Application secret -newtype Secret = Secret Text deriving (Show, Eq, Typeable) - -instance IsString Secret where - fromString = Secret . fromString - --- | Sign the 'Request' with the 'Secret' so it's ready to be sent -sign :: Secret -> Request f Sign -> Request f Ready -sign s = coerce . (<* signature) - where - signature = wrap $ - \r@R { _query = q } -> r { _query = apiSig s . authToken $ q } - -authToken :: Map Text Text -> Map Text Text -authToken q = maybe q (M.delete "password") $ do - password <- M.lookup "password" q - username <- M.lookup "username" q - return (M.insert "authToken" (md5 (username <> md5 password)) q) - -apiSig :: Secret -> Map Text Text -> Map Text Text -apiSig (Secret s) q = M.insert "api_sig" (signer (foldr M.delete q ["format", "callback"])) q - where - signer = md5 . M.foldrWithKey (\k v xs -> k <> v <> xs) s - --- | Get supplied string md5 hash hex representation -md5 :: Text -> Text -md5 = T.pack . show . (hash' :: Strict.ByteString -> MD5Digest) . T.encodeUtf8 - - --- | Lastfm connection manager -newtype Connection = Connection Http.Manager - --- | Creating an HTTPS connection manager is expensive; it's advised to use --- a single 'Connection' for all communications with last.fm -withConnection :: (Connection -> IO a) -> IO a -withConnection = bracket newConnection closeConnection - --- | Create a 'Connection' -newConnection :: IO Connection -newConnection = Connection <$> Http.newManager Http.tlsManagerSettings - --- | Close a 'Connection' -closeConnection :: Connection -> IO () -closeConnection (Connection man) = Http.closeManager man - --- | Perform the 'Request' and parse the response -lastfm :: Supported f r => Connection -> Request f Ready -> IO (Either LastfmError r) -lastfm man = lastfmWith man parse . finalize - --- | Perform the 'Request' ignoring any responses -lastfm_ :: Supported f r => Connection -> Request f Ready -> IO (Either LastfmError ()) -lastfm_ man = lastfmWith man (\_ -> Right ()) . finalize - --- | Send the 'R' and parse the 'Response' with the supplied parser -lastfmWith - :: Supported f r - => Connection - -> (Lazy.ByteString -> Either LastfmError a) - -> R f - -> IO (Either LastfmError a) -lastfmWith (Connection man) p r = do - req <- Http.parseUrl (render r) - let req' = req - { Http.method = _method r - , Http.responseTimeout = Just 10000000 - } - p . Http.responseBody <$> Http.httpLbs req' man - `catch` - (return . Left) - --- | Get the 'R' from the 'Request' -finalize :: Supported f r => Request f Ready -> R f -finalize x = (prepareRequest . unwrap x) base diff --git a/src/Network/Lastfm/Tag.hs b/src/Network/Lastfm/Tag.hs deleted file mode 100644 --- a/src/Network/Lastfm/Tag.hs +++ /dev/null @@ -1,101 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} --- | Lastfm tag API --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Network.Lastfm.Tag as Tag --- @ -module Network.Lastfm.Tag - ( getInfo, getSimilar, getTopAlbums, getTopArtists, getTopTags, getTopTracks - , getWeeklyArtistChart, getWeeklyChartList, search - ) where - -import Network.Lastfm.Request - - --- | Get the metadata for a tag --- --- Optional: language --- --- -getInfo :: Request f (Tag -> APIKey -> Ready) -getInfo = api "tag.getInfo" -{-# INLINE getInfo #-} - - --- | Search for tags similar to this one. Returns tags ranked by similarity, based on listening data. --- --- -getSimilar :: Request f (Tag -> APIKey -> Ready) -getSimilar = api "tag.getSimilar" -{-# INLINE getSimilar #-} - - --- | Get the top albums tagged by this tag, ordered by tag count. --- --- Optional: 'limit', 'page' --- --- -getTopAlbums :: Request f (Tag -> APIKey -> Ready) -getTopAlbums = api "tag.getTopAlbums" -{-# INLINE getTopAlbums #-} - - --- | Get the top artists tagged by this tag, ordered by tag count. --- --- Optional: 'limit', 'page' --- --- -getTopArtists :: Request f (Tag -> APIKey -> Ready) -getTopArtists = api "tag.getTopArtists" -{-# INLINE getTopArtists #-} - - --- | Fetches the top global tags on Last.fm, sorted by popularity (number of times used) --- --- -getTopTags :: Request f (APIKey -> Ready) -getTopTags = api "tag.getTopTags" -{-# INLINE getTopTags #-} - - --- | Get the top tracks tagged by this tag, ordered by tag count. --- --- Optional: 'limit', 'page' --- --- -getTopTracks :: Request f (Tag -> APIKey -> Ready) -getTopTracks = api "tag.getTopTracks" -{-# INLINE getTopTracks #-} - - --- | Get an artist chart for a tag, for a given date range. --- If no date range is supplied, it will return the most recent artist chart for this tag. --- --- Optional: 'from', 'to', 'limit' --- --- -getWeeklyArtistChart :: Request f (Tag -> APIKey -> Ready) -getWeeklyArtistChart = api "tag.getWeeklyArtistChart" -{-# INLINE getWeeklyArtistChart #-} - - --- | Get a list of available charts for this tag, expressed as --- date ranges which can be sent to the chart services. --- --- -getWeeklyChartList :: Request f (Tag -> APIKey -> Ready) -getWeeklyChartList = api "tag.getWeeklyChartList" -{-# INLINE getWeeklyChartList #-} - - --- | Search for a tag by name. Returns matches sorted by relevance. --- --- Optional: 'limit', 'page' --- --- -search :: Request f (Tag -> APIKey -> Ready) -search = api "tag.search" -{-# INLINE search #-} diff --git a/src/Network/Lastfm/Tasteometer.hs b/src/Network/Lastfm/Tasteometer.hs deleted file mode 100644 --- a/src/Network/Lastfm/Tasteometer.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} --- | Lastfm tasteometer API --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Network.Lastfm.Tasteometer as Tasteometer --- @ -module Network.Lastfm.Tasteometer where - -import Control.Applicative - -import Network.Lastfm.Request - - --- | Get a Tasteometer score from two inputs, along with a list of shared artists. --- If the input is a user some additional information is returned. --- --- Optional: 'limit' --- --- -compare :: (Targeted u, Targeted v) => Request f u -> Request f v -> Request f (APIKey -> Ready) -compare u v = api "tasteometer.compare" <* comparison 1 u <* comparison 2 v -{-# INLINE compare #-} diff --git a/src/Network/Lastfm/Track.hs b/src/Network/Lastfm/Track.hs deleted file mode 100644 --- a/src/Network/Lastfm/Track.hs +++ /dev/null @@ -1,221 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} --- | Lastfm track API --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Network.Lastfm.Track as Track --- @ -module Network.Lastfm.Track - ( ArtistTrackOrMBID - , addTags, ban, getBuyLinks, getCorrection, getFingerprintMetadata - , getInfo, getShouts, getSimilar, getTags, getTopFans - , getTopTags, love, removeTag, scrobble, item - , search, share, unban, unlove, updateNowPlaying - ) 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 - - --- | Unify ('Artist' -> 'Track' -> …) and ('MBID' -> …) -class ArtistTrackOrMBID a - -instance ArtistTrackOrMBID (MBID -> APIKey -> Ready) -instance ArtistTrackOrMBID (Artist -> Track -> APIKey -> Ready) - - --- | Tag a track using a list of user supplied tags. --- --- -addTags :: Request f (Artist -> Track -> [Tag] -> APIKey -> SessionKey -> Sign) -addTags = api "track.addTags" <* post -{-# INLINE addTags #-} - - --- | Ban a track for a given user profile. --- --- -ban :: Request f (Artist -> Track -> APIKey -> SessionKey -> Sign) -ban = api "track.ban" <* post -{-# INLINE ban #-} - - --- | Get a list of Buy Links for a particular track. --- --- Optional: 'autocorrect' --- --- -getBuyLinks :: ArtistTrackOrMBID t => Request f (Country -> t) -getBuyLinks = api "track.getBuyLinks" -{-# INLINE getBuyLinks #-} - - --- | Use the last.fm corrections data to check whether --- the supplied track has a correction to a canonical track. --- --- -getCorrection :: Request f (Artist -> Track -> APIKey -> Ready) -getCorrection = api "track.getCorrection" -{-# INLINE getCorrection #-} - - --- | Retrieve track metadata associated with a fingerprint id --- generated by the Last.fm Fingerprinter. Returns track --- elements, along with a 'rank' value between 0 and 1 reflecting the confidence for each match. --- --- -getFingerprintMetadata :: Request f (Fingerprint -> APIKey -> Ready) -getFingerprintMetadata = api "track.getFingerprintMetadata" -{-# INLINE getFingerprintMetadata #-} - - --- | Get the metadata for a track on Last.fm. --- --- Optional: 'autocorrect', 'username' --- --- -getInfo :: ArtistTrackOrMBID t => Request f t -getInfo = api "track.getInfo" -{-# INLINE getInfo #-} - - --- | Get shouts for this track. Also available as an rss feed. --- --- Optional: 'autocorrect', 'limit', 'page' --- --- -getShouts :: ArtistTrackOrMBID t => Request f t -getShouts = api "track.getShouts" -{-# INLINE getShouts #-} - - --- | Get the similar tracks for this track on Last.fm, based on listening data. --- --- Optional: 'autocorrect', 'limit' --- --- -getSimilar :: ArtistTrackOrMBID t => Request f t -getSimilar = api "track.getSimilar" -{-# INLINE getSimilar #-} - - --- | Get the tags applied by an individual user to a track on Last.fm. --- --- Optional: 'autocorrect', 'user' --- --- -getTags :: ArtistTrackOrMBID t => Request f t -getTags = api "track.getTags" -{-# INLINE getTags #-} - - --- | Get the top fans for this track on Last.fm, based on listening data. --- --- Optional: 'autocorrect' --- --- -getTopFans :: ArtistTrackOrMBID t => Request f t -getTopFans = api "track.getTopFans" -{-# INLINE getTopFans #-} - - --- | Get the top tags for this track on Last.fm, ordered by tag count. --- --- Optional: 'autocorrect' --- --- -getTopTags :: ArtistTrackOrMBID t => Request f t -getTopTags = api "track.getTopTags" -{-# INLINE getTopTags #-} - - --- | Love a track for a user profile. --- --- -love :: Request f (Artist -> Track -> APIKey -> SessionKey -> Sign) -love = api "track.love" <* post -{-# INLINE love #-} - - --- | Remove a user's tag from a track. --- --- -removeTag :: Request f (Artist -> Track -> Tag -> APIKey -> SessionKey -> Sign) -removeTag = api "track.removeTag" <* post -{-# INLINE removeTag #-} - - --- | Add played tracks to the user profile. --- --- Scrobbles 50 first list elements --- --- -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. --- --- Optional: 'artist', 'limit', 'page' --- --- -search :: Request f (Track -> APIKey -> Ready) -search = api "track.search" -{-# INLINE search #-} - - --- | Share a track twith one or more Last.fm users or other friends. --- --- Optional: 'public', 'message', 'recipient' --- --- -share :: Request f (Artist -> Track -> Recipient -> APIKey -> SessionKey -> Sign) -share = api "track.share" <* post -{-# INLINE share #-} - - --- | Unban a track for a user profile. --- --- -unban :: Request f (Artist -> Track -> APIKey -> SessionKey -> Sign) -unban = api "track.unban" <* post -{-# INLINE unban #-} - - --- | Unlove a track for a user profile. --- --- -unlove :: Request f (Artist -> Track -> APIKey -> SessionKey -> Sign) -unlove = api "track.unlove" <* post -{-# INLINE unlove #-} - - --- | Used to notify Last.fm that a user has started listening --- to a track. Parameter names are case sensitive. --- --- Optional: 'album', 'albumArtist', 'context', --- 'duration', 'mbid', 'trackNumber' --- --- -updateNowPlaying :: Request f (Artist -> Track -> APIKey -> SessionKey -> Sign) -updateNowPlaying = api "track.updateNowPlaying" <* post -{-# INLINE updateNowPlaying #-} diff --git a/src/Network/Lastfm/User.hs b/src/Network/Lastfm/User.hs deleted file mode 100644 --- a/src/Network/Lastfm/User.hs +++ /dev/null @@ -1,275 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} --- | Lastfm user API --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Network.Lastfm.User as User --- @ -module Network.Lastfm.User - ( getArtistTracks, getBannedTracks, getEvents, getFriends - , getInfo, getLovedTracks, getNeighbours, getNewReleases - , getPastEvents, getPersonalTags, getPlaylists, getRecentStations - , getRecentTracks, getRecommendedArtists, getRecommendedEvents - , getShouts, getTopAlbums, getTopArtists, getTopTags - , getTopTracks, getWeeklyAlbumChart, getWeeklyArtistChart - , getWeeklyChartList, getWeeklyTrackChart, shout - ) where - -import Control.Applicative - -import Network.Lastfm.Request - - --- | Get a list of tracks by a given artist scrobbled by this user --- , including scrobble time. Can be limited to specific timeranges, defaults to all time. --- --- Optional: 'startTimestamp', 'page', 'endTimestamp' --- --- -getArtistTracks :: Request f (User -> Artist -> APIKey -> Ready) -getArtistTracks = api "user.getArtistTracks" -{-# INLINE getArtistTracks #-} - - --- | Returns the tracks banned by the user --- --- Optional: 'limit', 'page' --- --- -getBannedTracks :: Request f (User -> APIKey -> Ready) -getBannedTracks = api "user.getBannedTracks" -{-# INLINE getBannedTracks #-} - - --- | Get a list of upcoming events that this user is attending. --- Easily integratable into calendars, using the ical standard (see 'more formats' section below). --- --- Optional: 'page', 'festivalsonly', 'limit' --- --- -getEvents :: Request f (User -> APIKey -> Ready) -getEvents = api "user.getEvents" -{-# INLINE getEvents #-} - - --- | Get a list of the user's friends on Last.fm. --- --- Optional: 'recenttracks', 'limit', 'page' --- --- -getFriends :: Request f (User -> APIKey -> Ready) -getFriends = api "user.getFriends" -{-# INLINE getFriends #-} - - --- | Get information about a user profile. --- --- -getInfo :: Request f (User -> APIKey -> Ready) -getInfo = api "user.getInfo" -{-# INLINE getInfo #-} - - --- | Get the last 50 tracks loved by a user. --- --- Optional: 'limit', 'page' --- --- -getLovedTracks :: Request f (User -> APIKey -> Ready) -getLovedTracks = api "user.getLovedTracks" -{-# INLINE getLovedTracks #-} - - --- | Get a list of a user's neighbours on Last.fm. --- --- Optional: 'limit' --- --- -getNeighbours :: Request f (User -> APIKey -> Ready) -getNeighbours = api "user.getNeighbours" -{-# INLINE getNeighbours #-} - - --- | Gets a list of forthcoming releases based on a user's musical taste. --- --- Optional: 'userecs' --- --- -getNewReleases :: Request f (User -> APIKey -> Ready) -getNewReleases = api "user.getNewReleases" -{-# INLINE getNewReleases #-} - - --- | Get a paginated list of all events a user has attended in the past. --- --- Optional: 'page', 'limit' --- --- -getPastEvents :: Request f (User -> APIKey -> Ready) -getPastEvents = api "user.getPastEvents" -{-# INLINE getPastEvents #-} - - --- | Get the user's personal tags --- --- Optional: 'taggingtype', 'limit', 'page' --- --- -getPersonalTags :: Request f (User -> Tag -> TaggingType -> APIKey -> Ready) -getPersonalTags = api "user.getPersonalTags" -{-# INLINE getPersonalTags #-} - - --- | Get a list of a user's playlists on Last.fm. --- --- -getPlaylists :: Request f (User -> APIKey -> Ready) -getPlaylists = api "user.getPlaylists" -{-# INLINE getPlaylists #-} - - --- | Get a list of the recent Stations listened to by this user. --- --- Optional: 'limit', 'page' --- --- -getRecentStations :: Request f (User -> APIKey -> SessionKey -> Sign) -getRecentStations = api "user.getRecentStations" -{-# INLINE getRecentStations #-} - - --- | Get a list of the recent tracks listened to by this user. --- Also includes the currently playing track with the nowplaying="true" --- attribute if the user is currently listening. --- --- Optional: 'limit', 'page', 'from', 'extended', 'to' --- --- -getRecentTracks :: Request f (User -> APIKey -> Ready) -getRecentTracks = api "user.getRecentTracks" -{-# INLINE getRecentTracks #-} - - --- | Get Last.fm artist recommendations for a user --- --- Optional: 'page', 'limit' --- --- -getRecommendedArtists :: Request f (APIKey -> SessionKey -> Sign) -getRecommendedArtists = api "user.getRecommendedArtists" -{-# INLINE getRecommendedArtists #-} - - --- | Get a paginated list of all events recommended to a user by Last.fm, based on their listening profile. --- --- Optional: 'limit', 'page', 'latitude', 'longitude', 'festivalsonly', 'country' --- --- -getRecommendedEvents :: Request f (APIKey -> SessionKey -> Sign) -getRecommendedEvents = api "user.getRecommendedEvents" -{-# INLINE getRecommendedEvents #-} - - --- | Get shouts for this user. Also available as an rss feed. --- --- Optional: 'page', 'limit' --- --- -getShouts :: Request f (User -> APIKey -> Ready) -getShouts = api "user.getShouts" -{-# INLINE getShouts #-} - - --- | Get the top albums listened to by a user. --- You can stipulate a time period. Sends the overall chart by default. --- --- Optional: 'period', 'limit', 'page' --- --- -getTopAlbums :: Request f (User -> APIKey -> Ready) -getTopAlbums = api "user.getTopAlbums" -{-# INLINE getTopAlbums #-} - - --- | Get the top artists listened to by a user. --- You can stipulate a time period. Sends the overall chart by default. --- --- Optional: 'period', 'limit', 'page' --- --- -getTopArtists :: Request f (User -> APIKey -> Ready) -getTopArtists = api "user.getTopArtists" -{-# INLINE getTopArtists #-} - - --- | Get the top tags used by this user. --- --- Optional: 'limit' --- --- -getTopTags :: Request f (User -> APIKey -> Ready) -getTopTags = api "user.getTopTags" -{-# INLINE getTopTags #-} - - --- | Get the top tracks listened to by a user. --- You can stipulate a time period. Sends the overall chart by default. --- --- Optional: 'period', 'limit', 'page' --- --- -getTopTracks :: Request f (User -> APIKey -> Ready) -getTopTracks = api "user.getTopTracks" -{-# INLINE getTopTracks #-} - - --- | Get an album chart for a user profile, for a given date range. --- If no date range is supplied, it will return the most recent album chart for this user. --- --- Optional: 'from', 'to' --- --- -getWeeklyAlbumChart :: Request f (User -> APIKey -> Ready) -getWeeklyAlbumChart = api "user.getWeeklyAlbumChart" -{-# INLINE getWeeklyAlbumChart #-} - - --- | Get an artist chart for a user profile, for a given date range. --- If no date range is supplied, it will return the most recent artist chart for this user. --- --- Optional: 'from', 'to' --- --- -getWeeklyArtistChart :: Request f (User -> APIKey -> Ready) -getWeeklyArtistChart = api "user.getWeeklyArtistChart" -{-# INLINE getWeeklyArtistChart #-} - - --- | Get a list of available charts for this user, expressed as --- date ranges which can be sent to the chart services. --- --- -getWeeklyChartList :: Request f (User -> APIKey -> Ready) -getWeeklyChartList = api "user.getWeeklyChartList" -{-# INLINE getWeeklyChartList #-} - - --- | Get a track chart for a user profile, for a given date range. --- If no date range is supplied, it will return the most recent track chart for this user. --- --- Optional: 'from', 'to' --- --- -getWeeklyTrackChart :: Request f (User -> APIKey -> Ready) -getWeeklyTrackChart = api "user.getWeeklyTrackChart" -{-# INLINE getWeeklyTrackChart #-} - - --- | Shout on this user's shoutbox --- --- -shout :: Request f (User -> Message -> APIKey -> SessionKey -> Sign) -shout = api "user.shout" <* post -{-# INLINE shout #-} diff --git a/src/Network/Lastfm/Venue.hs b/src/Network/Lastfm/Venue.hs deleted file mode 100644 --- a/src/Network/Lastfm/Venue.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} --- | Lastfm venue API --- --- This module is intended to be imported qualified: --- --- @ --- import qualified Network.Lastfm.Venue as Venue --- @ -module Network.Lastfm.Venue - ( getEvents, getPastEvents, search - ) where - -import Network.Lastfm.Request - - --- | Get a list of upcoming events at this venue. --- --- Optional: 'festivalsonly' --- --- -getEvents :: Request f (Venue -> APIKey -> Ready) -getEvents = api "venue.getEvents" - - --- | Get a paginated list of all the events held at this venue in the past. --- --- Optional: 'festivalsonly', 'page', 'limit' --- --- -getPastEvents :: Request f (Venue -> APIKey -> Ready) -getPastEvents = api "venue.getPastEvents" - - --- | Search for a venue by venue name --- --- Optional: 'page', 'limit', 'country' --- --- -search :: Request f (VenueName -> APIKey -> Ready) -search = api "venue.search" diff --git a/test/api/Json/AlbumSpec.hs b/test/api/Json/AlbumSpec.hs --- a/test/api/Json/AlbumSpec.hs +++ b/test/api/Json/AlbumSpec.hs @@ -5,8 +5,8 @@ import Data.Aeson (Value) import Data.Aeson.Lens import Data.Text (Text) -import Network.Lastfm -import Network.Lastfm.Album +import Lastfm +import Lastfm.Album import Test.Hspec import SpecHelper diff --git a/test/api/Json/ArtistSpec.hs b/test/api/Json/ArtistSpec.hs --- a/test/api/Json/ArtistSpec.hs +++ b/test/api/Json/ArtistSpec.hs @@ -5,8 +5,8 @@ import Data.Aeson (Value) import Data.Aeson.Lens import Data.Text (Text) -import Network.Lastfm -import Network.Lastfm.Artist +import Lastfm +import Lastfm.Artist import Test.Hspec import SpecHelper diff --git a/test/api/Json/ChartSpec.hs b/test/api/Json/ChartSpec.hs --- a/test/api/Json/ChartSpec.hs +++ b/test/api/Json/ChartSpec.hs @@ -5,8 +5,8 @@ import Data.Aeson (Value) import Data.Aeson.Lens import Data.Text (Text) -import Network.Lastfm -import Network.Lastfm.Chart +import Lastfm +import Lastfm.Chart import Test.Hspec import SpecHelper diff --git a/test/api/Json/EventSpec.hs b/test/api/Json/EventSpec.hs --- a/test/api/Json/EventSpec.hs +++ b/test/api/Json/EventSpec.hs @@ -3,8 +3,8 @@ module Json.EventSpec (spec) where import Data.Aeson.Lens -import Network.Lastfm -import Network.Lastfm.Event +import Lastfm +import Lastfm.Event import Test.Hspec import SpecHelper diff --git a/test/api/Json/GeoSpec.hs b/test/api/Json/GeoSpec.hs --- a/test/api/Json/GeoSpec.hs +++ b/test/api/Json/GeoSpec.hs @@ -5,8 +5,8 @@ import Data.Aeson (Value) import Data.Aeson.Lens import Data.Text (Text) -import Network.Lastfm -import Network.Lastfm.Geo +import Lastfm +import Lastfm.Geo import Test.Hspec import SpecHelper diff --git a/test/api/Json/GroupSpec.hs b/test/api/Json/GroupSpec.hs --- a/test/api/Json/GroupSpec.hs +++ b/test/api/Json/GroupSpec.hs @@ -3,8 +3,8 @@ module Json.GroupSpec (spec) where import Data.Aeson.Lens -import Network.Lastfm -import Network.Lastfm.Group +import Lastfm +import Lastfm.Group import Test.Hspec import SpecHelper diff --git a/test/api/Json/LibrarySpec.hs b/test/api/Json/LibrarySpec.hs --- a/test/api/Json/LibrarySpec.hs +++ b/test/api/Json/LibrarySpec.hs @@ -3,8 +3,8 @@ module Json.LibrarySpec (spec) where import Data.Aeson.Lens -import Network.Lastfm -import Network.Lastfm.Library +import Lastfm +import Lastfm.Library import Test.Hspec import SpecHelper diff --git a/test/api/Json/PlaylistSpec.hs b/test/api/Json/PlaylistSpec.hs --- a/test/api/Json/PlaylistSpec.hs +++ b/test/api/Json/PlaylistSpec.hs @@ -7,9 +7,9 @@ import Data.Aeson.Lens import Data.Int (Int64) import Data.Text.Lens (unpacked) -import Network.Lastfm hiding (to) -import Network.Lastfm.Playlist -import Network.Lastfm.User +import Lastfm hiding (to) +import Lastfm.Playlist +import Lastfm.User import Test.Hspec import Test.HUnit (assertFailure) import Text.Printf diff --git a/test/api/Json/TagSpec.hs b/test/api/Json/TagSpec.hs --- a/test/api/Json/TagSpec.hs +++ b/test/api/Json/TagSpec.hs @@ -3,8 +3,8 @@ module Json.TagSpec (spec) where import Data.Aeson.Lens -import Network.Lastfm -import Network.Lastfm.Tag +import Lastfm +import Lastfm.Tag import Test.Hspec import SpecHelper diff --git a/test/api/Json/TasteometerSpec.hs b/test/api/Json/TasteometerSpec.hs --- a/test/api/Json/TasteometerSpec.hs +++ b/test/api/Json/TasteometerSpec.hs @@ -5,8 +5,8 @@ import Data.Aeson (Value) import Data.Aeson.Lens import Data.Text (Text) -import Network.Lastfm -import qualified Network.Lastfm.Tasteometer as Taste +import Lastfm +import qualified Lastfm.Tasteometer as Taste import Test.Hspec import SpecHelper diff --git a/test/api/Json/TrackSpec.hs b/test/api/Json/TrackSpec.hs --- a/test/api/Json/TrackSpec.hs +++ b/test/api/Json/TrackSpec.hs @@ -5,8 +5,8 @@ import Data.Aeson (Value) import Data.Aeson.Lens import Data.Text (Text) -import Network.Lastfm -import Network.Lastfm.Track +import Lastfm +import Lastfm.Track import Test.Hspec import SpecHelper diff --git a/test/api/Json/UserSpec.hs b/test/api/Json/UserSpec.hs --- a/test/api/Json/UserSpec.hs +++ b/test/api/Json/UserSpec.hs @@ -3,8 +3,8 @@ module Json.UserSpec (spec) where import Data.Aeson.Lens -import Network.Lastfm -import Network.Lastfm.User +import Lastfm +import Lastfm.User import Test.Hspec import SpecHelper diff --git a/test/api/Json/VenueSpec.hs b/test/api/Json/VenueSpec.hs --- a/test/api/Json/VenueSpec.hs +++ b/test/api/Json/VenueSpec.hs @@ -3,8 +3,8 @@ module Json.VenueSpec (spec) where import Data.Aeson.Lens -import Network.Lastfm -import Network.Lastfm.Venue +import Lastfm +import Lastfm.Venue import Test.Hspec import SpecHelper diff --git a/test/api/SpecHelper.hs b/test/api/SpecHelper.hs --- a/test/api/SpecHelper.hs +++ b/test/api/SpecHelper.hs @@ -33,7 +33,7 @@ import Data.Typeable (Typeable) import qualified Network.HTTP.Client as Http import qualified Network.HTTP.Client.TLS as Http -import Network.Lastfm +import Lastfm import System.Environment import System.IO.Unsafe (unsafePerformIO) import Test.Hspec @@ -53,17 +53,17 @@ Just _ -> return () Nothing -> assertFailure (printf "Query failed on %s" (show r)) -shouldHaveJson :: Request JSON Ready -> Fold Value a -> Expectation +shouldHaveJson :: Request 'JSON Ready -> Fold Value a -> Expectation shouldHaveJson = shouldHaveResponse -shouldHaveXml :: Request XML Ready -> Fold Document a -> Expectation +shouldHaveXml :: Request 'XML Ready -> Fold Document a -> Expectation shouldHaveXml = shouldHaveResponse -- | Check success stuff for POST requests -shouldHaveJson_ :: Request JSON Ready -> Expectation +shouldHaveJson_ :: Request 'JSON Ready -> Expectation shouldHaveJson_ l = shouldHaveResponse l (key "status".only "ok") -shouldHaveXml_ :: Request XML Ready -> Expectation +shouldHaveXml_ :: Request 'XML Ready -> Expectation shouldHaveXml_ l = shouldHaveResponse l (root.attributed (ix "status".only "ok")) -- | Make a request using public API key diff --git a/test/api/Xml/AlbumSpec.hs b/test/api/Xml/AlbumSpec.hs --- a/test/api/Xml/AlbumSpec.hs +++ b/test/api/Xml/AlbumSpec.hs @@ -3,8 +3,8 @@ module Xml.AlbumSpec (spec) where import Data.Text (Text) -import Network.Lastfm -import Network.Lastfm.Album +import Lastfm +import Lastfm.Album import Test.Hspec import Text.Xml.Lens diff --git a/test/api/Xml/ArtistSpec.hs b/test/api/Xml/ArtistSpec.hs --- a/test/api/Xml/ArtistSpec.hs +++ b/test/api/Xml/ArtistSpec.hs @@ -4,8 +4,8 @@ import Data.Text (Text) import Data.Traversable (traverse) -import Network.Lastfm -import Network.Lastfm.Artist +import Lastfm +import Lastfm.Artist import Test.Hspec import Text.Xml.Lens diff --git a/test/api/Xml/ChartSpec.hs b/test/api/Xml/ChartSpec.hs --- a/test/api/Xml/ChartSpec.hs +++ b/test/api/Xml/ChartSpec.hs @@ -3,8 +3,8 @@ module Xml.ChartSpec (spec) where import Data.Text (Text) -import Network.Lastfm -import Network.Lastfm.Chart +import Lastfm +import Lastfm.Chart import Test.Hspec import Text.Xml.Lens diff --git a/test/api/Xml/EventSpec.hs b/test/api/Xml/EventSpec.hs --- a/test/api/Xml/EventSpec.hs +++ b/test/api/Xml/EventSpec.hs @@ -2,8 +2,8 @@ {-# LANGUAGE OverloadedStrings #-} module Xml.EventSpec (spec) where -import Network.Lastfm -import Network.Lastfm.Event +import Lastfm +import Lastfm.Event import Test.Hspec import Text.Xml.Lens diff --git a/test/api/Xml/GeoSpec.hs b/test/api/Xml/GeoSpec.hs --- a/test/api/Xml/GeoSpec.hs +++ b/test/api/Xml/GeoSpec.hs @@ -3,8 +3,8 @@ module Xml.GeoSpec (spec) where import Data.Text (Text) -import Network.Lastfm -import Network.Lastfm.Geo +import Lastfm +import Lastfm.Geo import Test.Hspec import Text.Xml.Lens diff --git a/test/api/Xml/GroupSpec.hs b/test/api/Xml/GroupSpec.hs --- a/test/api/Xml/GroupSpec.hs +++ b/test/api/Xml/GroupSpec.hs @@ -2,8 +2,8 @@ {-# LANGUAGE OverloadedStrings #-} module Xml.GroupSpec (spec) where -import Network.Lastfm -import Network.Lastfm.Group +import Lastfm +import Lastfm.Group import Test.Hspec import Text.Xml.Lens diff --git a/test/api/Xml/LibrarySpec.hs b/test/api/Xml/LibrarySpec.hs --- a/test/api/Xml/LibrarySpec.hs +++ b/test/api/Xml/LibrarySpec.hs @@ -2,8 +2,8 @@ {-# LANGUAGE OverloadedStrings #-} module Xml.LibrarySpec (spec) where -import Network.Lastfm -import Network.Lastfm.Library +import Lastfm +import Lastfm.Library import Test.Hspec import Text.Xml.Lens diff --git a/test/api/Xml/PlaylistSpec.hs b/test/api/Xml/PlaylistSpec.hs --- a/test/api/Xml/PlaylistSpec.hs +++ b/test/api/Xml/PlaylistSpec.hs @@ -5,9 +5,9 @@ import Control.Lens import Data.Int (Int64) import Data.Text.Lens (unpacked) -import Network.Lastfm hiding (to) -import Network.Lastfm.Playlist -import Network.Lastfm.User +import Lastfm hiding (to) +import Lastfm.Playlist +import Lastfm.User import Test.Hspec import Test.HUnit (assertFailure) import Text.Printf @@ -25,7 +25,7 @@ root.node "playlists".node "playlist".node "title".text it "addTrack" $ do - r <- lastfm man $ getPlaylists <*> user "liblastfm" <*> ak' <* Network.Lastfm.xml + r <- lastfm man $ getPlaylists <*> user "liblastfm" <*> ak' <* Lastfm.xml case r of Left e -> assertFailure (printf "last.fm error: %s" (show e)) diff --git a/test/api/Xml/TagSpec.hs b/test/api/Xml/TagSpec.hs --- a/test/api/Xml/TagSpec.hs +++ b/test/api/Xml/TagSpec.hs @@ -2,8 +2,8 @@ {-# LANGUAGE OverloadedStrings #-} module Xml.TagSpec (spec) where -import Network.Lastfm -import Network.Lastfm.Tag +import Lastfm +import Lastfm.Tag import Test.Hspec import Text.Xml.Lens diff --git a/test/api/Xml/TasteometerSpec.hs b/test/api/Xml/TasteometerSpec.hs --- a/test/api/Xml/TasteometerSpec.hs +++ b/test/api/Xml/TasteometerSpec.hs @@ -3,8 +3,8 @@ module Xml.TasteometerSpec (spec) where import Data.Text (Text) -import Network.Lastfm -import qualified Network.Lastfm.Tasteometer as Taste +import Lastfm +import qualified Lastfm.Tasteometer as Taste import Test.Hspec import Text.Xml.Lens diff --git a/test/api/Xml/TrackSpec.hs b/test/api/Xml/TrackSpec.hs --- a/test/api/Xml/TrackSpec.hs +++ b/test/api/Xml/TrackSpec.hs @@ -4,8 +4,8 @@ import Data.Text (Text) import Data.Traversable (traverse) -import Network.Lastfm -import Network.Lastfm.Track +import Lastfm +import Lastfm.Track import Test.Hspec import Text.Xml.Lens diff --git a/test/api/Xml/UserSpec.hs b/test/api/Xml/UserSpec.hs --- a/test/api/Xml/UserSpec.hs +++ b/test/api/Xml/UserSpec.hs @@ -2,8 +2,8 @@ {-# LANGUAGE OverloadedStrings #-} module Xml.UserSpec (spec) where -import Network.Lastfm -import Network.Lastfm.User +import Lastfm +import Lastfm.User import Test.Hspec import Text.Xml.Lens diff --git a/test/api/Xml/VenueSpec.hs b/test/api/Xml/VenueSpec.hs --- a/test/api/Xml/VenueSpec.hs +++ b/test/api/Xml/VenueSpec.hs @@ -2,8 +2,8 @@ {-# LANGUAGE OverloadedStrings #-} module Xml.VenueSpec (spec) where -import Network.Lastfm -import Network.Lastfm.Venue +import Lastfm +import Lastfm.Venue import Test.Hspec import Text.Xml.Lens diff --git a/test/spec/Lastfm/ResponseSpec.hs b/test/spec/Lastfm/ResponseSpec.hs new file mode 100644 --- /dev/null +++ b/test/spec/Lastfm/ResponseSpec.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Lastfm.ResponseSpec (spec) where + +import Control.Exception (ArithException(..), throwIO, try) +import Control.Exception.Lens +import Control.Lens +import Data.Aeson (Value) +import Data.ByteString.Lazy (ByteString) +import Data.Aeson.Lens +import Test.Hspec.Lens +import Text.Xml.Lens +import Network.HTTP.Client (HttpException(..)) + +import Lastfm.Response + + +instance Eq HttpException where + _ == _ = True + + +spec :: Spec +spec = do + describe "md5" $ do + it "calculates the right hash for an empty string" $ + md5 "" `shouldBe` "d41d8cd98f00b204e9800998ecf8427e" + + it "calculates the right hash for an ascii string" $ + md5 "Enduser" `shouldBe` "28ced1fafec20ae302a04e9f27f4800f" + + it "calculates the right hash for a unicode string" $ + md5 "ДМИТРИЙ МАЛИКОВ" `shouldBe` "e02e5affef1004a02d9762619dc2a585" + + describe "try for LastfmError" $ do + let tryLastfmError :: IO a -> IO (Either LastfmError a) + tryLastfmError = try + + it "catches 'HttpException'" $ do + val <- tryLastfmError (throwIO ResponseTimeout) :: IO (Either LastfmError ()) + val `shouldHave` _Left._LastfmHttpError.only ResponseTimeout + + it "does not catch other exceptions" $ + tryLastfmError (throwIO DivideByZero) `shouldThrow` _DivideByZero + + describe "parse" $ do + context "JSON" $ do + let parseJSON :: ByteString -> Either LastfmError Value + parseJSON = parse + + it "handles good input" $ + let + good = "{ \"a\": { \"b\": 4 } }" + in + parseJSON good `shouldHave` _Right.key "a".key "b"._Integer.only 4 + + it "handles malformed input" $ + let + malformed = "not a json" + in + parseJSON malformed `shouldHave` _Left._LastfmBadResponse.only malformed + + it "handles input with encoded errors" $ + let + encodedError = "{ \"error\": 5, \"message\": \"foo\" }" + in + parseJSON encodedError `shouldHave` _Left._LastfmEncodedError.only (5, "foo") + + context "XML" $ do + let parseXML :: ByteString -> Either LastfmError Document + parseXML = parse + + it "handles good input" $ + let + good = "baz" + in + parseXML good `shouldHave` _Right.root.node "foo".node "bar".text.only "baz" + + it "handles malformed input" $ + let + malformed = "not a xml" + in + parseXML malformed `shouldHave` _Left._LastfmBadResponse.only malformed + + it "handles input with encoded errors" $ + let + encodedError = "foo" + in + parseXML encodedError `shouldHave` _Left._LastfmEncodedError.only (5, "foo") diff --git a/test/spec/Network/Lastfm/ResponseSpec.hs b/test/spec/Network/Lastfm/ResponseSpec.hs deleted file mode 100644 --- a/test/spec/Network/Lastfm/ResponseSpec.hs +++ /dev/null @@ -1,90 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -module Network.Lastfm.ResponseSpec (spec) where - -import Control.Exception (ArithException(..), throwIO, try) -import Control.Exception.Lens -import Control.Lens -import Data.Aeson (Value) -import Data.ByteString.Lazy (ByteString) -import Data.Aeson.Lens -import Test.Hspec.Lens -import Text.Xml.Lens -import Network.HTTP.Client (HttpException(..)) - -import Network.Lastfm.Response - - -instance Eq HttpException where - _ == _ = True - - -spec :: Spec -spec = do - describe "md5" $ do - it "calculates the right hash for an empty string" $ - md5 "" `shouldBe` "d41d8cd98f00b204e9800998ecf8427e" - - it "calculates the right hash for an ascii string" $ - md5 "Enduser" `shouldBe` "28ced1fafec20ae302a04e9f27f4800f" - - it "calculates the right hash for a unicode string" $ - md5 "ДМИТРИЙ МАЛИКОВ" `shouldBe` "e02e5affef1004a02d9762619dc2a585" - - describe "try for LastfmError" $ do - let tryLastfmError :: IO a -> IO (Either LastfmError a) - tryLastfmError = try - - it "catches 'HttpException'" $ do - val <- tryLastfmError (throwIO ResponseTimeout) :: IO (Either LastfmError ()) - val `shouldHave` _Left._LastfmHttpError.only ResponseTimeout - - it "does not catch other exceptions" $ - tryLastfmError (throwIO DivideByZero) `shouldThrow` _DivideByZero - - describe "parse" $ do - context "JSON" $ do - let parseJSON :: ByteString -> Either LastfmError Value - parseJSON = parse - - it "handles good input" $ - let - good = "{ \"a\": { \"b\": 4 } }" - in - parseJSON good `shouldHave` _Right.key "a".key "b"._Integer.only 4 - - it "handles malformed input" $ - let - malformed = "not a json" - in - parseJSON malformed `shouldHave` _Left._LastfmBadResponse.only malformed - - it "handles input with encoded errors" $ - let - encodedError = "{ \"error\": 5, \"message\": \"foo\" }" - in - parseJSON encodedError `shouldHave` _Left._LastfmEncodedError.only (5, "foo") - - context "XML" $ do - let parseXML :: ByteString -> Either LastfmError Document - parseXML = parse - - it "handles good input" $ - let - good = "baz" - in - parseXML good `shouldHave` _Right.root.node "foo".node "bar".text.only "baz" - - it "handles malformed input" $ - let - malformed = "not a xml" - in - parseXML malformed `shouldHave` _Left._LastfmBadResponse.only malformed - - it "handles input with encoded errors" $ - let - encodedError = "foo" - in - parseXML encodedError `shouldHave` _Left._LastfmEncodedError.only (5, "foo")