Prepare for corpusQuery tests

gargantext.cabal

@@ -848,6 +848,7 @@ test-suite garg-test
   main-is: Main.hs
   other-modules:
       Core.Text
+      Core.Text.Corpus.Query
       Core.Text.Examples
       Core.Text.Flow
       Core.Utils
@@ -896,6 +897,7 @@ test-suite garg-test
       QuickCheck
     , aeson
     , base
+    , boolexpr
     , bytestring
     , containers
     , duckling
@@ -909,6 +911,7 @@ test-suite garg-test
     , quickcheck-instances
     , tasty
     , tasty-hunit
+    , tasty-quickcheck
     , text
     , time
     , unordered-containers

package.yaml

@@ -516,6 +516,7 @@ tests:
      dependencies:
      - aeson
      - base
+     - boolexpr
      - bytestring
      - containers
      - gargantext
@@ -530,6 +531,7 @@ tests:
      - duckling
      - tasty
      - tasty-hunit
+     - tasty-quickcheck
      - text
      - unordered-containers
      - validity

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

+{-# LANGUAGE OverloadedStrings #-}
+module Core.Text.Corpus.Query where
+
+import Data.BoolExpr
+import Gargantext.Core.Text.Corpus.Query
+import Prelude
+
+import Test.Tasty
+import Test.Tasty.QuickCheck hiding (Positive)
+
+main :: IO ()
+main = defaultMain tests
+
+tests :: TestTree
+tests = testGroup "Boolean Query Engine" [
+  testProperty "Parses 'A OR B'" testParse01
+  ]
+
+testParse01 :: Property
+testParse01 =
+  (renderQuery <$> parseQuery "A OR B") === (renderQuery <$> Right (unsafeMkQuery $ (BConst (Positive "A") `BOr` BConst (Positive "B"))))

src-test/Main.hs

@@ -11,6 +11,7 @@ Portability : POSIX
 
 import Gargantext.Prelude
 
+import qualified Core.Text.Corpus.Query  as CorpusQuery
 import qualified Core.Utils as Utils
 --import qualified Ngrams.Lang.Fr as Fr
 --import qualified Ngrams.Lang as Lang
@@ -34,3 +35,4 @@ main = do
   Crypto.test
   NLP.main
   NgramsQuery.main
+  CorpusQuery.main

src/Gargantext/Core/Text/Corpus/Query.hs

+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DerivingStrategies #-}
 module Gargantext.Core.Text.Corpus.Query (
     Query -- * opaque
@@ -5,7 +6,11 @@ module Gargantext.Core.Text.Corpus.Query (
   , Limit(..)
   , getQuery
   , parseQuery
+  , renderQuery
   , ExternalAPIs(..)
+
+  -- * Useful for testing
+  , unsafeMkQuery
   ) where
 
 import           Data.Bifunctor
@@ -13,13 +18,14 @@ import           Data.String
 import           Gargantext.API.Admin.Orchestrator.Types
 import           Gargantext.Core.Types
 import           Prelude
-import qualified Data.Aeson           as Aeson
-import qualified Data.BoolExpr        as BoolExpr
-import qualified Data.BoolExpr.Parser as BoolExpr
-import qualified Data.Swagger as Swagger
-import qualified Data.Text            as T
-import qualified Servant.API as Servant
-import qualified Text.Parsec          as P
+import qualified Data.Aeson                               as Aeson
+import qualified Data.BoolExpr                            as BoolExpr
+import qualified Data.BoolExpr.Parser                     as BoolExpr
+import qualified Data.BoolExpr.Printer                    as BoolExpr
+import qualified Data.Swagger                             as Swagger
+import qualified Data.Text                                as T
+import qualified Servant.API                              as Servant
+import qualified Text.Parsec                              as P
 
 -- | A raw query, as typed by the user from the frontend.
 newtype RawQuery = RawQuery { getRawQuery :: T.Text }
@@ -41,7 +47,13 @@ newtype Limit = Limit { getLimit :: Int }
 newtype Query = Query { getQuery :: (BoolExpr.CNF Term) }
   deriving Show
 
+unsafeMkQuery :: BoolExpr.BoolExpr Term -> Query
+unsafeMkQuery = Query . BoolExpr.boolTreeToCNF
+
 -- | Parses an input 'Text' into a 'Query', reporting an error if it fails.
 parseQuery :: RawQuery -> Either String Query
 parseQuery (RawQuery txt) = bimap show (Query . BoolExpr.boolTreeToCNF) $
   P.runParser (BoolExpr.parseBoolExpr (Term . T.pack <$> BoolExpr.identifier)) () "Corpus.Query" (T.unpack txt)
+
+renderQuery :: Query -> RawQuery
+renderQuery (Query cnf) = RawQuery . T.pack $ BoolExpr.boolExprPrinter (showsPrec 0) (BoolExpr.fromCNF cnf) ""