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

-- | Problems command.
module Codeforces.App.Commands.ProblemsCmd
    ( problemList
    ) where

import           Codeforces.API
import           Codeforces.App.Format
import           Codeforces.App.Options
import           Codeforces.App.Table
import           Codeforces.Error

import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Except

import           Data.Text                      ( Text )
import qualified Data.Text.IO                  as T

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

problemList :: ProblemOpts -> IO ()
problemList :: ProblemOpts -> IO ()
problemList ProblemOpts {Rating
optMaxRating :: ProblemOpts -> Rating
optMinRating :: ProblemOpts -> Rating
optMaxRating :: Rating
optMinRating :: Rating
..} = IO (Either CodeforcesError ()) -> IO ()
forall a. IO (Either CodeforcesError a) -> IO ()
handleE (IO (Either CodeforcesError ()) -> IO ())
-> IO (Either CodeforcesError ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ExceptT CodeforcesError IO () -> IO (Either CodeforcesError ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT CodeforcesError IO () -> IO (Either CodeforcesError ()))
-> ExceptT CodeforcesError IO () -> IO (Either CodeforcesError ())
forall a b. (a -> b) -> a -> b
$ do
    let ratingBounds :: Problem -> Bool
ratingBounds = (Rating, Rating) -> Problem -> Bool
inRatingRange (Rating
optMinRating, Rating
optMaxRating)

    [Problem]
problems <- IO (Either ResponseError [Problem])
-> ExceptT CodeforcesError IO [Problem]
forall a.
IO (Either ResponseError a) -> ExceptT CodeforcesError IO a
handleAPI (IO (Either ResponseError [Problem])
 -> ExceptT CodeforcesError IO [Problem])
-> IO (Either ResponseError [Problem])
-> ExceptT CodeforcesError IO [Problem]
forall a b. (a -> b) -> a -> b
$ ([Problem] -> [Problem])
-> Either ResponseError [Problem] -> Either ResponseError [Problem]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Problem -> Bool) -> [Problem] -> [Problem]
forall a. (a -> Bool) -> [a] -> [a]
filter Problem -> Bool
ratingBounds) (Either ResponseError [Problem] -> Either ResponseError [Problem])
-> IO (Either ResponseError [Problem])
-> IO (Either ResponseError [Problem])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ProblemTag] -> IO (Either ResponseError [Problem])
getProblems []

    let headers :: [(ProblemTag, Rating)]
headers = [(ProblemTag
"#", Rating
6), (ProblemTag
"Name", Rating
40), (ProblemTag
"Rating", Rating
6)]
        rows :: [[Cell]]
rows    = (Problem -> [Cell]) -> [Problem] -> [[Cell]]
forall a b. (a -> b) -> [a] -> [b]
map
            (\Problem {[ProblemTag]
Maybe Points
Maybe Rating
Maybe ProblemTag
Maybe ContestId
ProblemTag
ProblemType
problemTags :: Problem -> [ProblemTag]
problemRating :: Problem -> Maybe Rating
problemPoints :: Problem -> Maybe Points
problemType :: Problem -> ProblemType
problemName :: Problem -> ProblemTag
problemIndex :: Problem -> ProblemTag
problemSetName :: Problem -> Maybe ProblemTag
problemContestId :: Problem -> Maybe ContestId
problemTags :: [ProblemTag]
problemRating :: Maybe Rating
problemPoints :: Maybe Points
problemType :: ProblemType
problemName :: ProblemTag
problemIndex :: ProblemTag
problemSetName :: Maybe ProblemTag
problemContestId :: Maybe ContestId
..} ->
                [ ProblemTag -> Cell
plainCell (ProblemTag -> Cell) -> ProblemTag -> Cell
forall a b. (a -> b) -> a -> b
$ Maybe ContestId -> ProblemTag -> ProblemTag
fmtProblemIndex Maybe ContestId
problemContestId ProblemTag
problemIndex
                , ProblemTag -> Cell
plainCell ProblemTag
problemName
                , Cell -> (Rating -> Cell) -> Maybe Rating -> Cell
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Cell
blankCell Rating -> Cell
ratingCell Maybe Rating
problemRating
                ]
            )
            [Problem]
problems

    IO () -> ExceptT CodeforcesError IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ExceptT CodeforcesError IO ())
-> IO () -> ExceptT CodeforcesError IO ()
forall a b. (a -> b) -> a -> b
$ (ProblemTag -> IO ()) -> [ProblemTag] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ProblemTag -> IO ()
T.putStrLn ([ProblemTag] -> IO ()) -> [ProblemTag] -> IO ()
forall a b. (a -> b) -> a -> b
$ [(ProblemTag, Rating)] -> [[Cell]] -> [ProblemTag]
makeTable [(ProblemTag, Rating)]
headers [[Cell]]
rows

fmtProblemIndex :: Maybe ContestId -> ProblemIndex -> Text
fmtProblemIndex :: Maybe ContestId -> ProblemTag -> ProblemTag
fmtProblemIndex Maybe ContestId
cId ProblemTag
pIdx = ProblemTag
-> (ContestId -> ProblemTag) -> Maybe ContestId -> ProblemTag
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ProblemTag
"" (Rating -> ProblemTag
forall a. Show a => a -> ProblemTag
showText (Rating -> ProblemTag)
-> (ContestId -> Rating) -> ContestId -> ProblemTag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContestId -> Rating
unContestId) Maybe ContestId
cId ProblemTag -> ProblemTag -> ProblemTag
forall a. Semigroup a => a -> a -> a
<> ProblemTag
pIdx

inRatingRange :: (Rating, Rating) -> Problem -> Bool
inRatingRange :: (Rating, Rating) -> Problem -> Bool
inRatingRange (Rating
minr, Rating
maxr) Problem
p = case Problem -> Maybe Rating
problemRating Problem
p of
    Maybe Rating
Nothing -> Bool
False
    Just Rating
r  -> Rating
minr Rating -> Rating -> Bool
forall a. Ord a => a -> a -> Bool
<= Rating
r Bool -> Bool -> Bool
&& Rating
r Rating -> Rating -> Bool
forall a. Ord a => a -> a -> Bool
<= Rating
maxr

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