{-# LANGUAGE OverloadedStrings #-}

module Text.Hastily.Network (
        getFrom,
        getFromUrlAndDo
        ) where

import           Control.Concurrent.Thread.Delay (delay)
import           Control.Exception
import           Control.Monad.Catch             hiding (try)
import           Data.ByteString.Char8           hiding (putStrLn)
import qualified Data.ByteString.Lazy            as LZ
import           Data.String.Conversions
import           Data.Text                       (Text)
import           Network.HTTP.Client

makeGetRequestObject :: Control.Monad.Catch.MonadThrow m => String -> [(Text, Text)] -> m Request
makeGetRequestObject url query_pairs = do
    r <- parseUrl url
    return $ setQueryString (makeBST query_pairs) r
    where
        makeBST :: [(Text, Text)] -> [(ByteString, Maybe ByteString)]
        makeBST st = fmap makeBST' st
            where
                makeBST' :: (Text, Text) -> (ByteString, Maybe ByteString)
                makeBST' (a1, a2) = (pack $ (cs a1::String), Just $ pack $ (cs a2::String))

getFrom :: String -> [(Text, Text)] -> IO (Either SomeException LZ.ByteString)
getFrom url query_pairs =
    getFrom' url query_pairs 0
    where
    getFrom' :: String -> [(Text, Text)] -> Integer -> IO (Either SomeException LZ.ByteString)
    getFrom' url query_pairs attempt_count = do
        manager <- newManager defaultManagerSettings
        request <- makeGetRequestObject url query_pairs
        either_response <- try $ httpLbs request manager :: IO (Either SomeException (Response LZ.ByteString))
        case either_response of
            Left err -> do
                showErr err
                if attempt_count < 5
                    then getFrom' url query_pairs (attempt_count + 1)
                    else return $ Left err
            Right response -> return $ Right $ responseBody response

getFromUrlAndDo :: String -> [(Text, Text)] -> (Response BodyReader -> IO b) -> IO (Either SomeException b)
getFromUrlAndDo url query_pairs func = getFromUrlAndDo' url query_pairs func 0
    where
    getFromUrlAndDo' :: String -> [(Text, Text)] -> (Response BodyReader -> IO b) -> Integer -> IO (Either SomeException b)
    getFromUrlAndDo' url query_pairs func attempt_count = do
        manager <- newManager defaultManagerSettings
        request <- makeGetRequestObject url query_pairs
        either_result <- try $ withResponse request manager func
        case either_result of
            Left err -> do
                showErr err
                if attempt_count < 5
                    then getFromUrlAndDo' url query_pairs func (attempt_count + 1)
                    else return $ Left err
            Right result -> return $ Right result

showErr :: SomeException -> IO ()
showErr err = do
    putStrLn $ show err
    putStrLn "Retrying in 5 seconds.."
    delay 5000000