--------------------------------------------------------------------------------

-- | Provides a way of dealing with errors encountered during the retrieval or
-- processing of data from the Codeforces API.
--
module Codeforces.Error where

import           Codeforces.Logging
import qualified Codeforces.Response           as R

--------------------------------------------------------------------------------

-- | An error that may occur in this application.
data CodeforcesError
    = ResponseError R.ResponseError
    | StandingsEmpty
    | StandingsWithFriendsEmpty
    | VirtualNoResult

-- | Returns a human-friendly error message with error details.
showE :: CodeforcesError -> ErrorLog
showE :: CodeforcesError -> ErrorLog
showE (ResponseError ResponseError
e) = ResponseError -> ErrorLog
R.responseErrorMsg ResponseError
e
showE CodeforcesError
StandingsEmpty    = String -> ErrorLog
mkErrorLog String
"Standings empty."
showE CodeforcesError
StandingsWithFriendsEmpty =
    String -> ErrorLog
mkErrorLog String
"Neither you nor your friends participated in this contest."
showE CodeforcesError
VirtualNoResult =
    String -> ErrorLog
mkErrorLog
        String
"An unexpected error occurred.\
            \ Your rating change could not be calculated."

--------------------------------------------------------------------------------

-- | 'handleE' @m@ runs the computation @m@ that may produce a
-- 'CodeforcesError'. If an error is encountered, its error message is printed.
handleE :: IO (Either CodeforcesError a) -> IO ()
handleE :: IO (Either CodeforcesError a) -> IO ()
handleE IO (Either CodeforcesError a)
m = IO (Either CodeforcesError a)
m IO (Either CodeforcesError a)
-> (Either CodeforcesError a -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left  CodeforcesError
e -> String -> IO ()
putStrLn (String -> IO ())
-> (CodeforcesError -> String) -> CodeforcesError -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorLog -> String
elErrorMsg (ErrorLog -> String)
-> (CodeforcesError -> ErrorLog) -> CodeforcesError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeforcesError -> ErrorLog
showE (CodeforcesError -> IO ()) -> CodeforcesError -> IO ()
forall a b. (a -> b) -> a -> b
$ CodeforcesError
e
    Right a
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

--------------------------------------------------------------------------------