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