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