Commit 07fa2194 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Add support for APIKey

parent 364885c8
...@@ -38,14 +38,14 @@ defaultEnv = do ...@@ -38,14 +38,14 @@ defaultEnv = do
pure $ mkClientEnv manager' $ BaseUrl Https pmHost pmPort pmSearchPath pure $ mkClientEnv manager' $ BaseUrl Https pmHost pmPort pmSearchPath
-- | API main function -- | API main function
getMetadataWith :: Text -> Maybe Integer -> Maybe Limit -> IO (Either Text [PubMed]) getMetadataWith :: Maybe Text -> Text -> Maybe Integer -> Maybe Limit -> IO (Either Text [PubMed])
getMetadataWith = runSimpleFindPubmedAbstractRequest getMetadataWith = runSimpleFindPubmedAbstractRequest
getMetadataWithC :: Text -> Maybe Limit -> IO (Either ClientError (Maybe Integer, ConduitT () PubMed IO ())) getMetadataWithC :: Maybe Text -> Text -> Maybe Limit -> IO (Either ClientError (Maybe Integer, ConduitT () PubMed IO ()))
getMetadataWithC query limit = do getMetadataWithC mAPIKey query limit = do
env <- defaultEnv env <- defaultEnv
-- First, estimate the total number of documents -- First, estimate the total number of documents
eRes <- runClientM (search (Just query) Nothing (Just 1)) env eRes <- runClientM (search mAPIKey (Just query) Nothing (Just 1)) env
pure $ get' env query limit batchSize <$> eRes pure $ get' env query limit batchSize <$> eRes
where where
get' :: ClientEnv -> Text -> Maybe Limit -> Int -> BsXml -> (Maybe Integer, ConduitT () PubMed IO ()) get' :: ClientEnv -> Text -> Maybe Limit -> Int -> BsXml -> (Maybe Integer, ConduitT () PubMed IO ())
...@@ -53,21 +53,26 @@ getMetadataWithC query limit = do ...@@ -53,21 +53,26 @@ getMetadataWithC query limit = do
( Just numResults ( Just numResults
, yieldMany [0..] , yieldMany [0..]
.| takeC (fromInteger numPages) .| takeC (fromInteger numPages)
.| concatMapMC (getPage env q perPage)) .| concatMapMC (getPage env mAPIKey q perPage))
where where
numResults = fromMaybe 0 $ parseDocCount $ TL.fromStrict $ TE.decodeUtf8 $ LBS.toStrict res numResults = fromMaybe 0 $ parseDocCount $ TL.fromStrict $ TE.decodeUtf8 $ LBS.toStrict res
numPages = numResults `div` (fromIntegral perPage) + 1 numPages = numResults `div` (fromIntegral perPage) + 1
getPage :: ClientEnv -> Text -> Int -> Int -> IO [PubMed] getPage :: ClientEnv
getPage env q perPage pageNum = do -> Maybe Text
-> Text
-> Int
-> Int
-> IO [PubMed]
getPage env mAPIKey q perPage pageNum = do
let offset = fromIntegral $ pageNum * perPage let offset = fromIntegral $ pageNum * perPage
eDocs <- runSimpleFindPubmedAbstractRequest q (Just offset) (Just $ fromIntegral perPage) eDocs <- runSimpleFindPubmedAbstractRequest mAPIKey q (Just offset) (Just $ fromIntegral perPage)
case eDocs of case eDocs of
Left err -> panic $ "[getPage] error: " <> show err Left err -> panic $ "[getPage] error: " <> show err
Right docs -> do Right docs -> do
_ <- threadDelay 2000000 -- One seconds _ <- threadDelay 2000000 -- One seconds
pure docs pure docs
-- | TODO this parser need at least one subs at the end -- | TODO this parser need at least one subs at the end
-- (use endOfInput) -- (use endOfInput)
removeSub :: Parser ByteString removeSub :: Parser ByteString
...@@ -110,7 +115,7 @@ runSimpleFetchPubmedAbstractRequest :: ...@@ -110,7 +115,7 @@ runSimpleFetchPubmedAbstractRequest ::
runSimpleFetchPubmedAbstractRequest ids = do runSimpleFetchPubmedAbstractRequest ids = do
env <- defaultEnv env <- defaultEnv
res <- runClientM res <- runClientM
(fetch (Just "pubmed") (Just "abstract") ids) (fetch Nothing (Just "pubmed") (Just "abstract") ids)
env env
case res of case res of
(Left err) -> pure (Left . T.pack $ show err) (Left err) -> pure (Left . T.pack $ show err)
...@@ -126,18 +131,22 @@ runSimpleFetchPubmedAbstractRequest ids = do ...@@ -126,18 +131,22 @@ runSimpleFetchPubmedAbstractRequest ids = do
-- pure []) :: XmlException -> IO [PubMed]) -- pure []) :: XmlException -> IO [PubMed])
-- Right <$> pure parsed -- Right <$> pure parsed
runSimpleFindPubmedAbstractRequest :: Text -> Maybe Integer -> Maybe Limit -> IO (Either Text [PubMed]) runSimpleFindPubmedAbstractRequest :: Maybe Text
runSimpleFindPubmedAbstractRequest query offset limit = do -> Text
eDocIds <- searchDocIds query offset limit -> Maybe Integer
-> Maybe Limit
-> IO (Either Text [PubMed])
runSimpleFindPubmedAbstractRequest mAPIKey query offset limit = do
eDocIds <- searchDocIds mAPIKey query offset limit
case eDocIds of case eDocIds of
Left err -> pure $ Left err Left err -> pure $ Left err
Right docIds -> runMultipleFPAR docIds Right docIds -> runMultipleFPAR docIds
searchDocIds :: Text -> Maybe Integer -> Maybe Limit -> IO (Either Text [Integer]) searchDocIds :: Maybe Text -> Text -> Maybe Integer -> Maybe Limit -> IO (Either Text [Integer])
searchDocIds query offset limit = do searchDocIds mAPIKey query offset limit = do
env <- defaultEnv env <- defaultEnv
res <- runClientM res <- runClientM
(search (Just query) offset limit) (search mAPIKey (Just query) offset limit)
env env
case res of case res of
(Left err) -> pure (Left $ T.pack $ show err) (Left err) -> pure (Left $ T.pack $ show err)
......
...@@ -22,12 +22,14 @@ type PUBMEDAPI = ...@@ -22,12 +22,14 @@ type PUBMEDAPI =
"esearch.fcgi" "esearch.fcgi"
-- :> QueryParam "db" DB -- :> QueryParam "db" DB
-- not mandatory since the base db is pubmed -- not mandatory since the base db is pubmed
:> QueryParam "api_key" T.Text
:> QueryParam "term" T.Text :> QueryParam "term" T.Text
:> QueryParam "retstart" Integer :> QueryParam "retstart" Integer
:> QueryParam "retmax" Integer :> QueryParam "retmax" Integer
:> Get '[BsXml] BsXml :> Get '[BsXml] BsXml
:<|> :<|>
"efetch.fcgi" "efetch.fcgi"
:> QueryParam "api_key" T.Text
:> QueryParam "db" T.Text :> QueryParam "db" T.Text
:> QueryParam "rettype" T.Text :> QueryParam "rettype" T.Text
:> QueryParams "id" Integer :> QueryParams "id" Integer
...@@ -36,10 +38,15 @@ type PUBMEDAPI = ...@@ -36,10 +38,15 @@ type PUBMEDAPI =
pubmedApi :: Proxy PUBMEDAPI pubmedApi :: Proxy PUBMEDAPI
pubmedApi = Proxy pubmedApi = Proxy
search :: Maybe T.Text -> Maybe Integer -> Maybe Integer -> ClientM BsXml search :: Maybe T.Text
-> Maybe T.Text
-> Maybe Integer
-> Maybe Integer
-> ClientM BsXml
fetch :: Maybe T.Text fetch :: Maybe T.Text
-> Maybe T.Text -> Maybe T.Text
-> [Integer] -> Maybe T.Text
-> ClientM BsXml -> [Integer]
-> ClientM BsXml
search :<|> fetch = client pubmedApi search :<|> fetch = client pubmedApi
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment