Commit 233fb199 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[refactoring] add default-extensions to packages, some refactoring

parent a9d8e08a
{-# LANGUAGE OverloadedStrings #-}
module Main where module Main where
import PUBMED (getMetadataWith) import PUBMED (getMetadataWith)
......
cabal-version: 1.12 cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.31.2. -- This file has been generated from package.yaml by hpack version 0.34.4.
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
--
-- hash: 4bb73f43a66d509480c9a672fe457ad8be7cb2d27c8b0892e234b8ac088a2a44
name: crawlerPubMed name: crawlerPubMed
version: 0.1.0.0 version: 0.1.0.0
...@@ -30,10 +28,16 @@ library ...@@ -30,10 +28,16 @@ library
PUBMED PUBMED
PUBMED.Client PUBMED.Client
PUBMED.Parser PUBMED.Parser
PUBMED.Test
other-modules: other-modules:
Paths_crawlerPubMed Paths_crawlerPubMed
hs-source-dirs: hs-source-dirs:
src src
default-extensions:
DataKinds
MultiParamTypeClasses
OverloadedStrings
TypeOperators
build-depends: build-depends:
attoparsec attoparsec
, base >=4.7 && <5 , base >=4.7 && <5
...@@ -56,10 +60,13 @@ library ...@@ -56,10 +60,13 @@ library
executable crawlerPubMed-exe executable crawlerPubMed-exe
main-is: Main.hs main-is: Main.hs
other-modules:
Paths_crawlerPubMed
hs-source-dirs: hs-source-dirs:
app app
default-extensions:
DataKinds
MultiParamTypeClasses
OverloadedStrings
TypeOperators
ghc-options: -threaded -rtsopts -with-rtsopts=-N ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: build-depends:
attoparsec attoparsec
...@@ -89,6 +96,11 @@ test-suite crawlerPubMed-test ...@@ -89,6 +96,11 @@ test-suite crawlerPubMed-test
Paths_crawlerPubMed Paths_crawlerPubMed
hs-source-dirs: hs-source-dirs:
test test
default-extensions:
DataKinds
MultiParamTypeClasses
OverloadedStrings
TypeOperators
ghc-options: -threaded -rtsopts -with-rtsopts=-N ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: build-depends:
attoparsec attoparsec
......
...@@ -14,6 +14,12 @@ extra-source-files: ...@@ -14,6 +14,12 @@ extra-source-files:
# synopsis: Short description of your package # synopsis: Short description of your package
# category: Web # category: Web
default-extensions:
- DataKinds
- MultiParamTypeClasses
- OverloadedStrings
- TypeOperators
# To avoid duplicated efforts in documentation and dealing with the # To avoid duplicated efforts in documentation and dealing with the
# complications of embedding Haddock markup inside cabal files, it is # complications of embedding Haddock markup inside cabal files, it is
# common to point users to the README.md file. # common to point users to the README.md file.
...@@ -51,6 +57,10 @@ executables: ...@@ -51,6 +57,10 @@ executables:
- -with-rtsopts=-N - -with-rtsopts=-N
dependencies: dependencies:
- crawlerPubMed - crawlerPubMed
# https://stackoverflow.com/questions/67519851/multiple-files-use-the-same-module-name
when:
- condition: false
other-modules: Paths_crawlerPubMed
tests: tests:
crawlerPubMed-test: crawlerPubMed-test:
...@@ -62,3 +72,4 @@ tests: ...@@ -62,3 +72,4 @@ tests:
- -with-rtsopts=-N - -with-rtsopts=-N
dependencies: dependencies:
- crawlerPubMed - crawlerPubMed
{-# LANGUAGE OverloadedStrings #-}
module PUBMED where module PUBMED where
import Prelude hiding (takeWhile) import Prelude hiding (takeWhile)
...@@ -26,6 +24,17 @@ import qualified Data.ByteString as DB ...@@ -26,6 +24,17 @@ import qualified Data.ByteString as DB
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.List as List import qualified Data.List as List
pmHost :: String
pmHost = "eutils.ncbi.nlm.nih.gov"
pmSearchPath :: String
pmSearchPath = "entrez/eutils"
pmPort :: Int
pmPort = 443
defaultEnv = do
manager' <- newManager tlsManagerSettings
pure $ mkClientEnv manager' $ BaseUrl Https pmHost pmPort pmSearchPath
-- | API main function -- | API main function
getMetadataWith :: Text -> Maybe Limit -> IO (Either Text [PubMed]) getMetadataWith :: Text -> Maybe Limit -> IO (Either Text [PubMed])
getMetadataWith = runSimpleFindPubmedAbstractRequest getMetadataWith = runSimpleFindPubmedAbstractRequest
...@@ -72,10 +81,10 @@ runSimpleFetchPubmedAbstractRequest :: ...@@ -72,10 +81,10 @@ runSimpleFetchPubmedAbstractRequest ::
[Integer] [Integer]
-> IO (Either Text [PubMed]) -> IO (Either Text [PubMed])
runSimpleFetchPubmedAbstractRequest ids = do runSimpleFetchPubmedAbstractRequest ids = do
manager' <- newManager tlsManagerSettings env <- defaultEnv
res <- runClientM res <- runClientM
(fetch (Just "pubmed") (Just "abstract") ids) (fetch (Just "pubmed") (Just "abstract") ids)
(mkClientEnv manager' $ BaseUrl Https "eutils.ncbi.nlm.nih.gov" 443 "entrez/eutils") 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 abs)) -> (Right (BsXml abs)) ->
...@@ -89,13 +98,18 @@ runSimpleFetchPubmedAbstractRequest ids = do ...@@ -89,13 +98,18 @@ runSimpleFetchPubmedAbstractRequest ids = do
runSimpleFindPubmedAbstractRequest :: Text -> Maybe Limit -> IO (Either Text [PubMed]) runSimpleFindPubmedAbstractRequest :: Text -> Maybe Limit -> IO (Either Text [PubMed])
runSimpleFindPubmedAbstractRequest query limit = do runSimpleFindPubmedAbstractRequest query limit = do
manager' <- newManager tlsManagerSettings eDocIds <- searchDocIds query limit
case eDocIds of
Left err -> pure $ Left err
Right docIds -> runMultipleFPAR docIds
searchDocIds :: Text -> Maybe Limit -> IO (Either Text [Integer])
searchDocIds query limit = do
env <- defaultEnv
res <- runClientM res <- runClientM
(search (Just query) limit) (search (Just query) limit)
(mkClientEnv manager' $ BaseUrl Https "eutils.ncbi.nlm.nih.gov" 443 "entrez/eutils") 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
let docIds = runParser parseDocId docs pure $ Right $ runParser parseDocId docs
runMultipleFPAR docIds
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module PUBMED.Client where module PUBMED.Client where
import Servant.API import Servant.API
......
{-# LANGUAGE OverloadedStrings #-}
module PUBMED.Parser where module PUBMED.Parser where
import Text.XML.Stream.Parse import Text.XML.Stream.Parse
......
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