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
  13 import Test.Tasty
  14 import Test.Tasty.HUnit
  15 import Test.Tasty.QuickCheck hiding (Positive, Negative)
  16
  17 tests :: TestTree
  18 tests = testGroup "Boolean Query Engine" [
  19     testProperty "Parses 'A OR B'" testParse01
  20   , testProperty "Parses 'A AND B'" testParse02
  21   , testProperty "Parses '-A'" testParse03
  22   , testProperty "Parses 'NOT A'" testParse03_01
  23   , testProperty "Parses 'A -B'" testParse04
  24   , testProperty "Parses 'A NOT -B'" testParse04_01
  25   , testProperty "Parses 'A AND B -C'   (left associative)" testParse05
  26   , testProperty "Parses 'A AND (B -C)' (right associative)" testParse05_01
  27   , testProperty "Parses (A OR B OR NOT C) AND (D OR E OR F) -(G OR H OR I)" testParse06
  28   , testCase     "Parses words into a single constant" testWordsIntoConst
  29   , testGroup "Arxiv expression converter" [
  30       testCase "It supports 'A AND B'"     testArxiv01_01
  31     , testCase "It supports '\"Haskell\" AND \"Agda\"'" testArxiv01_02
  32     , testCase "It supports 'A OR B'"        testArxiv02
  33     , testCase "It supports 'A AND NOT B'"   testArxiv03_01
  34     , testCase "It supports 'A AND -B'"      testArxiv03_02
  35     , testCase "It supports 'A AND -B'"      testArxiv03_02
  36     , testCase "It supports 'A AND NOT (NOT B)'"  testArxiv04_01
  37     , testCase "It supports 'A AND NOT (NOT (NOT B))'"  testArxiv04_02
  38     , testCase "It supports 'A OR NOT B'"  testArxiv05
  39     , testCase "It supports '-A'"  testArxiv06
  40     ]
  41   ]
  42
  43 -- | Checks that the 'RawQuery' can be translated into the expected 'BoolExpr' form,
  44 -- by also checking that both renders back to the initial 'RawQuery'.
  45 translatesInto :: RawQuery -> BoolExpr Term -> Property
  46 (translatesInto) raw boolExpr =
  47   let parsed   = parseQuery raw
  48       expected = Right (unsafeMkQuery boolExpr)
  49   in counterexample (show parsed <> " != " <> show expected) $
  50        (renderQuery <$> parsed) === (renderQuery <$> expected)
  51
  52 testParse01 :: Property
  53 testParse01 = "A OR B" `translatesInto` (BConst (Positive "A") `BOr` BConst (Positive "B"))
  54
  55 testParse02 :: Property
  56 testParse02 = "A AND B" `translatesInto` (BConst (Positive "A") `BAnd` BConst (Positive "B"))
  57
  58 testParse03 :: Property
  59 testParse03 = "-A" `translatesInto` (BConst (Negative "A"))
  60
  61 testParse03_01 :: Property
  62 testParse03_01 = "NOT A" `translatesInto` (BConst (Negative "A"))
  63
  64 testParse04 :: Property
  65 testParse04 = "A -B" `translatesInto` (BConst (Positive "A") `BAnd` BConst (Negative "B"))
  66
  67 -- Both 'A -B' and 'A AND -B' desugars into the same form.
  68 testParse04_01 :: Property
  69 testParse04_01 = "A AND -B" `translatesInto` (BConst (Positive "A") `BAnd` BConst (Negative "B"))
  70
  71 testParse05 :: Property
  72 testParse05 = "A AND B -C" `translatesInto` ((BConst (Positive "A") `BAnd` BConst (Positive "B")) `BAnd` BConst (Negative "C"))
  73
  74 testParse05_01 :: Property
  75 testParse05_01 =
  76   "A AND (B -C)" `translatesInto` (BConst (Positive "A") `BAnd` (BConst (Positive "B") `BAnd` BConst (Negative "C")))
  77
  78 testParse06 :: Property
  79 testParse06 =
  80   translatesInto "(A OR B OR NOT C) AND (D OR E OR F) -(G OR H OR I)"
  81     (
  82       (
  83         ((BConst (Positive  "A") `BOr` (BConst (Positive  "B"))) `BOr` (BConst  (Negative "C")))
  84         `BAnd`
  85         ((BConst (Positive "D") `BOr` (BConst (Positive "E"))) `BOr` (BConst (Positive "F")))
  86       )
  87       `BAnd` BNot (
  88         ((BConst (Positive "G") `BOr` (BConst (Positive "H"))) `BOr` (BConst (Positive "I")))
  89       )
  90     )
  91
  92 testWordsIntoConst :: Assertion
  93 testWordsIntoConst =
  94   let (expected :: BoolExpr Term) =
  95         fromCNF (boolTreeToCNF @Term $ (BConst (Positive "The Art of Computer Programming") `BAnd` (BConst (Positive "Conceptual Mathematics"))))
  96   in case parseQuery "\"The Art of Computer Programming\" AND \"Conceptual Mathematics\"" of
  97     Left err
  98       -> assertBool err False
  99     Right x
 100       -> fromCNF (getQuery x) @?= expected
 101
 102 withValidQuery :: RawQuery -> (Query -> Assertion) -> Assertion
 103 withValidQuery rawQuery onValidParse = do
 104   case parseQuery rawQuery of
 105     Left err -> assertBool err False
 106     Right x  -> onValidParse x
 107
 108
 109 testArxiv01_01 :: Assertion
 110 testArxiv01_01 = withValidQuery "A AND B" $ \q ->
 111   assertBool ("Query not converted into expression: " <> show @(BoolExpr Term) (fromCNF $ getQuery q))
 112              (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.And (Arxiv.Exp $ Arxiv.Abs ["A"]) ((Arxiv.Exp $ Arxiv.Abs ["B"]))))
 113
 114 testArxiv01_02 :: Assertion
 115 testArxiv01_02 = withValidQuery "\"Haskell\" AND \"Agda\"" $ \q ->
 116   assertBool ("Query not converted into expression: " <> show @(BoolExpr Term) (fromCNF $ getQuery q))
 117              (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.And (Arxiv.Exp $ Arxiv.Abs ["Haskell"]) ((Arxiv.Exp $ Arxiv.Abs ["Agda"]))))
 118
 119 testArxiv02 :: Assertion
 120 testArxiv02 = withValidQuery "A OR B" $ \q ->
 121   assertBool ("Query not converted into expression: " <> show @(BoolExpr Term) (fromCNF $ getQuery q))
 122              (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.Or (Arxiv.Exp $ Arxiv.Abs ["A"]) ((Arxiv.Exp $ Arxiv.Abs ["B"]))))
 123
 124 testArxiv03_01 :: Assertion
 125 testArxiv03_01 = withValidQuery "A AND NOT B" $ \q ->
 126   assertBool ("Query not converted into expression: " <> show @(BoolExpr Term) (fromCNF $ getQuery q))
 127              (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.AndNot (Arxiv.Exp $ Arxiv.Abs ["A"]) ((Arxiv.Exp $ Arxiv.Abs ["B"]))))
 128
 129 testArxiv03_02 :: Assertion
 130 testArxiv03_02 = withValidQuery "A AND -B" $ \q ->
 131   assertBool ("Query not converted into expression: " <> show @(BoolExpr Term) (fromCNF $ getQuery q))
 132              (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.AndNot (Arxiv.Exp $ Arxiv.Abs ["A"]) ((Arxiv.Exp $ Arxiv.Abs ["B"]))))
 133
 134 -- Double negation get turned into positive.
 135 testArxiv04_01 :: Assertion
 136 testArxiv04_01 = withValidQuery "A AND NOT (NOT B)" $ \q ->
 137   assertBool ("Query not converted into expression: " <> show @(BoolExpr Term) (fromCNF $ getQuery q))
 138              (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.And (Arxiv.Exp $ Arxiv.Abs ["A"]) ((Arxiv.Exp $ Arxiv.Abs ["B"]))))
 139
 140 testArxiv04_02 :: Assertion
 141 testArxiv04_02 = withValidQuery "A AND NOT (NOT (NOT B))" $ \q ->
 142   assertBool ("Query not converted into expression: " <> show @(BoolExpr Term) (fromCNF $ getQuery q))
 143              (Arxiv.qExp (Arxiv.convertQuery q) == Just (Arxiv.AndNot (Arxiv.Exp $ Arxiv.Abs ["A"]) ((Arxiv.Exp $ Arxiv.Abs ["B"]))))
 144
 145 testArxiv05 :: Assertion
 146 testArxiv05 = withValidQuery "A OR NOT B" $ \q ->
 147   assertBool ("Query not converted into expression: " <> show @(BoolExpr Term) (fromCNF $ getQuery q))
 148              (Arxiv.qExp (Arxiv.convertQuery q) == Just (
 149                 Arxiv.Or (Arxiv.Exp $ Arxiv.Abs ["A"])
 150                          (Arxiv.AndNot (Arxiv.Exp $ Arxiv.Abs ["B"]) (Arxiv.Exp $ Arxiv.Abs ["B"]))
 151                 )
 152              )
 153
 154 testArxiv06 :: Assertion
 155 testArxiv06 = withValidQuery "-A" $ \q ->
 156   assertBool ("Query not converted into expression: " <> show @(BoolExpr Term) (fromCNF $ getQuery q))
 157              (Arxiv.qExp (Arxiv.convertQuery q) == Just (
 158                 Arxiv.AndNot (Arxiv.Exp $ Arxiv.Abs ["A"]) (Arxiv.Exp $ Arxiv.Abs ["A"])
 159                 )
 160              )