src/Gargantext/API/Search.hs

   1 {-|
   2 Module      : Gargantext.API.Count
   3 Description : Server API
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 Count API part of Gargantext.
  11 -}
  12
  13 {-# LANGUAGE TemplateHaskell    #-}
  14 {-# LANGUAGE TypeOperators      #-}
  15 {-# LANGUAGE DeriveAnyClass     #-}
  16
  17 module Gargantext.API.Search
  18       where
  19
  20 import Data.Aeson hiding (defaultTaggedObject)
  21 import Data.Maybe (fromMaybe)
  22 import Data.Swagger hiding (fieldLabelModifier, Contact)
  23 import Data.Text (Text)
  24 import Data.Time (UTCTime)
  25 import GHC.Generics (Generic)
  26 import Gargantext.API.Prelude (GargServer)
  27 import Gargantext.Core.Utils.Prefix (unPrefixSwagger, unCapitalize, dropPrefix)
  28 import Gargantext.Database.Action.Flow.Pairing (isPairedWith)
  29 import Gargantext.Database.Action.Search
  30 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataContact(..), HyperdataDocument(..), ContactWho(..))
  31 import Gargantext.Database.Admin.Types.Hyperdata.Contact (_cw_organization)
  32 import Gargantext.Database.Admin.Types.Node
  33 import Gargantext.Database.Query.Facet
  34 import Gargantext.Prelude
  35 import Gargantext.Utils.Aeson (defaultTaggedObject)
  36 import Servant
  37 import Test.QuickCheck (elements)
  38 import Test.QuickCheck.Arbitrary
  39 import qualified Data.Text as Text
  40
  41 -----------------------------------------------------------------------
  42 -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
  43 -- TODO-EVENTS: No event, this is a read-only query.
  44 type API results = Summary "Search endpoint"
  45                  :> ReqBody '[JSON] SearchQuery
  46                  :> QueryParam "offset" Int
  47                  :> QueryParam "limit"  Int
  48                  :> QueryParam "order"  OrderBy
  49                  :> Post '[JSON] results
  50 -----------------------------------------------------------------------
  51 -- | Api search function
  52 api :: NodeId -> GargServer (API SearchResult)
  53
  54 api nId (SearchQuery q SearchDoc) o l order =
  55   SearchResult <$> SearchResultDoc
  56                <$> map (toRow nId)
  57                <$> searchInCorpus nId False q o l order
  58
  59 api nId (SearchQuery q SearchContact) o l order = do
  60   printDebug "isPairedWith" nId
  61   aIds <- isPairedWith nId NodeAnnuaire
  62   -- TODO if paired with several corpus
  63   case head aIds of
  64     Nothing  -> pure $ SearchResult
  65               $ SearchNoResult "[G.A.Search] pair corpus with an Annuaire"
  66     Just aId -> SearchResult
  67             <$> SearchResultContact
  68             <$> map (toRow aId)
  69             <$> searchInCorpusWithContacts nId aId q o l order
  70
  71 -----------------------------------------------------------------------
  72 -----------------------------------------------------------------------
  73 -- | Main Types
  74 -----------------------------------------------------------------------
  75 data SearchType = SearchDoc | SearchContact
  76   deriving (Generic)
  77 instance FromJSON  SearchType
  78   where
  79     parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  80 instance ToJSON  SearchType
  81   where
  82     toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  83 instance ToSchema SearchType
  84 instance Arbitrary SearchType where
  85   arbitrary = elements [SearchDoc, SearchContact]
  86
  87 -----------------------------------------------------------------------
  88 data SearchQuery =
  89   SearchQuery { query    :: ![Text]
  90               , expected :: !SearchType
  91               }
  92     deriving (Generic)
  93 instance FromJSON  SearchQuery
  94   where
  95     parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  96 instance ToJSON  SearchQuery
  97   where
  98     toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  99 instance ToSchema SearchQuery
 100 {-
 101   where
 102     declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
 103 -}
 104
 105 instance Arbitrary SearchQuery where
 106   arbitrary = elements [SearchQuery ["electrodes"] SearchDoc]
 107   -- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
 108 -----------------------------------------------------------------------
 109 data SearchResult =
 110   SearchResult { result :: !SearchResultTypes}
 111     deriving (Generic)
 112
 113 instance FromJSON  SearchResult
 114   where
 115     parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
 116
 117 instance ToJSON  SearchResult
 118   where
 119     toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
 120
 121 instance ToSchema SearchResult
 122 {-
 123   where
 124     declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
 125 -}
 126
 127 instance Arbitrary SearchResult where
 128   arbitrary = SearchResult <$> arbitrary
 129
 130
 131 data SearchResultTypes =
 132     SearchResultDoc { docs     :: ![Row] }
 133   | SearchResultContact  { contacts :: ![Row] }
 134   | SearchNoResult      { message  :: !Text }
 135   deriving (Generic)
 136 instance FromJSON  SearchResultTypes
 137   where
 138     parseJSON = genericParseJSON (defaultOptions { sumEncoding = defaultTaggedObject })
 139 instance ToJSON  SearchResultTypes
 140   where
 141     toJSON = genericToJSON (defaultOptions { sumEncoding = defaultTaggedObject })
 142
 143 instance Arbitrary SearchResultTypes where
 144   arbitrary = do
 145     srd <- SearchResultDoc     <$> arbitrary
 146     src <- SearchResultContact <$> arbitrary
 147     srn <- pure $ SearchNoResult "No result because.."
 148     elements [srd, src, srn]
 149
 150 instance ToSchema SearchResultTypes where
 151   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
 152
 153
 154 --------------------------------------------------------------------
 155
 156 data Row =
 157     Document { id         :: !NodeId
 158              , created    :: !UTCTime
 159              , title      :: !Text
 160              , hyperdata  :: !HyperdataRow
 161              , category   :: !Int
 162              , score      :: !Int
 163              }
 164   | Contact  { c_id         :: !Int
 165              , c_created    :: !UTCTime
 166              , c_hyperdata  :: !HyperdataRow
 167              , c_score      :: !Int
 168              , c_annuaireId :: !NodeId
 169              }
 170   deriving (Generic)
 171 instance FromJSON  Row
 172   where
 173     parseJSON = genericParseJSON
 174                  ( defaultOptions { sumEncoding = defaultTaggedObject } )
 175 instance ToJSON  Row
 176   where
 177     toJSON = genericToJSON (defaultOptions { sumEncoding = defaultTaggedObject })
 178 instance Arbitrary Row where
 179   arbitrary = arbitrary
 180
 181 instance ToSchema Row where
 182   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
 183
 184 class ToRow a where
 185   toRow :: NodeId -> a -> Row
 186
 187 instance ToRow FacetDoc where
 188   toRow _ (FacetDoc { .. }) =
 189     Document { id = facetDoc_id
 190              , created = facetDoc_created
 191              , title = facetDoc_title
 192              , hyperdata = toHyperdataRow facetDoc_hyperdata
 193              , category = fromMaybe 0 facetDoc_category
 194              , score = round $ fromMaybe 0 facetDoc_score }
 195
 196 -- | TODO rename FacetPaired
 197 type FacetContact = FacetPaired Int UTCTime HyperdataContact Int
 198
 199 instance ToRow FacetContact where
 200   toRow annuaireId (FacetPaired nId utc h s) = Contact nId utc (toHyperdataRow h) s annuaireId
 201
 202
 203 --------------------------------------------------------------------
 204 data HyperdataRow =
 205   HyperdataRowDocument { _hr_abstract           :: !Text
 206                        , _hr_authors            :: !Text
 207                        , _hr_bdd                :: !Text
 208                        , _hr_doi                :: !Text
 209                        , _hr_institutes         :: !Text
 210                        , _hr_language_iso2      :: !Text
 211                        , _hr_page               :: !Int
 212                        , _hr_publication_date   :: !Text
 213                        , _hr_publication_day    :: !Int
 214                        , _hr_publication_hour   :: !Int
 215                        , _hr_publication_minute :: !Int
 216                        , _hr_publication_month  :: !Int
 217                        , _hr_publication_second :: !Int
 218                        , _hr_publication_year   :: !Int
 219                        , _hr_source             :: !Text
 220                        , _hr_title              :: !Text
 221                        , _hr_url                :: !Text
 222                        , _hr_uniqId             :: !Text
 223                        , _hr_uniqIdBdd          :: !Text
 224                        }
 225   | HyperdataRowContact { _hr_firstname :: !Text
 226                         , _hr_lastname  :: !Text
 227                         , _hr_labs      :: !Text
 228                         }
 229   deriving (Generic)
 230 instance FromJSON  HyperdataRow
 231   where
 232     parseJSON = genericParseJSON
 233               ( defaultOptions
 234                 { sumEncoding = defaultTaggedObject
 235                 , fieldLabelModifier = unCapitalize . dropPrefix "_hr_"
 236                 , omitNothingFields = False
 237                 }
 238               )
 239 instance ToJSON  HyperdataRow
 240   where
 241     toJSON = genericToJSON
 242                ( defaultOptions
 243                 { sumEncoding = defaultTaggedObject
 244                 , fieldLabelModifier = unCapitalize . dropPrefix "_hr_"
 245                 , omitNothingFields = False
 246                 }
 247               )
 248
 249 instance Arbitrary HyperdataRow where
 250   arbitrary = arbitrary
 251
 252 instance ToSchema HyperdataRow where
 253   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hr_")
 254
 255 class ToHyperdataRow a where
 256   toHyperdataRow :: a -> HyperdataRow
 257
 258 instance ToHyperdataRow HyperdataDocument where
 259   toHyperdataRow (HyperdataDocument { .. }) =
 260     HyperdataRowDocument
 261       { _hr_abstract = fromMaybe "" _hd_abstract
 262       , _hr_authors = fromMaybe "" _hd_authors
 263       , _hr_bdd = fromMaybe "" _hd_bdd
 264       , _hr_doi = fromMaybe "" _hd_doi
 265       , _hr_institutes = fromMaybe "" _hd_institutes
 266       , _hr_language_iso2 = fromMaybe "EN" _hd_language_iso2
 267       , _hr_page = fromMaybe 0 _hd_page
 268       , _hr_publication_date = fromMaybe "" _hd_publication_date
 269       , _hr_publication_day = fromMaybe 1 _hd_publication_day
 270       , _hr_publication_hour = fromMaybe 1 _hd_publication_hour
 271       , _hr_publication_minute = fromMaybe 1 _hd_publication_minute
 272       , _hr_publication_month = fromMaybe 1 _hd_publication_month
 273       , _hr_publication_second = fromMaybe 1 _hd_publication_second
 274       , _hr_publication_year = fromMaybe 2020 _hd_publication_year
 275       , _hr_source = fromMaybe "" _hd_source
 276       , _hr_title = fromMaybe "Title" _hd_title
 277       , _hr_url = fromMaybe "" _hd_url
 278       , _hr_uniqId = fromMaybe "" _hd_uniqId
 279       , _hr_uniqIdBdd = fromMaybe "" _hd_uniqIdBdd }
 280
 281 instance ToHyperdataRow HyperdataContact where
 282   toHyperdataRow (HyperdataContact { _hc_who = Just (ContactWho _ fn ln _ _), _hc_where = ou} ) =
 283     HyperdataRowContact (fromMaybe "FirstName" fn) (fromMaybe "LastName" ln) ou'
 284       where
 285         ou' = maybe "CNRS" (Text.intercalate " " . _cw_organization) (head ou)
 286   toHyperdataRow (HyperdataContact {}) =
 287     HyperdataRowContact "FirstName" "LastName" "Labs"