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

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE DerivingStrategies #-}
   3 module Gargantext.Core.Text.Corpus.Query (
   4     Query -- * opaque
   5   , RawQuery(..)
   6   , Limit(..)
   7   , getQuery
   8   , parseQuery
   9   , renderQuery
  10   , interpretQuery
  11   , ExternalAPIs(..)
  12   , module BoolExpr
  13
  14   -- * Useful for testing
  15   , unsafeMkQuery
  16   ) where
  17
  18 import           Data.Bifunctor
  19 import           Data.String
  20 import           Gargantext.API.Admin.Orchestrator.Types
  21 import           Gargantext.Core.Types
  22 import           Prelude
  23 import           Text.ParserCombinators.Parsec
  24 import           Test.QuickCheck
  25 import qualified Data.Aeson                               as Aeson
  26 import           Data.BoolExpr                            as BoolExpr
  27 import           Data.BoolExpr.Parser                     as BoolExpr
  28 import           Data.BoolExpr.Printer                    as BoolExpr
  29 import qualified Data.Swagger                             as Swagger
  30 import qualified Data.Text                                as T
  31 import qualified Servant.API                              as Servant
  32 import qualified Text.Parsec                              as P
  33
  34 -- | A raw query, as typed by the user from the frontend.
  35 newtype RawQuery = RawQuery { getRawQuery :: T.Text }
  36   deriving newtype ( Show, Eq, IsString
  37                    , Servant.FromHttpApiData, Servant.ToHttpApiData
  38                    , Aeson.FromJSON, Aeson.ToJSON
  39                    , Swagger.ToParamSchema, Swagger.ToSchema)
  40
  41 instance Arbitrary RawQuery where
  42   arbitrary = RawQuery <$> arbitrary
  43
  44 -- | A limit to the number of results we want to retrieve.
  45 newtype Limit = Limit { getLimit :: Int }
  46   deriving newtype ( Show, Eq, Num
  47                    , Servant.FromHttpApiData, Servant.ToHttpApiData
  48                    , Aeson.FromJSON, Aeson.ToJSON
  49                    , Swagger.ToParamSchema, Swagger.ToSchema)
  50
  51 -- | An opaque wrapper around a 'Query' type which can be parsed from a boolean
  52 -- expression like (a AND b) OR c, and which can be interpreted in many ways
  53 -- according to the particular service we are targeting.
  54 newtype Query = Query { getQuery :: (BoolExpr.CNF Term) }
  55   deriving Show
  56
  57 interpretQuery :: Query -> (BoolExpr.BoolExpr Term -> ast) -> ast
  58 interpretQuery (Query q) transform = transform . simplify . BoolExpr.fromCNF $ q
  59
  60 simplify :: BoolExpr.BoolExpr a -> BoolExpr.BoolExpr a
  61 simplify expr = case expr of
  62   BAnd sub BTrue    -> simplify sub
  63   BAnd BTrue sub    -> simplify sub
  64   BAnd BFalse _     -> BFalse
  65   BAnd _ BFalse     -> BFalse
  66   BAnd sub1 sub2    -> BAnd (simplify sub1) (simplify sub2)
  67   BOr _ BTrue       -> BTrue
  68   BOr BTrue _       -> BTrue
  69   BOr sub BFalse    -> simplify sub
  70   BOr BFalse sub    -> simplify sub
  71   BOr sub1 sub2     -> BOr (simplify sub1) (simplify sub2)
  72   BNot BTrue        -> BFalse
  73   BNot BFalse       -> BTrue
  74   BNot (BNot sub)   -> simplify sub
  75   BNot sub          -> BNot (simplify sub)
  76   BTrue             -> BTrue
  77   BFalse            -> BFalse
  78   BConst signed     -> BConst signed
  79
  80 unsafeMkQuery :: BoolExpr.BoolExpr Term -> Query
  81 unsafeMkQuery = Query . BoolExpr.boolTreeToCNF
  82
  83 termToken :: CharParser st Term
  84 termToken = Term <$> (try (T.pack <$> BoolExpr.identifier) <|> (between dubQuote dubQuote multipleTerms))
  85   where
  86     dubQuote      = BoolExpr.symbol "\""
  87     multipleTerms = T.intercalate " " . map T.pack <$> sepBy BoolExpr.identifier BoolExpr.whiteSpace
  88
  89 -- | Parses an input 'Text' into a 'Query', reporting an error if it fails.
  90 parseQuery :: RawQuery -> Either String Query
  91 parseQuery (RawQuery txt) = bimap show (Query . BoolExpr.boolTreeToCNF) $
  92   P.runParser (BoolExpr.parseBoolExpr termToken) () "Corpus.Query" (T.unpack txt)
  93
  94 renderQuery :: Query -> RawQuery
  95 renderQuery (Query cnf) = RawQuery . T.pack $ BoolExpr.boolExprPrinter (showsPrec 0) (BoolExpr.fromCNF cnf) ""