Use HttpClient in contest parsers and CheckUpdates

libcaide/libcaide.cabal

@@ -196,7 +196,6 @@ library
         Data.Text.Encoding.Util
         Data.Text.IO.Util
         Filesystem.Util
-        Network.HTTP.Util
         Paths_CaideExt
         Paths_libcaide
         System.IO.Util

libcaide/src/Caide/CheckUpdates.hs

@@ -21,10 +21,10 @@ import qualified Data.Aeson as Aeson
 import Paths_libcaide (version)
 import Caide.GlobalState (GlobalState(latestVersion, lastUpdateCheck), readGlobalState, modifyGlobalState, flushGlobalState)
 import Caide.Logger (logInfo, logWarn)
+import Caide.Parsers.Common (downloadDocument)
 import Caide.Settings (autoCheckUpdates)
-import Caide.Types (CaideIO, caideSettings, throw)
+import Caide.Types (CaideIO, caideHttpClient, caideSettings, throw)
 import Caide.Util (withLock)
-import Network.HTTP.Util (downloadDocument)
 
 
 data Release = Release
@@ -50,7 +50,8 @@ parseLatestVersion s = do
 
 checkUpdatesImpl :: CaideIO ()
 checkUpdatesImpl = do
-    releases <- liftIO $ downloadDocument "https://api.github.com/repos/slycelote/caide/releases"
+    client <- caideHttpClient
+    releases <- downloadDocument client "https://api.github.com/repos/slycelote/caide/releases"
     case releases of
         Left e -> throw e
         Right contents -> do

libcaide/src/Caide/Commands/ParseContest.hs

@@ -3,19 +3,27 @@ module Caide.Commands.ParseContest(
       createContest
 ) where
 
+import Control.Monad.Extended (liftIO)
 import Data.List (find)
 
-import Caide.Types (CaideIO, throw)
+import Caide.Types (CaideIO, throw, caideHttpClient)
 
-import Caide.Parsers.Common (URL, ContestParser(..))
+import Caide.Commands.ParseProblem (parseProblems)
+import Caide.Parsers.Common (URL, ContestParser(..), ContestParserResult(Urls, Problems))
 import Caide.Parsers.CodeforcesContest
 import Caide.Parsers.CodeChefContest
 import qualified Caide.Parsers.LeetCodeContest as LeetCode
 
 createContest :: URL -> CaideIO ()
 createContest contestUrl = case findContestParser contestUrl of
     Nothing -> throw $ contestUrl <> " is not recognized as a supported contest URL"
-    Just contestParser -> contestParser `parseContest` contestUrl
+    Just contestParser -> do
+        client <- caideHttpClient
+        result <- liftIO $ parseContest contestParser client contestUrl
+        case result of
+            Left err -> throw err
+            Right (Urls urls) -> parseProblems 3 urls
+            Right (Problems _problems) -> throw "TODO"
 
 contestParsers :: [ContestParser]
 contestParsers = [codeforcesContestParser, codeChefContestParser, LeetCode.contestParser]

libcaide/src/Caide/Parsers/CodeChefContest.hs

@@ -3,22 +3,20 @@ module Caide.Parsers.CodeChefContest(
       codeChefContestParser
 ) where
 
-import Control.Monad.Except (throwError)
-import Control.Monad.IO.Class (liftIO)
-import qualified Data.ByteString.Lazy as LBS
+import Control.Monad.Extended (liftEither, orThrow, runExceptT)
+import Data.Either.Util (mapLeft)
 import qualified Data.Map.Strict as Map
 import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Network.URI (parseURI, uriPath)
 
 import qualified Data.Aeson as Aeson
 
-import Caide.Commands.ParseProblem (parseProblems)
-import Caide.Parsers.Common (URL, ContestParser(..), isHostOneOf)
-import Caide.Types
-import Caide.Util (downloadDocument)
+import qualified Caide.HttpClient as Http
+import Caide.Parsers.Common (URL, ContestParser(..), ContestParserResult(Urls),
+    isHostOneOf)
+
 
 codeChefContestParser :: ContestParser
 codeChefContestParser = ContestParser
@@ -35,25 +33,23 @@ data JsonProblem = JsonProblem
                  } deriving (Generic, Show)
 
 data JsonContest = JsonContest
-                 { problems :: Map.Map ProblemID JsonProblem
+                 { problems :: Map.Map Text JsonProblem
                  } deriving (Generic, Show)
 
 instance Aeson.FromJSON JsonProblem
 instance Aeson.FromJSON JsonContest
 
-parseFromJson :: Text -> Either Text [ProblemID]
-parseFromJson jsonText = case Aeson.eitherDecode' . LBS.fromStrict . encodeUtf8 $ jsonText of
-    Left err -> throwError $ T.pack err
-    Right contest -> return $ Map.keys $ problems $ contest
 
-doParseContest :: URL -> CaideIO ()
-doParseContest url = case uriPath <$> parseURI (T.unpack url) of
-    Just (_:contestId) -> do
-        let apiUrl = "https://www.codechef.com/api/contests/" <> T.pack contestId
+doParseContest :: Http.Client -> URL -> IO (Either Text ContestParserResult)
+doParseContest client url = case uriPath <$> parseURI (T.unpack url) of
+    Just (_:contestId) -> runExceptT $ do
+        let apiUrl = "https://www.codechef.com/api/contests/" <> contestId
             probUrlPrefix = "https://www.codechef.com/" <> T.pack contestId <> "/problems/"
-        mbDoc <- liftIO $ downloadDocument apiUrl
-        case mbDoc >>= parseFromJson of
-            Left err      -> throw err
-            Right probIds -> parseProblems 1 $ map (probUrlPrefix <> ) probIds
-    _ -> throw "Invalid contest url"
+        apiUri <- parseURI apiUrl `orThrow` "Invalid API URL"
+        doc <- Http.get client apiUri >>= liftEither
+        contest <- liftEither $ mapLeft T.pack $ Aeson.eitherDecode' doc
+        let probIds = Map.keys $ problems contest
+        pure $ Urls $ map (probUrlPrefix <> ) probIds
+
+    _ -> pure $ Left "Invalid contest url"
 

libcaide/src/Caide/Parsers/CodeforcesContest.hs

@@ -3,19 +3,18 @@ module Caide.Parsers.CodeforcesContest(
       codeforcesContestParser
 ) where
 
-import Control.Monad.Except (liftIO)
 import Data.Maybe (mapMaybe)
 
 import qualified Data.Text as T
+import Data.Text (Text)
 
 import Text.HTML.TagSoup (partitions, parseTags, fromAttrib, Tag)
 import Text.HTML.TagSoup.Utils
 
 
-import Caide.Commands.ParseProblem (parseProblems)
-import Caide.Parsers.Common (URL, ContestParser(..), isHostOneOf)
-import Caide.Types
-import Caide.Util (downloadDocument)
+import qualified Caide.HttpClient as Http
+import Caide.Parsers.Common (URL, ContestParser(..), ContestParserResult(Urls),
+    downloadDocument, isHostOneOf)
 
 
 codeforcesContestParser :: ContestParser
@@ -27,12 +26,12 @@ codeforcesContestParser = ContestParser
 isCodeForcesUrl :: URL -> Bool
 isCodeForcesUrl = isHostOneOf ["codeforces.com", "www.codeforces.com", "codeforces.ru", "www.codeforces.ru", "codeforces.ml", "www.codeforces.ml"]
 
-doParseContest :: URL -> CaideIO ()
-doParseContest url = do
-    maybeUrls <- liftIO $ parseCfContest <$> downloadDocument url
+doParseContest :: Http.Client -> URL -> IO (Either Text ContestParserResult)
+doParseContest client url = do
+    maybeUrls <- parseCfContest <$> downloadDocument client url
     case maybeUrls of
-        Left err   -> throw err
-        Right urls -> parseProblems 3  urls
+        Left err   -> return $ Left err
+        Right urls -> return $ Right $ Urls urls
 
 parseCfContest :: Either T.Text URL -> Either T.Text [T.Text]
 parseCfContest (Left err)   = Left err

libcaide/src/Caide/Parsers/Common.hs

@@ -8,12 +8,13 @@ module Caide.Parsers.Common(
     , ProblemParser(..)
     , CHelperProblemParser(..)
     , HtmlProblemParser
+    , ContestParserResult(..)
     , ContestParser(..)
     , makeProblemParser
     , isHostOneOf
 ) where
 
-import Control.Monad.Extended (liftEither, orThrow, runExceptT)
+import Control.Monad.Extended (MonadIO, liftEither, liftIO, orThrow, runExceptT)
 import qualified Data.ByteString.Lazy as LBS
 import Data.Function ((&))
 import Data.Functor ((<&>))
@@ -29,7 +30,7 @@ import Text.HTML.TagSoup.Utils (isTagName)
 import Text.StringLike (StringLike, strConcat)
 
 import qualified Caide.HttpClient as Http
-import Caide.Types (Problem, TestCase(TestCase), CaideIO)
+import Caide.Types (Problem, TestCase(TestCase))
 
 
 type URL = T.Text
@@ -47,9 +48,13 @@ data CHelperProblemParser = CHelperProblemParser
 
 type HtmlProblemParser = T.Text -> IO (Either T.Text (Problem, [TestCase]))
 
+-- | Contest parser can return either a list of problem URLs or a list of parsed problems.
+data ContestParserResult = Urls [URL]
+                         | Problems [(Problem, [TestCase])]
+
 data ContestParser = ContestParser
     { contestUrlMatches :: URL -> Bool
-    , parseContest      :: URL -> CaideIO ()
+    , parseContest      :: Http.Client -> URL -> IO (Either T.Text ContestParserResult)
     }
 
 makeProblemParser :: (URL -> Bool) -> HtmlProblemParser -> ProblemParser
@@ -64,8 +69,8 @@ makeProblemParser matchPredicate htmlParser = ProblemParser matchPredicate parse
 isHostOneOf :: [String] -> URL -> Bool
 isHostOneOf hosts url = (url & T.unpack & parseURI >>= uriAuthority <&> uriRegName) `elem` (map Just hosts)
 
-downloadDocument :: Http.Client -> URL -> IO (Either T.Text T.Text)
-downloadDocument client url = runExceptT $ do
+downloadDocument :: MonadIO m => Http.Client -> URL -> m (Either T.Text T.Text)
+downloadDocument client url = liftIO $ runExceptT $ do
     uri <- parseURI (T.unpack url) `orThrow` "Invalid URL"
     lbsBody <- Http.get client uri >>= liftEither
     pure $ T.safeDecodeUtf8 $ LBS.toStrict $ lbsBody

libcaide/src/Caide/Parsers/LeetCodeContest.hs

@@ -3,22 +3,18 @@ module Caide.Parsers.LeetCodeContest(
       contestParser
 ) where
 
-import Control.Monad.Extended (liftIO)
-import qualified Data.ByteString.Lazy as LBS
 import Data.Either.Util (mapLeft)
 import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
 import Data.Text (Text)
 
 import GHC.Generics (Generic)
 import Network.URI (parseURI, pathSegments, URI(uriPath, uriQuery, uriFragment))
 
 import qualified Data.Aeson as Aeson
 
-import Caide.Commands.ParseProblem (parseProblems)
-import Caide.Parsers.Common (URL, ContestParser(..), isHostOneOf)
-import Caide.Types
-import Caide.Util (downloadDocument, tshow)
+import qualified Caide.HttpClient as Http
+import Caide.Parsers.Common (URL, ContestParser(..), ContestParserResult(Urls), isHostOneOf)
+import Caide.Util (tshow)
 
 
 isLeetCodeUrl :: URL -> Bool
@@ -40,22 +36,19 @@ newtype Contest = Contest { questions :: [ProblemInContest] }
 instance Aeson.FromJSON Contest
 
 
-eitherDecodeText' :: Aeson.FromJSON a => Text -> Either Text a
-eitherDecodeText' = mapLeft T.pack . Aeson.eitherDecode' . LBS.fromStrict . T.encodeUtf8
-
-doParseContest :: URL -> CaideIO ()
-doParseContest url = case (mbUri, mbPathSegments) of
+doParseContest :: Http.Client -> URL -> IO (Either Text ContestParserResult)
+doParseContest client url = case (mbUri, mbPathSegments) of
     (Just uri, Just seg) | length seg >= 2 && seg !! (length seg - 2) == "contest" -> do
         let contestId = last seg
             apiUri = uri{uriPath = "/contest/api/info/" <> contestId <> "/", uriQuery="", uriFragment=""}
             probUrlPrefix = tshow $ apiUri{uriPath="/problems/"}
-        mbDoc <- liftIO $ downloadDocument $ tshow apiUri
-        case mbDoc >>= eitherDecodeText' of
-            Left err -> throw err
-            Right (Contest{questions}) -> parseProblems 3 $
+        mbDoc <- Http.get client apiUri
+        case mbDoc >>= (mapLeft T.pack . Aeson.eitherDecode') of
+            Left err -> pure $ Left err
+            Right (Contest{questions}) -> pure . Right . Urls $
                 [ probUrlPrefix <> (title_slug prob) | prob <- questions ]
 
-    _ -> throw "Invalid contest url"
+    _ -> pure $ Left "Invalid contest url"
   where
     mbUri = parseURI (T.unpack url)
     mbPathSegments = pathSegments <$> mbUri

libcaide/src/Caide/Util.hs

@@ -2,8 +2,7 @@
 {- | Common utilities
 -}
 module Caide.Util(
-      downloadDocument
-    , newDefaultHttpClient
+      newDefaultHttpClient
     , mapWithLimitedThreads
     , tshow
     , readTextFile'
@@ -23,7 +22,6 @@ import System.FileLock (SharedExclusive(Exclusive), tryLockFile, unlockFile)
 import Network.HTTP.Types.Header (hAccept, hAcceptEncoding, hUserAgent)
 
 import Filesystem.Util (pathToText, readTextFile)
-import Network.HTTP.Util (downloadDocument)
 import qualified Caide.CodeforcesCookie as CodeforcesCookie
 import Caide.Configuration (orDefault)
 import qualified Caide.HttpClient as Http