You need to sign in or sign up before continuing.
Commit b78bdc85 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Add config

parent 9b4ed995
module Main where
import PUBMED (getMetadataWith)
import PUBMED.Types
main :: IO ()
main = getMetadataWith Nothing "bisphenol" Nothing (Just 100) >>= print
main = getMetadataWith config "bisphenol" Nothing (Just 100) >>= print
where
config = Config { mAPIKey = Nothing }
cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.34.4.
-- This file has been generated from package.yaml by hpack version 0.35.0.
--
-- see: https://github.com/sol/hpack
......@@ -28,6 +28,7 @@ library
PUBMED
PUBMED.Client
PUBMED.Parser
PUBMED.Types
other-modules:
Paths_crawlerPubMed
hs-source-dirs:
......
......@@ -22,6 +22,8 @@ import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import PUBMED.Types
pmHost :: String
pmHost = "eutils.ncbi.nlm.nih.gov"
pmSearchPath :: String
......@@ -38,11 +40,14 @@ defaultEnv = do
pure $ mkClientEnv manager' $ BaseUrl Https pmHost pmPort pmSearchPath
-- | API main function
getMetadataWith :: Maybe Text -> Text -> Maybe Integer -> Maybe Limit -> IO (Either Text [PubMed])
getMetadataWith :: Config -> Text -> Maybe Integer -> Maybe Limit -> IO (Either Text [PubMed])
getMetadataWith = runSimpleFindPubmedAbstractRequest
getMetadataWithC :: Maybe Text -> Text -> Maybe Limit -> IO (Either ClientError (Maybe Integer, ConduitT () PubMed IO ()))
getMetadataWithC mAPIKey query limit = do
getMetadataWithC :: Config
-> Text
-> Maybe Limit
-> IO (Either ClientError (Maybe Integer, ConduitT () PubMed IO ()))
getMetadataWithC config@(Config { mAPIKey = mAPIKey }) query limit = do
env <- defaultEnv
-- First, estimate the total number of documents
eRes <- runClientM (search mAPIKey (Just query) Nothing (Just 1)) env
......@@ -53,20 +58,20 @@ getMetadataWithC mAPIKey query limit = do
( Just numResults
, yieldMany [0..]
.| takeC (fromInteger numPages)
.| concatMapMC (getPage env mAPIKey q perPage))
.| concatMapMC (getPage env config q perPage))
where
numResults = fromMaybe 0 $ parseDocCount $ TL.fromStrict $ TE.decodeUtf8 $ LBS.toStrict res
numPages = numResults `div` (fromIntegral perPage) + 1
getPage :: ClientEnv
-> Maybe Text
-> Config
-> Text
-> Int
-> Int
-> IO [PubMed]
getPage env mAPIKey q perPage pageNum = do
getPage env config q perPage pageNum = do
let offset = fromIntegral $ pageNum * perPage
eDocs <- runSimpleFindPubmedAbstractRequest mAPIKey q (Just offset) (Just $ fromIntegral perPage)
eDocs <- runSimpleFindPubmedAbstractRequest config q (Just offset) (Just $ fromIntegral perPage)
case eDocs of
Left err -> panic $ "[getPage] error: " <> show err
Right docs -> do
......@@ -131,19 +136,19 @@ runSimpleFetchPubmedAbstractRequest ids = do
-- pure []) :: XmlException -> IO [PubMed])
-- Right <$> pure parsed
runSimpleFindPubmedAbstractRequest :: Maybe Text
runSimpleFindPubmedAbstractRequest :: Config
-> Text
-> Maybe Integer
-> Maybe Limit
-> IO (Either Text [PubMed])
runSimpleFindPubmedAbstractRequest mAPIKey query offset limit = do
eDocIds <- searchDocIds mAPIKey query offset limit
runSimpleFindPubmedAbstractRequest config query offset limit = do
eDocIds <- searchDocIds config query offset limit
case eDocIds of
Left err -> pure $ Left err
Right docIds -> runMultipleFPAR docIds
searchDocIds :: Maybe Text -> Text -> Maybe Integer -> Maybe Limit -> IO (Either Text [Integer])
searchDocIds mAPIKey query offset limit = do
searchDocIds :: Config -> Text -> Maybe Integer -> Maybe Limit -> IO (Either Text [Integer])
searchDocIds (Config { mAPIKey = mAPIKey }) query offset limit = do
env <- defaultEnv
res <- runClientM
(search mAPIKey (Just query) offset limit)
......
module PUBMED.Types where
import Data.Text (Text)
data Config = Config {
mAPIKey :: Maybe Text
}
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