src-test/Core/Text/Corpus/Query.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE ScopedTypeVariables #-}
   3 {-# LANGUAGE TypeApplications #-}
   4 module Core.Text.Corpus.Query (tests) where
   5
   6 import Data.BoolExpr
   7 import Gargantext.Core.Text.Corpus.Query
   8 import Gargantext.Core.Types
   9 import Prelude
  10 import qualified Gargantext.Core.Text.Corpus.API.Arxiv as Arxiv
  11 import qualified Network.Api.Arxiv as Arxiv
  12 import qualified Gargantext.Core.Text.Corpus.API.Pubmed as Pubmed
  13
  14 import Test.Tasty
  15 import Test.Tasty.HUnit
  16 import Test.Tasty.QuickCheck hiding (Positive, Negative)
  17
  18 tests :: TestTree
  19 tests = testGroup "Boolean Query Engine" [
  20     testProperty "Parses 'A OR B'" testParse01
  21   , testProperty "Parses 'A AND B'" testParse02
  22   , testProperty "Parses '-A'" testParse03
  23   , testProperty "Parses 'NOT A'" testParse03_01
  24   , testProperty "Parses 'A -B'" testParse04
  25   , testProperty "Parses 'A NOT -B'" testParse04_01
  26   , testProperty "Parses 'A AND B -C'   (left associative)" testParse05
  27   , testProperty "Parses 'A AND (B -C)' (right associative)" testParse05_01
  28   , testProperty "Parses (A OR B OR NOT C) AND (D OR E OR F) -(G OR H OR I)" testParse06
  29   , testCase     "Parses words into a single constant" testWordsIntoConst
  30   , testGroup "Arxiv expression converter" [
  31       testCase "It supports 'A AND B'"     testArxiv01_01
  32     , testCase "It supports '\"Haskell\" AND \"Agda\"'" testArxiv01_02
  33     , testCase "It supports 'A OR B'"        testArxiv02
  34     , testCase "It supports 'A AND NOT B'"   testArxiv03_01
  35     , testCase "It supports 'A AND -B'"      testArxiv03_02
  36     , testCase "It supports 'A AND -B'"      testArxiv03_02
  37     , testCase "It supports 'A AND NOT (NOT B)'"  testArxiv04_01
  38     , testCase "It supports 'A AND NOT (NOT (NOT B))'"  testArxiv04_02
  39     , testCase "It supports 'A OR NOT B'"  testArxiv05
  40     , testCase "It supports '-A'"  testArxiv06
  41     ]
  42   , testGroup "PUBMED expression converter" [
  43       testCase "It supports 'A'" testPubMed01
  44     , testCase "It supports '-A'" testPubMed02_01
  45     , testCase "It supports 'NOT A'" testPubMed02_02
  46     , testCase "It supports 'NOT (NOT A)'" testPubMed02_03
  47     , testCase "It supports '\"Haskell\" AND \"Idris\"'" testPubMed03
  48     , testCase "It supports 'A OR B'" testPubMed04
  49     ]
  50   ]
  51
  52 -- | Checks that the 'RawQuery' can be translated into the expected 'BoolExpr' form,
  53 -- by also checking that both renders back to the initial 'RawQuery'.
  54 translatesInto :: RawQuery -> BoolExpr Term -> Property
  55 (translatesInto) raw boolExpr =
  56   let parsed   = parseQuery raw
  57       expected = Right (unsafeMkQuery boolExpr)
  58   in counterexample (show parsed <> " != " <> show expected) $
  59        (renderQuery <$> parsed) === (renderQuery <$> expected)
  60
  61 testParse01 :: Property
  62 testParse01 = "A OR B" `translatesInto` (BConst (Positive "A") `BOr` BConst (Positive "B"))
  63
  64 testParse02 :: Property
  65 testParse02 = "A AND B" `translatesInto` (BConst (Positive "A") `BAnd` BConst (Positive "B"))
  66
  67 testParse03 :: Property
  68 testParse03 = "-A" `translatesInto` (BConst (Negative "A"))
  69
  70 testParse03_01 :: Property
  71 testParse03_01 = "NOT A" `translatesInto` (BConst (Negative "A"))
  72
  73 testParse04 :: Property
  74 testParse04 = "A -B" `translatesInto` (BConst (Positive "A") `BAnd` BConst (Negative "B"))
  75
  76 -- Both 'A -B' and 'A AND -B' desugars into the same form.
  77 testParse04_01 :: Property
  78 testParse04_01 = "A AND -B" `translatesInto` (BConst (Positive "A") `BAnd` BConst (Negative "B"))
  79
  80 testParse05 :: Property
  81 testParse05 = "A AND B -C" `translatesInto` ((BConst (Positive "A") `BAnd` BConst (Positive "B")) `BAnd` BConst (Negative "C"))
  82
  83 testParse05_01 :: Property
  84 testParse05_01 =
  85   "A AND (B -C)" `translatesInto` (BConst (Positive "A") `BAnd` (BConst (Positive "B") `BAnd` BConst (Negative "C")))
  86
  87 testParse06 :: Property
  88 testParse06 =
  89   translatesInto "(A OR B OR NOT C) AND (D OR E OR F) -(G OR H OR I)"
  90     (
  91       (
  92         ((BConst (Positive  "A") `BOr` (BConst (Positive  "B"))) `BOr` (BConst  (Negative "C")))
  93         `BAnd`
  94         ((BConst (Positive "D") `BOr` (BConst (Positive "E"))) `BOr` (BConst (Positive "F")))
  95       )
  96       `BAnd` BNot (
  97         ((BConst (Positive "G") `BOr` (BConst (Positive "H"))) `BOr` (BConst (Positive "I")))
  98       )
  99     )
 100
 101 testWordsIntoConst :: Assertion
 102 testWordsIntoConst =
 103   let (expected :: BoolExpr Term) =
 104         fromCNF (boolTreeToCNF @Term $ (BConst (Positive "The Art of Computer Programming") `BAnd` (BConst (Positive "Conceptual Mathematics"))))
 105   in case parseQuery "\"The Art of Computer Programming\" AND \"Conceptual Mathematics\"" of
 106     Left err
 107       -> assertBool err False
 108     Right x
 109       -> fromCNF (getQuery x) @?= expected
 110
 111 withValidQuery :: RawQuery -> (Query -> Assertion) -> Assertion
 112 withValidQuery rawQuery onValidParse = do
 113   case parseQuery rawQuery of
 114     Left err -> assertBool err False
 115     Right x  -> onValidParse x
 116
 117
 118 testArxiv01_01 :: Assertion
 119 testArxiv01_01 = withValidQuery "A AND B" $ \q ->
 120   assertBool ("Query not converted into expression: " <> show @(BoolExpr Term) (fromCNF $ getQuery q))
 121              (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.And (Arxiv.Exp $ Arxiv.Abs ["A"]) ((Arxiv.Exp $ Arxiv.Abs ["B"]))))
 122
 123 testArxiv01_02 :: Assertion
 124 testArxiv01_02 = withValidQuery "\"Haskell\" AND \"Agda\"" $ \q ->
 125   assertBool ("Query not converted into expression: " <> show @(BoolExpr Term) (fromCNF $ getQuery q))
 126              (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.And (Arxiv.Exp $ Arxiv.Abs ["Haskell"]) ((Arxiv.Exp $ Arxiv.Abs ["Agda"]))))
 127
 128 testArxiv02 :: Assertion
 129 testArxiv02 = withValidQuery "A OR B" $ \q ->
 130   assertBool ("Query not converted into expression: " <> show @(BoolExpr Term) (fromCNF $ getQuery q))
 131              (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.Or (Arxiv.Exp $ Arxiv.Abs ["A"]) ((Arxiv.Exp $ Arxiv.Abs ["B"]))))
 132
 133 testArxiv03_01 :: Assertion
 134 testArxiv03_01 = withValidQuery "A AND NOT B" $ \q ->
 135   assertBool ("Query not converted into expression: " <> show @(BoolExpr Term) (fromCNF $ getQuery q))
 136              (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.AndNot (Arxiv.Exp $ Arxiv.Abs ["A"]) ((Arxiv.Exp $ Arxiv.Abs ["B"]))))
 137
 138 testArxiv03_02 :: Assertion
 139 testArxiv03_02 = withValidQuery "A AND -B" $ \q ->
 140   assertBool ("Query not converted into expression: " <> show @(BoolExpr Term) (fromCNF $ getQuery q))
 141              (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.AndNot (Arxiv.Exp $ Arxiv.Abs ["A"]) ((Arxiv.Exp $ Arxiv.Abs ["B"]))))
 142
 143 -- Double negation get turned into positive.
 144 testArxiv04_01 :: Assertion
 145 testArxiv04_01 = withValidQuery "A AND NOT (NOT B)" $ \q ->
 146   assertBool ("Query not converted into expression: " <> show @(BoolExpr Term) (fromCNF $ getQuery q))
 147              (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.And (Arxiv.Exp $ Arxiv.Abs ["A"]) ((Arxiv.Exp $ Arxiv.Abs ["B"]))))
 148
 149 testArxiv04_02 :: Assertion
 150 testArxiv04_02 = withValidQuery "A AND NOT (NOT (NOT B))" $ \q ->
 151   assertBool ("Query not converted into expression: " <> show @(BoolExpr Term) (fromCNF $ getQuery q))
 152              (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.AndNot (Arxiv.Exp $ Arxiv.Abs ["A"]) ((Arxiv.Exp $ Arxiv.Abs ["B"]))))
 153
 154 testArxiv05 :: Assertion
 155 testArxiv05 = withValidQuery "A OR NOT B" $ \q ->
 156   assertBool ("Query not converted into expression: " <> show @(BoolExpr Term) (fromCNF $ getQuery q))
 157              (Arxiv.qExp (Arxiv.convertQuery q) == Just (
 158                 Arxiv.Or (Arxiv.Exp $ Arxiv.Abs ["A"])
 159                          (Arxiv.AndNot (Arxiv.Exp $ Arxiv.Abs ["B"]) (Arxiv.Exp $ Arxiv.Abs ["B"]))
 160                 )
 161              )
 162
 163 testArxiv06 :: Assertion
 164 testArxiv06 = withValidQuery "-A" $ \q ->
 165   assertBool ("Query not converted into expression: " <> show @(BoolExpr Term) (fromCNF $ getQuery q))
 166              (Arxiv.qExp (Arxiv.convertQuery q) == Just (
 167                 Arxiv.AndNot (Arxiv.Exp $ Arxiv.Abs ["A"]) (Arxiv.Exp $ Arxiv.Abs ["A"])
 168                 )
 169              )
 170
 171 --
 172 -- PUBMED tests
 173 --
 174
 175 testPubMed01 :: Assertion
 176 testPubMed01 = withValidQuery "A" $ \q ->
 177   assertBool ("Query not converted into expression: " <> show @(BoolExpr Term) (fromCNF $ getQuery q))
 178              (Pubmed.getESearch (Pubmed.convertQuery q) == "%23A")
 179
 180 testPubMed02_01 :: Assertion
 181 testPubMed02_01 = withValidQuery "-A" $ \q -> Pubmed.getESearch (Pubmed.convertQuery q) @?= "%23NOT+A"
 182
 183 testPubMed02_02 :: Assertion
 184 testPubMed02_02 = withValidQuery "NOT A" $ \q -> Pubmed.getESearch (Pubmed.convertQuery q) @?= "%23NOT+A"
 185
 186 testPubMed02_03 :: Assertion
 187 testPubMed02_03 = withValidQuery "NOT (NOT A)" $ \q -> Pubmed.getESearch (Pubmed.convertQuery q) @?= "%23A"
 188
 189 testPubMed03 :: Assertion
 190 testPubMed03 = withValidQuery "\"Haskell\" AND \"Idris\"" $ \q ->
 191   Pubmed.getESearch (Pubmed.convertQuery q) @?= "%23Haskell+AND+Idris"
 192
 193 testPubMed04 :: Assertion
 194 testPubMed04 = withValidQuery "A OR B" $ \q ->
 195   Pubmed.getESearch (Pubmed.convertQuery q) @?= "%23A+OR+B"