Commit 63eb8187 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

some main.hs work for better tests

This doesn't compile yet.
parent b78bdc85
module Main where module Main where
import PUBMED (getMetadataWith) import Data.Semigroup ((<>))
import qualified Data.Text as Text
import Options.Applicative
import System.Environment (getArgs)
import PUBMED (getMetadataWith, getMetadataWithC)
import PUBMED.Types import PUBMED.Types
data MetaParams = MetaParams
{ mp_mAPIKey :: Maybe String
, mp_term :: String }
data FetchParams = FetchParams
{ fp_mAPIKey :: Maybe String
, fp_limit :: Int
, fp_term :: String }
data Command
= Meta MetaParams
| Fetch FetchParams
metaParams :: Parser Command
metaParams = do
api_key <- optional (strOption
( long "api-key"
<> metavar "API_KEY"
<> help "Pubmed API key"))
term <- strArgument (metavar "term")
pure $ Meta (MetaParams api_key term)
fetchParams :: Parser Command
fetchParams = do
api_key <- optional (strOption
( long "api-key"
<> metavar "API_KEY"
<> help "Pubmed API key"))
limit <- option auto
( long "limit"
<> help "Maximum number of documents"
<> showDefault
<> value 100
<> metavar "INT" )
term <- strArgument (metavar "term")
pure $ Fetch (FetchParams api_key limit term)
params :: Parser Command
params = metaParams <|> fetchParams
opts :: ParserInfo Command
opts = info (params <**> helper)
(fullDesc
<> progDesc "A program to test PUBMD"
<> header "crawlerPubMed-exe")
main :: IO () main :: IO ()
main = getMetadataWith config "bisphenol" Nothing (Just 100) >>= print main = run =<< execParser opts
where where
config = Config { mAPIKey = Nothing }
run :: Command -> IO ()
run (Meta (MetaParams { mp_mAPIKey, mp_term })) = do
let config = Config { mAPIKey = Text.pack <$> mp_mAPIKey }
eDocs <- getMetadataWithC config (Text.pack mp_term) Nothing
case eDocs of
Left err -> print err
Right (count, _docs) -> print $ show count
run (Fetch (FetchParams { fp_mAPIKey, fp_term, fp_limit })) = do
let config = Config { mAPIKey = Text.pack <$> fp_mAPIKey }
eDocs <- getMetadataWithC config (Text.pack fp_term) (Just $ fromIntegral fp_limit)
case eDocs of
Left err -> print err
Right (count, docs) -> print $ show count
...@@ -36,6 +36,7 @@ library ...@@ -36,6 +36,7 @@ library
default-extensions: default-extensions:
DataKinds DataKinds
MultiParamTypeClasses MultiParamTypeClasses
NamedFieldPuns
OverloadedStrings OverloadedStrings
TypeOperators TypeOperators
ghc-options: -Wunused-imports ghc-options: -Wunused-imports
...@@ -52,6 +53,7 @@ library ...@@ -52,6 +53,7 @@ library
, http-client-tls , http-client-tls
, http-media , http-media
, lens , lens
, optparse-applicative
, protolude , protolude
, servant , servant
, servant-client , servant-client
...@@ -68,6 +70,7 @@ executable crawlerPubMed-exe ...@@ -68,6 +70,7 @@ executable crawlerPubMed-exe
default-extensions: default-extensions:
DataKinds DataKinds
MultiParamTypeClasses MultiParamTypeClasses
NamedFieldPuns
OverloadedStrings OverloadedStrings
TypeOperators TypeOperators
ghc-options: -threaded -rtsopts -Wunused-imports -with-rtsopts=-N ghc-options: -threaded -rtsopts -Wunused-imports -with-rtsopts=-N
...@@ -85,6 +88,7 @@ executable crawlerPubMed-exe ...@@ -85,6 +88,7 @@ executable crawlerPubMed-exe
, http-client-tls , http-client-tls
, http-media , http-media
, lens , lens
, optparse-applicative
, protolude , protolude
, servant , servant
, servant-client , servant-client
...@@ -104,6 +108,7 @@ test-suite crawlerPubMed-test ...@@ -104,6 +108,7 @@ test-suite crawlerPubMed-test
default-extensions: default-extensions:
DataKinds DataKinds
MultiParamTypeClasses MultiParamTypeClasses
NamedFieldPuns
OverloadedStrings OverloadedStrings
TypeOperators TypeOperators
ghc-options: -threaded -rtsopts -with-rtsopts=-N ghc-options: -threaded -rtsopts -with-rtsopts=-N
...@@ -121,6 +126,7 @@ test-suite crawlerPubMed-test ...@@ -121,6 +126,7 @@ test-suite crawlerPubMed-test
, http-client-tls , http-client-tls
, http-media , http-media
, lens , lens
, optparse-applicative
, protolude , protolude
, servant , servant
, servant-client , servant-client
......
...@@ -17,6 +17,7 @@ extra-source-files: ...@@ -17,6 +17,7 @@ extra-source-files:
default-extensions: default-extensions:
- DataKinds - DataKinds
- MultiParamTypeClasses - MultiParamTypeClasses
- NamedFieldPuns
- OverloadedStrings - OverloadedStrings
- TypeOperators - TypeOperators
...@@ -38,6 +39,7 @@ dependencies: ...@@ -38,6 +39,7 @@ dependencies:
- http-client-tls - http-client-tls
- http-media - http-media
- lens - lens
- optparse-applicative
- protolude - protolude
- servant - servant
- servant-client - servant-client
......
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