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 (BoolExpr.fromCNF q)
  55
  56 unsafeMkQuery :: BoolExpr.BoolExpr Term -> Query
  57 unsafeMkQuery = Query . BoolExpr.boolTreeToCNF
  58
  59 termToken :: CharParser st Term
  60 termToken = Term <$> (try (T.pack <$> BoolExpr.identifier) <|> (between dubQuote dubQuote multipleTerms))
  61   where
  62     dubQuote      = BoolExpr.symbol "\""
  63     multipleTerms = T.intercalate " " . map T.pack <$> sepBy BoolExpr.identifier BoolExpr.whiteSpace
  64
  65 -- | Parses an input 'Text' into a 'Query', reporting an error if it fails.
  66 parseQuery :: RawQuery -> Either String Query
  67 parseQuery (RawQuery txt) = bimap show (Query . BoolExpr.boolTreeToCNF) $
  68   P.runParser (BoolExpr.parseBoolExpr termToken) () "Corpus.Query" (T.unpack txt)
  69
  70 renderQuery :: Query -> RawQuery
  71 renderQuery (Query cnf) = RawQuery . T.pack $ BoolExpr.boolExprPrinter (showsPrec 0) (BoolExpr.fromCNF cnf) ""