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

Basic Hal tests

parent cc436c77
...@@ -96,12 +96,15 @@ get la (convertQuery -> q) ml = do ...@@ -96,12 +96,15 @@ get la (convertQuery -> q) ml = do
eDocs <- HAL.getMetadataWith [getHalQuery q] (Just 0) (fromIntegral . getLimit <$> ml) la eDocs <- HAL.getMetadataWith [getHalQuery q] (Just 0) (fromIntegral . getLimit <$> ml) la
either (panic . pack . show) (\d -> mapM (toDoc' la) $ HAL._docs d) eDocs either (panic . pack . show) (\d -> mapM (toDoc' la) $ HAL._docs d) eDocs
halOptions :: HAL.HalCrawlerOptions
halOptions = HAL.HalCrawlerOptions False 1000
getC :: Maybe ISO639.ISO639_1 getC :: Maybe ISO639.ISO639_1
-> Corpus.Query -> Corpus.Query
-> Maybe Corpus.Limit -> Maybe Corpus.Limit
-> IO (Either ClientError (Maybe Integer, ConduitT () HyperdataDocument IO ())) -> IO (Either ClientError (Maybe Integer, ConduitT () HyperdataDocument IO ()))
getC la (convertQuery -> q) ml = do getC la (convertQuery -> q) ml = do
eRes <- HAL.getMetadataWithC [getHalQuery q] (Just 0) (fromIntegral . getLimit <$> ml) la eRes <- HAL.getMetadataWithLangC halOptions [getHalQuery q] (Just 0) (fromIntegral . getLimit <$> ml) la
pure $ (\(len, docsC) -> (len, docsC .| mapMC (toDoc' la))) <$> eRes pure $ (\(len, docsC) -> (len, docsC .| mapMC (toDoc' la))) <$> eRes
toDoc' :: Maybe ISO639.ISO639_1 -> HAL.Corpus -> IO HyperdataDocument toDoc' :: Maybe ISO639.ISO639_1 -> HAL.Corpus -> IO HyperdataDocument
......
...@@ -8,7 +8,7 @@ import Data.BoolExpr ...@@ -8,7 +8,7 @@ import Data.BoolExpr
import Data.Conduit import Data.Conduit
import Data.Maybe import Data.Maybe
import Data.String import Data.String
import Gargantext.Core (Lang(..)) import Gargantext.Core (Lang(..), toISO639)
import Gargantext.Core.Text.Corpus.Query import Gargantext.Core.Text.Corpus.Query
import Gargantext.Core.Types import Gargantext.Core.Types
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..)) import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
...@@ -116,6 +116,11 @@ tests = withResource pubmedSettings (const (pure ())) $ \getPubmedKey -> ...@@ -116,6 +116,11 @@ tests = withResource pubmedSettings (const (pure ())) $ \getPubmedKey ->
testCase "It searches for \"brain\"" (testIstexRealWorld_01 getPubmedKey) testCase "It searches for \"brain\"" (testIstexRealWorld_01 getPubmedKey)
, testCase "It searches for \"brain\" AND NOT \"neural\"" (testIstexRealWorld_02 getPubmedKey) , testCase "It searches for \"brain\" AND NOT \"neural\"" (testIstexRealWorld_02 getPubmedKey)
] ]
-- .. ditto for HAL
, testGroup "HAL real queries (skipped if PUBMED_API_KEY env var not set)" [
testCase "It searches for \"Haskell\"" (testHalRealWorld_01 getPubmedKey)
, testCase "It searches for \"Haskell\" AND NOT \"Agda\"" (testHalRealWorld_02 getPubmedKey)
]
] ]
-- | Checks that the 'RawQuery' can be translated into the expected 'BoolExpr' form, -- | Checks that the 'RawQuery' can be translated into the expected 'BoolExpr' form,
...@@ -503,3 +508,38 @@ testIstexRealWorld_02 getPubmedKey = do ...@@ -503,3 +508,38 @@ testIstexRealWorld_02 getPubmedKey = do
case hyperDocs of case hyperDocs of
[] -> fail "No documents found." [] -> fail "No documents found."
(x:_) -> isJust (_hd_title x) @?= True (x:_) -> isJust (_hd_title x) @?= True
--
-- HAL integration tests
--
testHalRealWorld_01 :: IO (Maybe PubmedApiKey) -> Assertion
testHalRealWorld_01 getPubmedKey = do
mb_key <- getPubmedKey
case mb_key of
Nothing -> pure ()
Just _ -> withValidQuery "Haskell" $ \query -> do
res <- Hal.getC (toISO639 EN) query (Just 1)
case res of
Left err -> fail (show err)
Right (_, cnd) -> do
hyperDocs <- sourceToList cnd
case hyperDocs of
[] -> fail "No documents found."
(x:_) -> assertBool ("found: " <> show (_hd_title x))
(isJust (_hd_title x))
testHalRealWorld_02 :: IO (Maybe PubmedApiKey) -> Assertion
testHalRealWorld_02 getPubmedKey = do
mb_key <- getPubmedKey
case mb_key of
Nothing -> pure ()
Just _ -> withValidQuery "Haskell AND NOT Agda" $ \query -> do
res <- Hal.getC (toISO639 EN) query (Just 1)
case res of
Left err -> fail (show err)
Right (_, cnd) -> do
hyperDocs <- sourceToList cnd
case hyperDocs of
[] -> fail "No documents found."
(x:_) -> isJust (_hd_title x) @?= True
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