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
  11 import Test.Tasty
  12 import Test.Tasty.HUnit
  13 import Test.Tasty.QuickCheck hiding (Positive, Negative)
  14
  15 tests :: TestTree
  16 tests = testGroup "Boolean Query Engine" [
  17     testProperty "Parses 'A OR B'" testParse01
  18   , testProperty "Parses 'A AND B'" testParse02
  19   , testProperty "Parses '-A'" testParse03
  20   , testProperty "Parses 'NOT A'" testParse03_01
  21   , testProperty "Parses 'A -B'" testParse04
  22   , testProperty "Parses 'A NOT -B'" testParse04_01
  23   , testProperty "Parses 'A AND B -C'   (left associative)" testParse05
  24   , testProperty "Parses 'A AND (B -C)' (right associative)" testParse05_01
  25   , testProperty "Parses (A OR B OR NOT C) AND (D OR E OR F) -(G OR H OR I)" testParse06
  26   , testCase     "Parses words into a single constant" testWordsIntoConst
  27
  28   ]
  29
  30 -- | Checks that the 'RawQuery' can be translated into the expected 'BoolExpr' form,
  31 -- by also checking that both renders back to the initial 'RawQuery'.
  32 translatesInto :: RawQuery -> BoolExpr Term -> Property
  33 (translatesInto) raw boolExpr =
  34   let parsed   = parseQuery raw
  35       expected = Right (unsafeMkQuery boolExpr)
  36   in counterexample (show parsed <> " != " <> show expected) $
  37        (renderQuery <$> parsed) === (renderQuery <$> expected)
  38
  39 testParse01 :: Property
  40 testParse01 = "A OR B" `translatesInto` (BConst (Positive "A") `BOr` BConst (Positive "B"))
  41
  42 testParse02 :: Property
  43 testParse02 = "A AND B" `translatesInto` (BConst (Positive "A") `BAnd` BConst (Positive "B"))
  44
  45 testParse03 :: Property
  46 testParse03 = "-A" `translatesInto` (BConst (Negative "A"))
  47
  48 testParse03_01 :: Property
  49 testParse03_01 = "NOT A" `translatesInto` (BConst (Negative "A"))
  50
  51 testParse04 :: Property
  52 testParse04 = "A -B" `translatesInto` (BConst (Positive "A") `BAnd` BConst (Negative "B"))
  53
  54 -- Both 'A -B' and 'A AND -B' desugars into the same form.
  55 testParse04_01 :: Property
  56 testParse04_01 = "A AND -B" `translatesInto` (BConst (Positive "A") `BAnd` BConst (Negative "B"))
  57
  58 testParse05 :: Property
  59 testParse05 = "A AND B -C" `translatesInto` ((BConst (Positive "A") `BAnd` BConst (Positive "B")) `BAnd` BConst (Negative "C"))
  60
  61 testParse05_01 :: Property
  62 testParse05_01 =
  63   "A AND (B -C)" `translatesInto` (BConst (Positive "A") `BAnd` (BConst (Positive "B") `BAnd` BConst (Negative "C")))
  64
  65 testParse06 :: Property
  66 testParse06 =
  67   translatesInto "(A OR B OR NOT C) AND (D OR E OR F) -(G OR H OR I)"
  68     (
  69       (
  70         ((BConst (Positive  "A") `BOr` (BConst (Positive  "B"))) `BOr` (BConst  (Negative "C")))
  71         `BAnd`
  72         ((BConst (Positive "D") `BOr` (BConst (Positive "E"))) `BOr` (BConst (Positive "F")))
  73       )
  74       `BAnd` BNot (
  75         ((BConst (Positive "G") `BOr` (BConst (Positive "H"))) `BOr` (BConst (Positive "I")))
  76       )
  77     )
  78
  79 testWordsIntoConst :: Assertion
  80 testWordsIntoConst =
  81   let (expected :: BoolExpr Term) =
  82         fromCNF (boolTreeToCNF @Term $ (BConst (Positive "The Art of Computer Programming") `BAnd` (BConst (Positive "Conceptual Mathematics"))))
  83   in case parseQuery "\"The Art of Computer Programming\" AND \"Conceptual Mathematics\"" of
  84     Left err
  85       -> assertBool err False
  86     Right x
  87       -> fromCNF (getQuery x) @?= expected