[scroll] implement getMetadataScroll

src/ISTEX.hs

@@ -20,13 +20,55 @@ getMetadataWith q n = do
     n
     (Just q)
 
-getMetadataScrollWith :: Text -> Maybe Text -> IO (Either ClientError Documents)
-getMetadataScrollWith q n = do
-  runIstexAPIClient $
+type Progress = ScrollResponse -> IO ()
+type ErrorHandler = ClientError -> IO ()
+
+runIstexScrollAPIClient :: ClientM (ScrollResponse) -> IO (Either ClientError ScrollResponse)
+runIstexScrollAPIClient cmd = do
+  manager' <- newManager tlsManagerSettings
+  runClientM cmd (mkClientEnv manager' $ BaseUrl Https "api.istex.fr" 443 "document")
+
+maxScrollPages :: Int
+maxScrollPages = 10
+
+getMetadataScroll :: Text -> Text -> Maybe Text -> Int -> IO (Either ClientError Documents)
+getMetadataScroll q scroll scrollId page = do
+  if page >= maxScrollPages then
+    pure $ Right mempty
+  else do
+    -- Prelude.putStrLn $ "[getMetadataScroll] scroll: " <> show scroll
+    -- Prelude.putStrLn $ "[getMetadataScroll] scrollId: " <> show scrollId
+    -- Prelude.putStrLn $ "[getMetadataScroll] page: " <> show page
+    eRes <- runIstexScrollAPIClient $
+      searchScroll
+      (Just "author,title,abstract,publicationDate,refBibs")
+      scroll
+      (Just q)
+      scrollId
+    case eRes of
+      Left err -> pure $ Left err
+      Right res@(ScrollResponse { .. }) -> do
+        eDocs <- getMetadataScroll q scroll (Just _scroll_scrollId) (page + 1)
+        case eDocs of
+          Left err -> pure $ Left err
+          Right docs -> pure $ Right $ _scroll_documents <> docs
+        --mappend _scroll_documents <*> getMetadataScroll q scroll (Just _scroll_scrollId) (page + 1)
+
+getMetadataScrollProgress :: Text -> Text -> Maybe Text -> Progress -> ErrorHandler -> IO ()
+getMetadataScrollProgress q scroll scrollId progress errorHandler = do
+  eRes <- runIstexScrollAPIClient $
     searchScroll
     (Just "author,title,abstract,publicationDate,refBibs")
-    n
+    scroll
     (Just q)
+    scrollId
+  case eRes of
+    Left err -> errorHandler err
+    Right res@(ScrollResponse { _scroll_noMoreScrollResults
+                              , _scroll_nextScrollURI
+                              , _scroll_scrollId }) -> do
+      progress res
+      getMetadataScrollProgress q scroll (Just _scroll_scrollId) progress errorHandler
 
 type Query = Text
 

src/ISTEX/Client.hs

@@ -76,10 +76,34 @@ data Documents = Documents
   , _documents_hits  :: [Document]
   } deriving (Show, Generic)
 L.makeLenses ''Documents
-
 instance FromJSON Documents where
   parseJSON (Object o) =
     Documents <$> (o .: "total") <*> (o .: "hits")
+instance Semigroup Documents where
+  (<>) (Documents { _documents_total
+                  , _documents_hits = d1 })
+       (Documents { _documents_hits = d2 }) = Documents { _documents_total
+                                                        , _documents_hits = d1 <> d2 }
+
+instance Monoid Documents where
+  mempty = Documents { _documents_total = 0
+                     , _documents_hits = [] }
+
+data ScrollResponse = ScrollResponse
+  { _scroll_documents           :: Documents
+  , _scroll_noMoreScrollResults :: Bool
+  , _scroll_nextScrollURI       :: T.Text
+  , _scroll_scrollId            :: T.Text }
+L.makeLenses ''ScrollResponse
+instance FromJSON ScrollResponse where
+  parseJSON (Object o) = do
+    _documents_total <- o .: "total"
+    _documents_hits <- o .: "hits"
+    _scroll_noMoreScrollResults <- o .: "noMoreScrollResults"
+    _scroll_nextScrollURI <- o .: "nextScrollURI"
+    _scroll_scrollId <- o .: "scrollId"
+    pure $ ScrollResponse { _scroll_documents = Documents { .. }
+                          , .. }
 
 type ISTEXAPI = Search
 
@@ -97,10 +121,11 @@ search = client istexProxy
 type SearchScroll = QueryParam "output" T.Text
                  :> QueryParam "scroll" T.Text
                  :> QueryParam "q" T.Text
-                 :> Get '[JSON] Documents
+                 :> QueryParam "scrollId" T.Text
+                 :> Get '[JSON] ScrollResponse
 
 istexProxyScroll :: Proxy SearchScroll
 istexProxyScroll = Proxy
 
-searchScroll :: Maybe T.Text -> Maybe T.Text -> Maybe T.Text -> ClientM Documents
-searchScroll = client istexProxyScroll
+searchScroll :: Maybe T.Text -> T.Text -> Maybe T.Text -> Maybe T.Text -> ClientM ScrollResponse
+searchScroll output scroll = client istexProxyScroll output (Just scroll)