Commit b8d1de8c authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

Add debug log option to Config

This commit adds an `enableDebugLogs` option to the `Config` such that
it can be used to enable or disable debug logs. This way production code
is not littered with debug logs, which might even leak sensible
information.
parent 7adf6bd4
...@@ -5,7 +5,7 @@ import Control.Monad.Reader (runReaderT) ...@@ -5,7 +5,7 @@ import Control.Monad.Reader (runReaderT)
import qualified Data.Text as Text import qualified Data.Text as Text
import Options.Applicative import Options.Applicative
import PUBMED (getMetadataWith, getMetadataWithC) import PUBMED (getMetadataWithC)
import PUBMED.Types import PUBMED.Types
...@@ -65,7 +65,10 @@ run :: Command -> IO () ...@@ -65,7 +65,10 @@ run :: Command -> IO ()
run (Meta (MetaParams { mp_mAPIKey, mp_term })) = do run (Meta (MetaParams { mp_mAPIKey, mp_term })) = do
let config = Config { apiKey = Text.pack <$> mp_mAPIKey let config = Config { apiKey = Text.pack <$> mp_mAPIKey
, query = Text.pack mp_term , query = Text.pack mp_term
, perPage = Nothing } , perPage = Nothing
, mWebEnv = Nothing
, enableDebugLogs = True
}
eDocs <- runReaderT getMetadataWithC config eDocs <- runReaderT getMetadataWithC config
case eDocs of case eDocs of
...@@ -74,7 +77,10 @@ run (Meta (MetaParams { mp_mAPIKey, mp_term })) = do ...@@ -74,7 +77,10 @@ run (Meta (MetaParams { mp_mAPIKey, mp_term })) = do
run (Fetch (FetchParams { fp_mAPIKey, fp_term, fp_limit })) = do run (Fetch (FetchParams { fp_mAPIKey, fp_term, fp_limit })) = do
let config = Config { apiKey = Text.pack <$> fp_mAPIKey let config = Config { apiKey = Text.pack <$> fp_mAPIKey
, query = Text.pack fp_term , query = Text.pack fp_term
, perPage = Nothing } , perPage = Nothing
, mWebEnv = Nothing
, enableDebugLogs = True
}
eDocs <- runReaderT getMetadataWithC config eDocs <- runReaderT getMetadataWithC config
case eDocs of case eDocs of
......
{-# LANGUAGE NumericUnderscores #-}
{-| {-|
Module : PUBMED Module : PUBMED
Description : PubMed API integration Description : PubMed API integration
...@@ -85,13 +86,13 @@ getPage pageNum = do ...@@ -85,13 +86,13 @@ getPage pageNum = do
(Config { apiKey, perPage = mPerPage, query }) <- ask (Config { apiKey, perPage = mPerPage, query }) <- ask
let perPage = fromMaybe defaultPerPage mPerPage let perPage = fromMaybe defaultPerPage mPerPage
let offset = fromIntegral $ pageNum * perPage let offset = fromIntegral $ pageNum * perPage
liftIO $ print $ "[getPage] getting page " <> show pageNum <> ", offset: " <> show offset <> ", perPage: " <> show perPage <> ", query: " <> T.unpack query <> ", apiKey: " <> show apiKey debugLog $ "[getPage] getting page " <> show pageNum <> ", offset: " <> show offset <> ", perPage: " <> show perPage <> ", query: " <> T.unpack query <> ", apiKey: " <> show apiKey
eDocs <- runSimpleFindPubmedAbstractRequest (Just offset) eDocs <- runSimpleFindPubmedAbstractRequest (Just offset)
case eDocs of case eDocs of
Left err -> panic $ "[getPage] error: " <> show err Left err -> panic $ "[getPage] error: " <> show err
Right docs -> liftIO $ do Right docs -> do
_ <- threadDelay 2000000 -- One seconds _ <- liftIO $ threadDelay 2_000_000 -- two seconds
print $ "[getPage] docs length: " <> show (length docs) debugLog $ "[getPage] docs length: " <> show (length docs)
pure docs pure docs
runMultipleFPAR :: [Integer] runMultipleFPAR :: [Integer]
...@@ -129,7 +130,7 @@ runSimpleFetchPubmedAbstractRequest ids = do ...@@ -129,7 +130,7 @@ runSimpleFetchPubmedAbstractRequest ids = do
let parsed = parsePubMed $ TL.fromStrict $ TE.decodeUtf8 $ LBS.toStrict v let parsed = parsePubMed $ TL.fromStrict $ TE.decodeUtf8 $ LBS.toStrict v
pure $ Right parsed pure $ Right parsed
-- parsed <- catch (pubMedParser v) ((\e -> do -- parsed <- catch (pubMedParser v) ((\e -> do
-- _ <- print e -- _ <- debugLog e
-- pure []) :: XmlException -> IO [PubMed]) -- pure []) :: XmlException -> IO [PubMed])
-- Right <$> pure parsed -- Right <$> pure parsed
...@@ -140,21 +141,21 @@ runSimpleFindPubmedAbstractRequest offset = do ...@@ -140,21 +141,21 @@ runSimpleFindPubmedAbstractRequest offset = do
case eDocIds of case eDocIds of
Left err -> pure $ Left err Left err -> pure $ Left err
Right docIds -> do Right docIds -> do
liftIO $ print $ "[runSimpleFindPubmedAbstractRequest] docIds" <> show docIds debugLog $ "[runSimpleFindPubmedAbstractRequest] docIds" <> show docIds
runMultipleFPAR docIds runMultipleFPAR docIds
searchDocIds :: Maybe Offset -> Env (Either Text [Integer]) searchDocIds :: Maybe Offset -> Env (Either Text [Integer])
searchDocIds offset = do searchDocIds offset = do
(Config { apiKey, query, perPage, mWebEnv }) <- ask (Config { apiKey, query, perPage, mWebEnv }) <- ask
liftIO $ do res <- liftIO $ do
env <- defaultClientEnv env <- defaultClientEnv
res <- runClientM runClientM
(searchWithHistory apiKey (Just query) offset perPage (Just "y") mWebEnv) (searchWithHistory apiKey (Just query) offset perPage (Just "y") mWebEnv)
env env
case res of case res of
(Left err) -> pure (Left $ T.pack $ show err) (Left err) -> pure (Left $ T.pack $ show err)
(Right (BsXml docs)) -> do (Right (BsXml docs)) -> do
liftIO $ print $ "[searchDocIds] docs" <> show docs debugLog $ "[searchDocIds] docs" <> show docs
pure $ Right $ parseDocIds $ TL.fromStrict $ TE.decodeUtf8 $ LBS.toStrict docs pure $ Right $ parseDocIds $ TL.fromStrict $ TE.decodeUtf8 $ LBS.toStrict docs
--pure $ Right $ runParser parseDocId docs --pure $ Right $ runParser parseDocId docs
......
...@@ -11,8 +11,10 @@ Portability : POSIX ...@@ -11,8 +11,10 @@ Portability : POSIX
module PUBMED.Types where module PUBMED.Types where
import Control.Monad.Reader (ReaderT) import Control.Monad.Reader (ReaderT, liftIO)
import Data.Text (Text) import Data.Text (Text)
import Control.Monad (when)
import Control.Monad.Reader.Class (asks)
type APIKey = Text type APIKey = Text
...@@ -26,10 +28,17 @@ data Config = Config { ...@@ -26,10 +28,17 @@ data Config = Config {
, query :: Query , query :: Query
, perPage :: Maybe PerPage , perPage :: Maybe PerPage
, mWebEnv :: Maybe WebEnv , mWebEnv :: Maybe WebEnv
-- | If 'True', emit useful debug logs
, enableDebugLogs :: Bool
} }
type Env = ReaderT Config IO type Env = ReaderT Config IO
-- | Prints the debug message only if the verbose logs are enabled.
debugLog :: String -> Env ()
debugLog msg = do
logs_enabled <- asks enableDebugLogs
when logs_enabled $ liftIO (putStrLn msg)
-- | This is the default `retmax` value in ESearch. -- | This is the default `retmax` value in ESearch.
defaultPerPage :: PerPage defaultPerPage :: PerPage
......
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