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/"
type CountryID = T.Text
data SearchCategory
= SearchAlbum
| SearchArtist
| SearchTrack
deriving (Eq, Ord)
instance Show SearchCategory where
show SearchAlbum = "album"
show SearchArtist = "artist"
show SearchTrack = "track"
build :: T.Text -> SpotID -> T.Text
build e = build2 e ""
build2 :: T.Text -> T.Text -> SpotID -> T.Text
build2 endpoint dir arg = T.intercalate "/" [endpoint, arg, dir]
getAlbum :: SpotID -> IO Album
getAlbum = fetch . build "albums"
getAlbumTracks :: SpotID -> P.Producer Track IO ()
getAlbumTracks = makeProducer Nothing W.defaults .build2 "albums" "tracks"
getArtist :: SpotID -> IO Artist
getArtist = fetch . build "artists"
getArtistAlbums :: SpotID -> P.Producer Album IO ()
getArtistAlbums = makeProducer Nothing W.defaults .build2 "artists" "albums"
type Predicate a = W.Response BL.ByteString -> IO a
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')
extractInner :: (FromJSON a) => W.Response BL.ByteString -> T.Text -> Maybe a
extractInner raw tag = locate >>= parseMaybe parseJSON
where
locate = raw ^? W.responseBody . key tag
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"
getArtistRelated :: SpotID -> IO [Artist]
getArtistRelated artist = do
reply <- grab W.defaults $ build2 "artists" "related-artists" artist
return .fromMaybe []$extractInner reply "artists"
getTrack :: SpotID -> IO Track
getTrack = fetch . build "tracks"
getUser :: T.Text -> IO User
getUser = fetch . build "users"
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
searchArtist :: T.Text -> P.Producer Artist IO ()
searchArtist = (^. _1) . search [SearchArtist]
searchAlbum :: T.Text -> P.Producer Album IO ()
searchAlbum = (^. _2) . search [SearchAlbum]
searchTrack :: T.Text -> P.Producer Track IO ()
searchTrack = (^. _3) . search [SearchTrack]
fetchOne :: Monad m => P.Producer a m () -> m (Maybe a)
fetchOne = P.head
fetchAll :: Monad m => P.Producer a m () -> m [a]
fetchAll = P.toListM
fetch :: FromJSON a => T.Text -> IO a
fetch = fetchWith W.defaults
fetchWith :: FromJSON a => W.Options -> T.Text -> IO a
fetchWith opts path' =
(^. W.responseBody) <$> (grab opts path' >>= W.asJSON)
grab :: W.Options -> T.Text -> IO (W.Response BL.ByteString)
grab opts path' =
W.getWith opts $baseURL <> versionURL <> T.unpack path'