Count API part of Gargantext.
-}
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
module Gargantext.API.Search
where
-import GHC.Generics (Generic)
-import Data.Time (UTCTime)
-import Data.Aeson.TH (deriveJSON)
-import Data.Swagger
+import Data.Aeson hiding (defaultTaggedObject)
+import Data.Maybe (fromMaybe)
+import Data.Swagger hiding (fieldLabelModifier, Contact)
import Data.Text (Text)
+import Data.Time (UTCTime)
+import GHC.Generics (Generic)
+import Gargantext.API.Prelude (GargServer)
+import Gargantext.Core.Utils.Prefix (unPrefixSwagger, unCapitalize, dropPrefix)
+import Gargantext.Database.Action.Flow.Pairing (isPairedWith)
+import Gargantext.Database.Action.Search
+import Gargantext.Database.Admin.Types.Hyperdata (HyperdataContact(..), HyperdataDocument(..), ContactWho(..))
+import Gargantext.Database.Admin.Types.Hyperdata.Contact (_cw_organization)
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Query.Facet
+import Gargantext.Prelude
+import Gargantext.Utils.Aeson (defaultTaggedObject)
import Servant
-import Test.QuickCheck.Arbitrary
import Test.QuickCheck (elements)
--- import Control.Applicative ((<*>))
-import Gargantext.API.Types (GargServer)
-import Gargantext.Prelude
-import Gargantext.Core.Utils.Prefix (unPrefix)
-import Gargantext.Database.Types.Node
-import Gargantext.Database.TextSearch
-import Gargantext.Database.Facet
+import Test.QuickCheck.Arbitrary
+import qualified Data.Text as Text
-----------------------------------------------------------------------
-data SearchQuery = SearchQuery
- { sq_query :: [Text]
- } deriving (Generic)
+-- TODO-ACCESS: CanSearch? or is it part of CanGetNode
+-- TODO-EVENTS: No event, this is a read-only query.
+type API results = Summary "Search endpoint"
+ :> ReqBody '[JSON] SearchQuery
+ :> QueryParam "offset" Int
+ :> QueryParam "limit" Int
+ :> QueryParam "order" OrderBy
+ :> Post '[JSON] results
+-----------------------------------------------------------------------
+-- | Api search function
+api :: NodeId -> GargServer (API SearchResult)
-$(deriveJSON (unPrefix "sq_") ''SearchQuery)
+api nId (SearchQuery q SearchDoc) o l order =
+ SearchResult <$> SearchResultDoc
+ <$> map (toRow nId)
+ <$> searchInCorpus nId False q o l order
-instance ToSchema SearchQuery where
- declareNamedSchema =
- genericDeclareNamedSchema
- defaultSchemaOptions {fieldLabelModifier = drop 3}
+api nId (SearchQuery q SearchContact) o l order = do
+ printDebug "isPairedWith" nId
+ aIds <- isPairedWith nId NodeAnnuaire
+ -- TODO if paired with several corpus
+ case head aIds of
+ Nothing -> pure $ SearchResult
+ $ SearchNoResult "[G.A.Search] pair corpus with an Annuaire"
+ Just aId -> SearchResult
+ <$> SearchResultContact
+ <$> map (toRow aId)
+ <$> searchInCorpusWithContacts nId aId q o l order
-instance Arbitrary SearchQuery where
- arbitrary = elements [SearchQuery ["electrodes"]]
+-----------------------------------------------------------------------
+-----------------------------------------------------------------------
+-- | Main Types
+-----------------------------------------------------------------------
+data SearchType = SearchDoc | SearchContact
+ deriving (Generic)
+instance FromJSON SearchType
+ where
+ parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+instance ToJSON SearchType
+ where
+ toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+instance ToSchema SearchType
+instance Arbitrary SearchType where
+ arbitrary = elements [SearchDoc, SearchContact]
-----------------------------------------------------------------------
+data SearchQuery =
+ SearchQuery { query :: ![Text]
+ , expected :: !SearchType
+ }
+ deriving (Generic)
+instance FromJSON SearchQuery
+ where
+ parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+instance ToJSON SearchQuery
+ where
+ toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+instance ToSchema SearchQuery
+{-
+ where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
+-}
-data SearchDocResults = SearchDocResults { sdr_results :: [FacetDoc]}
+instance Arbitrary SearchQuery where
+ arbitrary = elements [SearchQuery ["electrodes"] SearchDoc]
+ -- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
+-----------------------------------------------------------------------
+data SearchResult =
+ SearchResult { result :: !SearchResultTypes}
+ deriving (Generic)
+
+instance FromJSON SearchResult
+ where
+ parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+
+instance ToJSON SearchResult
+ where
+ toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+
+instance ToSchema SearchResult
+{-
+ where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
+-}
+
+instance Arbitrary SearchResult where
+ arbitrary = SearchResult <$> arbitrary
+
+
+data SearchResultTypes =
+ SearchResultDoc { docs :: ![Row] }
+ | SearchResultContact { contacts :: ![Row] }
+ | SearchNoResult { message :: !Text }
deriving (Generic)
-$(deriveJSON (unPrefix "sdr_") ''SearchDocResults)
+instance FromJSON SearchResultTypes
+ where
+ parseJSON = genericParseJSON (defaultOptions { sumEncoding = defaultTaggedObject })
+instance ToJSON SearchResultTypes
+ where
+ toJSON = genericToJSON (defaultOptions { sumEncoding = defaultTaggedObject })
+
+instance Arbitrary SearchResultTypes where
+ arbitrary = do
+ srd <- SearchResultDoc <$> arbitrary
+ src <- SearchResultContact <$> arbitrary
+ srn <- pure $ SearchNoResult "No result because.."
+ elements [srd, src, srn]
+
+instance ToSchema SearchResultTypes where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
-instance Arbitrary SearchDocResults where
- arbitrary = SearchDocResults <$> arbitrary
-instance ToSchema SearchDocResults where
- declareNamedSchema =
- genericDeclareNamedSchema
- defaultSchemaOptions {fieldLabelModifier = drop 4}
+--------------------------------------------------------------------
-data SearchPairedResults = SearchPairedResults { spr_results :: [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]] }
+data Row =
+ Document { id :: !NodeId
+ , created :: !UTCTime
+ , title :: !Text
+ , hyperdata :: !HyperdataRow
+ , category :: !Int
+ , score :: !Int
+ }
+ | Contact { c_id :: !Int
+ , c_created :: !UTCTime
+ , c_hyperdata :: !HyperdataRow
+ , c_score :: !Int
+ , c_annuaireId :: !NodeId
+ }
deriving (Generic)
-$(deriveJSON (unPrefix "spr_") ''SearchPairedResults)
+instance FromJSON Row
+ where
+ parseJSON = genericParseJSON
+ ( defaultOptions { sumEncoding = defaultTaggedObject } )
+instance ToJSON Row
+ where
+ toJSON = genericToJSON (defaultOptions { sumEncoding = defaultTaggedObject })
+instance Arbitrary Row where
+ arbitrary = arbitrary
-instance Arbitrary SearchPairedResults where
- arbitrary = SearchPairedResults <$> arbitrary
+instance ToSchema Row where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
-instance ToSchema SearchPairedResults where
- declareNamedSchema =
- genericDeclareNamedSchema
- defaultSchemaOptions {fieldLabelModifier = \fieldLabel -> drop 4 fieldLabel}
+class ToRow a where
+ toRow :: NodeId -> a -> Row
------------------------------------------------------------------------
--- TODO-ACCESS: CanSearch? or is it part of CanGetNode
--- TODO-EVENTS: No event, this is a read-only query.
-type SearchAPI results
- = Summary "Search endpoint"
- :> ReqBody '[JSON] SearchQuery
- :> QueryParam "offset" Int
- :> QueryParam "limit" Int
- :> QueryParam "order" OrderBy
- :> Post '[JSON] results
-
-type SearchDocsAPI = SearchAPI SearchDocResults
-type SearchPairsAPI = SearchAPI SearchPairedResults
------------------------------------------------------------------------
+instance ToRow FacetDoc where
+ toRow _ (FacetDoc { .. }) =
+ Document { id = facetDoc_id
+ , created = facetDoc_created
+ , title = facetDoc_title
+ , hyperdata = toHyperdataRow facetDoc_hyperdata
+ , category = fromMaybe 0 facetDoc_category
+ , score = round $ fromMaybe 0 facetDoc_score }
+
+-- | TODO rename FacetPaired
+type FacetContact = FacetPaired Int UTCTime HyperdataContact Int
-searchPairs :: NodeId -> GargServer SearchPairsAPI
-searchPairs pId (SearchQuery q) o l order =
- SearchPairedResults <$> searchInCorpusWithContacts pId q o l order
+instance ToRow FacetContact where
+ toRow annuaireId (FacetPaired nId utc h s) = Contact nId utc (toHyperdataRow h) s annuaireId
-searchDocs :: NodeId -> GargServer SearchDocsAPI
-searchDocs nId (SearchQuery q) o l order =
- SearchDocResults <$> searchInCorpus nId q o l order
- --SearchResults <$> searchInCorpusWithContacts nId q o l order
+--------------------------------------------------------------------
+data HyperdataRow =
+ HyperdataRowDocument { _hr_abstract :: !Text
+ , _hr_authors :: !Text
+ , _hr_bdd :: !Text
+ , _hr_doi :: !Text
+ , _hr_institutes :: !Text
+ , _hr_language_iso2 :: !Text
+ , _hr_page :: !Int
+ , _hr_publication_date :: !Text
+ , _hr_publication_day :: !Int
+ , _hr_publication_hour :: !Int
+ , _hr_publication_minute :: !Int
+ , _hr_publication_month :: !Int
+ , _hr_publication_second :: !Int
+ , _hr_publication_year :: !Int
+ , _hr_source :: !Text
+ , _hr_title :: !Text
+ , _hr_url :: !Text
+ , _hr_uniqId :: !Text
+ , _hr_uniqIdBdd :: !Text
+ }
+ | HyperdataRowContact { _hr_firstname :: !Text
+ , _hr_lastname :: !Text
+ , _hr_labs :: !Text
+ }
+ deriving (Generic)
+instance FromJSON HyperdataRow
+ where
+ parseJSON = genericParseJSON
+ ( defaultOptions
+ { sumEncoding = defaultTaggedObject
+ , fieldLabelModifier = unCapitalize . dropPrefix "_hr_"
+ , omitNothingFields = False
+ }
+ )
+instance ToJSON HyperdataRow
+ where
+ toJSON = genericToJSON
+ ( defaultOptions
+ { sumEncoding = defaultTaggedObject
+ , fieldLabelModifier = unCapitalize . dropPrefix "_hr_"
+ , omitNothingFields = False
+ }
+ )
+
+instance Arbitrary HyperdataRow where
+ arbitrary = arbitrary
+instance ToSchema HyperdataRow where
+ declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hr_")
+
+class ToHyperdataRow a where
+ toHyperdataRow :: a -> HyperdataRow
+
+instance ToHyperdataRow HyperdataDocument where
+ toHyperdataRow (HyperdataDocument { .. }) =
+ HyperdataRowDocument
+ { _hr_abstract = fromMaybe "" _hd_abstract
+ , _hr_authors = fromMaybe "" _hd_authors
+ , _hr_bdd = fromMaybe "" _hd_bdd
+ , _hr_doi = fromMaybe "" _hd_doi
+ , _hr_institutes = fromMaybe "" _hd_institutes
+ , _hr_language_iso2 = fromMaybe "EN" _hd_language_iso2
+ , _hr_page = fromMaybe 0 _hd_page
+ , _hr_publication_date = fromMaybe "" _hd_publication_date
+ , _hr_publication_day = fromMaybe 1 _hd_publication_day
+ , _hr_publication_hour = fromMaybe 1 _hd_publication_hour
+ , _hr_publication_minute = fromMaybe 1 _hd_publication_minute
+ , _hr_publication_month = fromMaybe 1 _hd_publication_month
+ , _hr_publication_second = fromMaybe 1 _hd_publication_second
+ , _hr_publication_year = fromMaybe 2020 _hd_publication_year
+ , _hr_source = fromMaybe "" _hd_source
+ , _hr_title = fromMaybe "Title" _hd_title
+ , _hr_url = fromMaybe "" _hd_url
+ , _hr_uniqId = fromMaybe "" _hd_uniqId
+ , _hr_uniqIdBdd = fromMaybe "" _hd_uniqIdBdd }
+
+instance ToHyperdataRow HyperdataContact where
+ toHyperdataRow (HyperdataContact { _hc_who = Just (ContactWho _ fn ln _ _), _hc_where = ou} ) =
+ HyperdataRowContact (fromMaybe "FirstName" fn) (fromMaybe "LastName" ln) ou'
+ where
+ ou' = maybe "CNRS" (Text.intercalate " " . _cw_organization) (head ou)
+ toHyperdataRow (HyperdataContact {}) =
+ HyperdataRowContact "FirstName" "LastName" "Labs"