Commit b78bdc85 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Add config

parent 9b4ed995
module Main where module Main where
import PUBMED (getMetadataWith) import PUBMED (getMetadataWith)
import PUBMED.Types
main :: IO () 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 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 -- see: https://github.com/sol/hpack
...@@ -28,6 +28,7 @@ library ...@@ -28,6 +28,7 @@ library
PUBMED PUBMED
PUBMED.Client PUBMED.Client
PUBMED.Parser PUBMED.Parser
PUBMED.Types
other-modules: other-modules:
Paths_crawlerPubMed Paths_crawlerPubMed
hs-source-dirs: hs-source-dirs:
......
...@@ -22,6 +22,8 @@ import qualified Data.Text as T ...@@ -22,6 +22,8 @@ import qualified Data.Text as T
import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import PUBMED.Types
pmHost :: String pmHost :: String
pmHost = "eutils.ncbi.nlm.nih.gov" pmHost = "eutils.ncbi.nlm.nih.gov"
pmSearchPath :: String pmSearchPath :: String
...@@ -38,11 +40,14 @@ defaultEnv = do ...@@ -38,11 +40,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 :: Maybe Text -> Text -> Maybe Integer -> Maybe Limit -> IO (Either Text [PubMed]) getMetadataWith :: Config -> Text -> Maybe Integer -> Maybe Limit -> IO (Either Text [PubMed])
getMetadataWith = runSimpleFindPubmedAbstractRequest getMetadataWith = runSimpleFindPubmedAbstractRequest
getMetadataWithC :: Maybe Text -> Text -> Maybe Limit -> IO (Either ClientError (Maybe Integer, ConduitT () PubMed IO ())) getMetadataWithC :: Config
getMetadataWithC mAPIKey query limit = do -> Text
-> Maybe Limit
-> IO (Either ClientError (Maybe Integer, ConduitT () PubMed IO ()))
getMetadataWithC config@(Config { mAPIKey = 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 mAPIKey (Just query) Nothing (Just 1)) env eRes <- runClientM (search mAPIKey (Just query) Nothing (Just 1)) env
...@@ -53,20 +58,20 @@ getMetadataWithC mAPIKey query limit = do ...@@ -53,20 +58,20 @@ getMetadataWithC mAPIKey query limit = do
( Just numResults ( Just numResults
, yieldMany [0..] , yieldMany [0..]
.| takeC (fromInteger numPages) .| takeC (fromInteger numPages)
.| concatMapMC (getPage env mAPIKey q perPage)) .| concatMapMC (getPage env config 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 getPage :: ClientEnv
-> Maybe Text -> Config
-> Text -> Text
-> Int -> Int
-> Int -> Int
-> IO [PubMed] -> IO [PubMed]
getPage env mAPIKey q perPage pageNum = do getPage env config q perPage pageNum = do
let offset = fromIntegral $ pageNum * perPage 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 case eDocs of
Left err -> panic $ "[getPage] error: " <> show err Left err -> panic $ "[getPage] error: " <> show err
Right docs -> do Right docs -> do
...@@ -131,19 +136,19 @@ runSimpleFetchPubmedAbstractRequest ids = do ...@@ -131,19 +136,19 @@ runSimpleFetchPubmedAbstractRequest ids = do
-- pure []) :: XmlException -> IO [PubMed]) -- pure []) :: XmlException -> IO [PubMed])
-- Right <$> pure parsed -- Right <$> pure parsed
runSimpleFindPubmedAbstractRequest :: Maybe Text runSimpleFindPubmedAbstractRequest :: Config
-> Text -> Text
-> Maybe Integer -> Maybe Integer
-> Maybe Limit -> Maybe Limit
-> IO (Either Text [PubMed]) -> IO (Either Text [PubMed])
runSimpleFindPubmedAbstractRequest mAPIKey query offset limit = do runSimpleFindPubmedAbstractRequest config query offset limit = do
eDocIds <- searchDocIds mAPIKey query offset limit eDocIds <- searchDocIds config 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 :: Maybe Text -> Text -> Maybe Integer -> Maybe Limit -> IO (Either Text [Integer]) searchDocIds :: Config -> Text -> Maybe Integer -> Maybe Limit -> IO (Either Text [Integer])
searchDocIds mAPIKey query offset limit = do searchDocIds (Config { mAPIKey = mAPIKey }) query offset limit = do
env <- defaultEnv env <- defaultEnv
res <- runClientM res <- runClientM
(search mAPIKey (Just query) offset limit) (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