exh 1.0.0 → 1.0.1

raw patch · 4 files changed

+72/−12 lines, 4 filesdep ~in-other-wordsdep ~language-javascriptdep ~optics-corePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: in-other-words, language-javascript, optics-core, optics-th, transformers, xml-optics

API changes (from Hackage documentation)

Files

CHANGELOG.md +5/−0
exh.cabal +10/−10
src/Web/Exhentai/Utils.hs +6/−0
test/Spec.hs +51/−2

CHANGELOG.md view

@@ -12,3 +12,8 @@ ## 1.0.0  - Rewrite using in-other-words++## 1.0.1++- Performance optimizations+- Add stricter version bounds

exh.cabal view

@@ -1,6 +1,6 @@ cabal-version:   3.0 name:            exh-version:         1.0.0+version:         1.0.1 synopsis:        A library for crawling exhentai description:   A library for crawling exhentai, with the support of streaming@@ -12,8 +12,8 @@ maintainer:      Poscat <poscat@mail.poscat.moe> copyright:       Copyright (c) Poscat 2021 stability:       experimental-homepage:        https://github.com/poscat0x04/exh-bug-reports:     https://github.com/poscat0x04/exh/issues+homepage:        https://github.com/The-closed-eye-of-love/exh+bug-reports:     https://github.com/The-closed-eye-of-love/exh/issues extra-doc-files:   CHANGELOG.md   README.md@@ -27,16 +27,16 @@     , containers           ^>=0.6.2     , html-conduit         ^>=1.3.2     , http-client          >=0.6.4   && <0.8-    , in-other-words-    , language-javascript+    , in-other-words       ^>=0.2.0+    , language-javascript  ^>=0.7.0     , megaparsec           ^>=9.0-    , optics-core-    , optics-th+    , optics-core          ^>=0.3+    , optics-th            ^>=0.3     , text                 ^>=1.2.3     , time                 >=1.9.3   && <1.12-    , transformers+    , transformers         ^>=0.5.6     , xml-conduit          >=1.8.0   && <1.10-    , xml-optics+    , xml-optics           ^>=0.1.0    default-language:   Haskell2010   default-extensions:@@ -105,4 +105,4 @@  source-repository head   type:     git-  location: https://github.com/poscat0x04/exh+  location: https://github.com/The-closed-eye-of-love/exh

src/Web/Exhentai/Utils.hs view

@@ -83,28 +83,34 @@  sinkAeson :: (FromJSON a, Monad m) => ConduitT ByteString o m (Either String a) sinkAeson = eitherDecode <$> sinkLazy+{-# INLINE sinkAeson #-}  jsonRequest :: (FromJSON a, Effs '[Http, Error HttpException, ConduitIO, Cookie, Bracket] m) => Request -> m (Either String a) jsonRequest req = evalContT $ do   resp <- withSource req   lift $ runConduitIO $ responseBody resp .| sinkAeson+{-# INLINEABLE jsonRequest #-}  htmlRequest :: Effs '[Http, Error HttpException, ConduitIO, Cookie, Bracket] m => Request -> m Document htmlRequest req = evalContT $ do   resp <- withSource req   lift $ runConduitIO $ responseBody resp .| sinkDoc+{-# INLINEABLE htmlRequest #-}  htmlRequest' :: Effs '[Http, Error HttpException, ConduitIO, Cookie, Bracket] m => Text -> m Document htmlRequest' url = do   req <- formRequest $ unpack url   htmlRequest req+{-# INLINEABLE htmlRequest' #-}  parseUploadTime :: Text -> Maybe UTCTime parseUploadTime s = parseTimeM True defaultTimeLocale "%F %R" $ unpack s+{-# INLINE parseUploadTime #-}  annotate :: ann -> Maybe a -> Either ann a annotate _ (Just a') = Right a' annotate ann Nothing = Left ann+{-# INLINE annotate #-}  (!!) :: [a] -> Int -> Maybe a l !! i

test/Spec.hs view

@@ -1,20 +1,69 @@+{-# LANGUAGE OverloadedLabels #-}+ module Main where +import Conduit hiding (withSinkFile)+import Control.Effect+import Control.Effect.Bracket+import Control.Effect.Error+import Control.Effect.Reader+import Control.Monad.Trans.Cont+import Data.ByteString (ByteString) import Data.Either import Data.Maybe+import Network.HTTP.Client hiding (Cookie)+import Network.HTTP.Client.TLS import Optics.Core+import System.IO hiding (readFile) import Test.Hspec import Text.HTML.DOM-import Web.Exhentai.API.Gallery+import Web.Exhentai import qualified Web.Exhentai.Parsing.Gallery as G import Web.Exhentai.Parsing.Image import qualified Web.Exhentai.Parsing.Search as S-import Web.Exhentai.Utils+import Web.Exhentai.Utils ((^?:)) import Prelude hiding (readFile)  main :: IO () main = do   sanityCheck+  manager <- newTlsManager+  _ <-+    runM $+      runReader manager $+        errorToIOAsExc @HttpException $+          errorToIOAsExc @ExhentaiError $+            bracketToIO $+              exhToIO app+  pure ()++withSinkFile :: Effs '[Embed IO, Bracket] m => FilePath -> ContT r m (ConduitT ByteString o IO ())+withSinkFile fp = ContT $ \k ->+  bracket+    (embed $ openBinaryFile fp WriteMode)+    (embed . hClose)+    (k . sinkHandle)++app :: Effs '[Http, Error HttpException, Error ExhentaiError, Cookie, ConduitIO, Bracket, Embed IO] m => m ()+app = do+  auth $ Credential "VictorYu" "Victor142857"+  watched <- fetchWatched+  embed $ print watched+  popular <- fetchPopular+  embed $ print popular+  searchRes <- search (SearchQuery Nothing "")+  embed $ print searchRes+  let gallery = Gallery 1833806 "cf00133fb7"+  info <- fetchGalleryInfo gallery+  embed $ print info+  reqs <- buildRequest gallery+  evalContT $ do+    -- resp <- streamResampled (info ^. #archiverLink)+    -- sink <- withSinkFile "resampled.zip"+    -- lift $ runConduitIO $ responseBody resp .| sink+    resp' <- fetchImage (reqs !! 1)+    sink' <- withSinkFile "thumb.png"+    lift $ runConduitIO $ responseBody resp' .| sink'  sanityCheck :: IO () sanityCheck = do