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.

app/Main.hs

@@ -5,7 +5,7 @@ import Control.Monad.Reader (runReaderT)
 import qualified Data.Text as Text
 import Options.Applicative
 
-import PUBMED (getMetadataWith, getMetadataWithC)
+import PUBMED (getMetadataWithC)
 import PUBMED.Types
 
 
@@ -65,7 +65,10 @@ run :: Command -> IO ()
 run (Meta (MetaParams { mp_mAPIKey, mp_term })) = do
   let config = Config { apiKey = Text.pack <$> mp_mAPIKey
                       , query = Text.pack mp_term
-                      , perPage = Nothing }
+                      , perPage = Nothing
+                      , mWebEnv = Nothing
+                      , enableDebugLogs = True
+                      }
 
   eDocs <- runReaderT getMetadataWithC config
   case eDocs of
@@ -74,7 +77,10 @@ run (Meta (MetaParams { mp_mAPIKey, mp_term })) = do
 run (Fetch (FetchParams { fp_mAPIKey, fp_term, fp_limit })) = do
   let config = Config { apiKey = Text.pack <$> fp_mAPIKey
                       , query = Text.pack fp_term
-                      , perPage = Nothing }
+                      , perPage = Nothing
+                      , mWebEnv = Nothing
+                      , enableDebugLogs = True
+                      }
 
   eDocs <- runReaderT getMetadataWithC config
   case eDocs of

src/PUBMED.hs

+{-# LANGUAGE NumericUnderscores #-}
 {-|
 Module      : PUBMED
 Description : PubMed API integration
@@ -85,13 +86,13 @@ getPage pageNum = do
   (Config { apiKey, perPage = mPerPage, query }) <- ask
   let perPage = fromMaybe defaultPerPage mPerPage
   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)
   case eDocs of
     Left err -> panic $ "[getPage] error: " <> show err
-    Right docs -> liftIO $ do
-      _ <- threadDelay 2000000 -- One seconds
-      print $ "[getPage] docs length: " <> show (length docs)
+    Right docs -> do
+      _ <- liftIO $ threadDelay 2_000_000 -- two seconds
+      debugLog $ "[getPage] docs length: " <> show (length docs)
       pure docs
 
 runMultipleFPAR :: [Integer]
@@ -129,7 +130,7 @@ runSimpleFetchPubmedAbstractRequest ids = do
             let parsed = parsePubMed $ TL.fromStrict $ TE.decodeUtf8 $ LBS.toStrict v
             pure $ Right parsed
 --          parsed <- catch (pubMedParser v) ((\e -> do
---                                                _ <- print e
+--                                                _ <- debugLog e
 --                                                pure []) :: XmlException -> IO [PubMed])
 --          Right <$> pure parsed
 
@@ -140,23 +141,23 @@ runSimpleFindPubmedAbstractRequest offset =  do
   case eDocIds of
     Left err -> pure $ Left err
     Right docIds -> do
-      liftIO $ print $ "[runSimpleFindPubmedAbstractRequest] docIds" <> show docIds
+      debugLog $ "[runSimpleFindPubmedAbstractRequest] docIds" <> show docIds
       runMultipleFPAR docIds
 
 searchDocIds :: Maybe Offset -> Env (Either Text [Integer])
 searchDocIds offset = do
   (Config { apiKey, query, perPage, mWebEnv }) <- ask
-  liftIO $ do
+  res <- liftIO $ do
     env <- defaultClientEnv
-    res <- runClientM
+    runClientM
       (searchWithHistory apiKey (Just query) offset perPage (Just "y") mWebEnv)
       env
-    case res of
-      (Left err) -> pure (Left $ T.pack $ show err)
-      (Right (BsXml docs)) -> do
-        liftIO $ print $ "[searchDocIds] docs" <> show docs
-        pure $ Right $ parseDocIds $ TL.fromStrict $ TE.decodeUtf8 $ LBS.toStrict docs
-        --pure $ Right $ runParser parseDocId docs
+  case res of
+    (Left err) -> pure (Left $ T.pack $ show err)
+    (Right (BsXml docs)) -> do
+      debugLog $ "[searchDocIds] docs" <> show docs
+      pure $ Right $ parseDocIds $ TL.fromStrict $ TE.decodeUtf8 $ LBS.toStrict docs
+      --pure $ Right $ runParser parseDocId docs
 
 --runParser :: Show res => (Cursor -> res) -> LBS.ByteString -> res
 --runParser parser = parser . fromDocument . parseLBS_ def

src/PUBMED/Types.hs

@@ -11,8 +11,10 @@ Portability : POSIX
 
 module PUBMED.Types where
 
-import Control.Monad.Reader (ReaderT)
+import Control.Monad.Reader (ReaderT, liftIO)
 import Data.Text (Text)
+import Control.Monad (when)
+import Control.Monad.Reader.Class (asks)
 
 
 type APIKey = Text
@@ -26,10 +28,17 @@ data Config = Config {
   , query   :: Query
   , perPage :: Maybe PerPage
   , mWebEnv :: Maybe WebEnv
+  -- | If 'True', emit useful debug logs
+  , enableDebugLogs :: Bool
   }
 
 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.
 defaultPerPage :: PerPage