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   , ExternalAPIs(..)
  11
  12   -- * Useful for testing
  13   , unsafeMkQuery
  14   ) where
  15
  16 import           Data.Bifunctor
  17 import           Data.String
  18 import           Gargantext.API.Admin.Orchestrator.Types
  19 import           Gargantext.Core.Types
  20 import           Prelude
  21 import           Text.ParserCombinators.Parsec
  22 import qualified Data.Aeson                               as Aeson
  23 import qualified Data.BoolExpr                            as BoolExpr
  24 import qualified Data.BoolExpr.Parser                     as BoolExpr
  25 import qualified Data.BoolExpr.Printer                    as BoolExpr
  26 import qualified Data.Swagger                             as Swagger
  27 import qualified Data.Text                                as T
  28 import qualified Servant.API                              as Servant
  29 import qualified Text.Parsec                              as P
  30
  31 -- | A raw query, as typed by the user from the frontend.
  32 newtype RawQuery = RawQuery { getRawQuery :: T.Text }
  33   deriving newtype ( Show, Eq, IsString
  34                    , Servant.FromHttpApiData, Servant.ToHttpApiData
  35                    , Aeson.FromJSON, Aeson.ToJSON
  36                    , Swagger.ToParamSchema, Swagger.ToSchema)
  37
  38 -- | A limit to the number of results we want to retrieve.
  39 newtype Limit = Limit { getLimit :: Int }
  40   deriving newtype ( Show, Eq, Num
  41                    , Servant.FromHttpApiData, Servant.ToHttpApiData
  42                    , Aeson.FromJSON, Aeson.ToJSON
  43                    , Swagger.ToParamSchema, Swagger.ToSchema)
  44
  45 -- | An opaque wrapper around a 'Query' type which can be parsed from a boolean
  46 -- expression like (a AND b) OR c, and which can be interpreted in many ways
  47 -- according to the particular service we are targeting.
  48 newtype Query = Query { getQuery :: (BoolExpr.CNF Term) }
  49   deriving Show
  50
  51 unsafeMkQuery :: BoolExpr.BoolExpr Term -> Query
  52 unsafeMkQuery = Query . BoolExpr.boolTreeToCNF
  53
  54 termToken :: CharParser st Term
  55 termToken = Term <$> (try (T.pack <$> BoolExpr.identifier) <|> (between dubQuote dubQuote multipleTerms))
  56   where
  57     dubQuote      = BoolExpr.symbol "\""
  58     multipleTerms = T.intercalate " " . map T.pack <$> sepBy BoolExpr.identifier BoolExpr.whiteSpace
  59
  60 -- | Parses an input 'Text' into a 'Query', reporting an error if it fails.
  61 parseQuery :: RawQuery -> Either String Query
  62 parseQuery (RawQuery txt) = bimap show (Query . BoolExpr.boolTreeToCNF) $
  63   P.runParser (BoolExpr.parseBoolExpr termToken) () "Corpus.Query" (T.unpack txt)
  64
  65 renderQuery :: Query -> RawQuery
  66 renderQuery (Query cnf) = RawQuery . T.pack $ BoolExpr.boolExprPrinter (showsPrec 0) (BoolExpr.fromCNF cnf) ""