{-# LANGUAGE NoMonomorphismRestriction, OverloadedStrings, ScopedTypeVariables #-} module Utils.Spoty ( module Utils.Spoty.Types, getAlbum, getAlbumTracks, getArtist, getArtistAlbums, CountryID, getArtistTop, getArtistRelated, SearchCategory(..), search, searchArtist, searchAlbum, searchTrack, getTrack, getUser, fetchOne, fetchAll ) where import Control.Applicative ((<$>)) import Control.Exception (throw) import Control.Lens import Control.Monad (when) import Data.Aeson import Data.Aeson.Lens (key) import Data.Aeson.Types (parseMaybe) import qualified Data.ByteString.Lazy.Char8 as BL import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import qualified Data.Text as T import qualified Network.Wreq as W import qualified Pipes as P import qualified Pipes.Prelude as P import Utils.Spoty.Types baseURL, versionURL :: String baseURL = "https://api.spotify.com/" versionURL = "v1/" -- | Country identifier e.g. \"SE\". type CountryID = T.Text -- | Categories being used in a search. data SearchCategory = SearchAlbum -- ^ Search for albums. | SearchArtist -- ^ Search for artists. | SearchTrack -- ^ Search for tracks. deriving (Eq, Ord) instance Show SearchCategory where show SearchAlbum = "album" show SearchArtist = "artist" show SearchTrack = "track" -- | Construct a URL from an endpoint and an identifier. build :: T.Text -> SpotID -> T.Text build e = build2 e "" -- | Construct a URL from endpoint / spotify id / subdir. build2 :: T.Text -> T.Text -> SpotID -> T.Text build2 endpoint dir arg = T.intercalate "/" [endpoint, arg, dir] -- | Retrieve an album. getAlbum :: SpotID -> IO Album getAlbum = fetch . build "albums" -- | Retrieve the tracks of an album. getAlbumTracks :: SpotID -> P.Producer Track IO () getAlbumTracks = makeProducer Nothing W.defaults . build2 "albums" "tracks" -- | Retrieve an artist. getArtist :: SpotID -> IO Artist getArtist = fetch . build "artists" -- | Retrieve the albums of an artist. getArtistAlbums :: SpotID -> P.Producer Album IO () getArtistAlbums = makeProducer Nothing W.defaults . build2 "artists" "albums" type Predicate a = W.Response BL.ByteString -> IO a -- | Construct producer (source) from URL generating a paging object. -- Optionally accepts a predicate applied on the retrieved JSON object. makeProducer :: FromJSON a => Maybe (Predicate (Paging a)) -> W.Options -> T.Text -> P.Producer a IO () makeProducer predicate opts url = go 0 where go off = do let opts' = opts & W.param "offset" .~ [T.pack $ show off] reply <- P.liftIO $ grab opts' url let f = fromMaybe (fmap (^. W.responseBody) . W.asJSON) predicate (chunk :: Paging b) <- P.liftIO $ f reply mapM_ P.yield $ chunk ^. items let delta = length $ chunk ^. items off' = off + delta when (off' < chunk ^. total) (go off') -- | Extract the value associated with the given key from a response. extractInner :: (FromJSON a) => W.Response BL.ByteString -> T.Text -> Maybe a extractInner raw tag = locate >>= parseMaybe parseJSON where locate = raw ^? W.responseBody . key tag -- | Retrieve the most popular tracks of an artist. getArtistTop :: SpotID -> CountryID -> IO [Track] getArtistTop artist country = do let opts = W.defaults & W.param "country" .~ [country] reply <- grab opts $ build2 "artists" "top-tracks" artist return . fromMaybe [] $ extractInner reply "tracks" -- | Retrieve a few related artists. getArtistRelated :: SpotID -> IO [Artist] getArtistRelated artist = do reply <- grab W.defaults $ build2 "artists" "related-artists" artist return . fromMaybe [] $ extractInner reply "artists" -- | Retrieve a track. getTrack :: SpotID -> IO Track getTrack = fetch . build "tracks" -- | Retrieve an user. getUser :: T.Text -> IO User getUser = fetch . build "users" -- | Search for some string in the given categories. search :: [SearchCategory] -> T.Text -> (P.Producer Artist IO (), P.Producer Album IO (), P.Producer Track IO ()) search cats term = (extract SearchArtist, extract SearchAlbum, extract SearchTrack) where opts = W.defaults & W.param "q" .~ [term] & W.param "type" .~ [T.intercalate "," $ map (T.pack . show) cats] pluralize = T.pack . (<> "s") . show extract tag = when (tag `elem` cats) (makeProducer (Just $ predicate tag) opts url) url = build "search" "" predicate tag reply = case extractInner reply (pluralize tag) of Just val -> return val Nothing -> throw . W.JSONError $ "Unexpected search result, got: " <> show reply -- | Search for artists. searchArtist :: T.Text -> P.Producer Artist IO () searchArtist = (^. _1) . search [SearchArtist] -- | Search for albums. searchAlbum :: T.Text -> P.Producer Album IO () searchAlbum = (^. _2) . search [SearchAlbum] -- | Search for tracks. searchTrack :: T.Text -> P.Producer Track IO () searchTrack = (^. _3) . search [SearchTrack] -- | Fetch one element from the producer and discard the rest. fetchOne :: Monad m => P.Producer a m () -> m (Maybe a) fetchOne = P.head -- | Fetch all elements from the producer (NOTE: not constant space). fetchAll :: Monad m => P.Producer a m () -> m [a] fetchAll = P.toListM -- | Fetch a path and decode the corresponding object. fetch :: FromJSON a => T.Text -> IO a fetch = fetchWith W.defaults -- | Fetch a path with the given HTTP options and decode the corresponding object. fetchWith :: FromJSON a => W.Options -> T.Text -> IO a fetchWith opts path' = (^. W.responseBody) <$> (grab opts path' >>= W.asJSON) -- | Fetch a path with the given HTTP options and return the raw response. grab :: W.Options -> T.Text -> IO (W.Response BL.ByteString) grab opts path' = W.getWith opts $ baseURL <> versionURL <> T.unpack path'