{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}

module MusicScroll.Web (getLyricsFromWeb) where

import Control.Applicative (Alternative (empty))
import Control.Exception (try)
import Control.Monad.IO.Class (MonadIO (..))
import Data.Text.Encoding (decodeUtf8)
import MusicScroll.Providers.Utils
import MusicScroll.TrackInfo (TrackInfo (..))
import Network.HTTP.Req

getLyricsFromWeb ::
  (MonadIO m, Alternative m) =>
  Provider ->
  TrackInfo ->
  m Lyrics
getLyricsFromWeb :: forall (m :: * -> *).
(MonadIO m, Alternative m) =>
Provider -> TrackInfo -> m Lyrics
getLyricsFromWeb (Provider {Text -> Lyrics
TrackInfo -> Url 'Https
toUrl :: TrackInfo -> Url 'Https
extractLyricsFromPage :: Text -> Lyrics
toUrl :: Provider -> TrackInfo -> Url 'Https
extractLyricsFromPage :: Provider -> Text -> Lyrics
..}) TrackInfo
track =
  do
    let songUrl :: Url 'Https
songUrl = TrackInfo -> Url 'Https
toUrl TrackInfo
track
    Either HttpException BsResponse
resp <- IO (Either HttpException BsResponse)
-> m (Either HttpException BsResponse)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either HttpException BsResponse)
 -> m (Either HttpException BsResponse))
-> IO (Either HttpException BsResponse)
-> m (Either HttpException BsResponse)
forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
try @HttpException (Url 'Https -> IO BsResponse
getPage Url 'Https
songUrl)
    let notValid :: Bool
notValid =
          (HttpException -> Bool)
-> (BsResponse -> Bool) -> Either HttpException BsResponse -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            (Bool -> HttpException -> Bool
forall a b. a -> b -> a
const Bool
True)
            ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
200) (Int -> Bool) -> (BsResponse -> Int) -> BsResponse -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BsResponse -> Int
forall response. HttpResponse response => response -> Int
responseStatusCode)
            Either HttpException BsResponse
resp
    if Bool
notValid
      then m Lyrics
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
      else
        let Right BsResponse
realResp = Either HttpException BsResponse
resp
            body :: Text
body = ByteString -> Text
decodeUtf8 (BsResponse -> HttpResponseBody BsResponse
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody BsResponse
realResp)
            lyrics :: Lyrics
lyrics = Text -> Lyrics
extractLyricsFromPage Text
body
         in Lyrics -> m Lyrics
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Lyrics
lyrics

getPage :: Url 'Https -> IO BsResponse
getPage :: Url 'Https -> IO BsResponse
getPage Url 'Https
url =
  HttpConfig -> Req BsResponse -> IO BsResponse
forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq HttpConfig
defaultHttpConfig (Req BsResponse -> IO BsResponse)
-> Req BsResponse -> IO BsResponse
forall a b. (a -> b) -> a -> b
$
    GET
-> Url 'Https
-> NoReqBody
-> Proxy BsResponse
-> Option 'Https
-> Req BsResponse
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
 HttpResponse response,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req GET
GET Url 'Https
url NoReqBody
NoReqBody Proxy BsResponse
bsResponse Option 'Https
forall a. Monoid a => a
mempty