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 where
  78   parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  79 instance ToJSON SearchType where
  80   toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  81 instance ToSchema SearchType
  82 instance Arbitrary SearchType where
  83   arbitrary = elements [SearchDoc, SearchContact]
  84
  85 -----------------------------------------------------------------------
  86 data SearchQuery =
  87   SearchQuery { query    :: ![Text]
  88               , expected :: !SearchType
  89               }
  90     deriving (Generic)
  91 instance FromJSON SearchQuery where
  92   parseJSON = genericParseJSON defaultOptions
  93 instance ToJSON SearchQuery where
  94   toJSON = genericToJSON defaultOptions
  95 instance ToSchema SearchQuery
  96 {-
  97   where
  98     declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
  99 -}
 100
 101 instance Arbitrary SearchQuery where
 102   arbitrary = elements [SearchQuery ["electrodes"] SearchDoc]
 103   -- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
 104 -----------------------------------------------------------------------
 105 data SearchResult =
 106   SearchResult { result :: !SearchResultTypes}
 107     deriving (Generic)
 108
 109 instance FromJSON SearchResult where
 110   parseJSON = genericParseJSON defaultOptions
 111
 112 instance ToJSON SearchResult where
 113   toJSON = genericToJSON defaultOptions
 114
 115 instance ToSchema SearchResult
 116 {-
 117   where
 118     declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
 119 -}
 120
 121 instance Arbitrary SearchResult where
 122   arbitrary = SearchResult <$> arbitrary
 123
 124
 125 data SearchResultTypes =
 126     SearchResultDoc { docs     :: ![Row] }
 127   | SearchResultContact  { contacts :: ![Row] }
 128   | SearchNoResult      { message  :: !Text }
 129   deriving (Generic)
 130 instance FromJSON SearchResultTypes where
 131   parseJSON = genericParseJSON (defaultOptions { sumEncoding = defaultTaggedObject })
 132 instance ToJSON SearchResultTypes where
 133   toJSON = genericToJSON (defaultOptions { sumEncoding = defaultTaggedObject })
 134
 135 instance Arbitrary SearchResultTypes where
 136   arbitrary = do
 137     srd <- SearchResultDoc     <$> arbitrary
 138     src <- SearchResultContact <$> arbitrary
 139     srn <- pure $ SearchNoResult "No result because.."
 140     elements [srd, src, srn]
 141
 142 instance ToSchema SearchResultTypes where
 143   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
 144
 145
 146 --------------------------------------------------------------------
 147
 148 data Row =
 149     Document { id         :: !NodeId
 150              , created    :: !UTCTime
 151              , title      :: !Text
 152              , hyperdata  :: !HyperdataRow
 153              , category   :: !Int
 154              , score      :: !Int
 155              }
 156   | Contact  { c_id         :: !Int
 157              , c_created    :: !UTCTime
 158              , c_hyperdata  :: !HyperdataRow
 159              , c_score      :: !Int
 160              , c_annuaireId :: !NodeId
 161              }
 162   deriving (Generic)
 163 instance FromJSON  Row
 164   where
 165     parseJSON = genericParseJSON
 166                  ( defaultOptions { sumEncoding = defaultTaggedObject } )
 167 instance ToJSON  Row
 168   where
 169     toJSON = genericToJSON (defaultOptions { sumEncoding = defaultTaggedObject })
 170 instance Arbitrary Row where
 171   arbitrary = arbitrary
 172
 173 instance ToSchema Row where
 174   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
 175
 176 class ToRow a where
 177   toRow :: NodeId -> a -> Row
 178
 179 instance ToRow FacetDoc where
 180   toRow _ (FacetDoc { .. }) =
 181     Document { id = facetDoc_id
 182              , created = facetDoc_created
 183              , title = facetDoc_title
 184              , hyperdata = toHyperdataRow facetDoc_hyperdata
 185              , category = fromMaybe 0 facetDoc_category
 186              , score = round $ fromMaybe 0 facetDoc_score }
 187
 188 -- | TODO rename FacetPaired
 189 type FacetContact = FacetPaired Int UTCTime HyperdataContact Int
 190
 191 instance ToRow FacetContact where
 192   toRow annuaireId (FacetPaired nId utc h s) = Contact nId utc (toHyperdataRow h) s annuaireId
 193
 194
 195 --------------------------------------------------------------------
 196 data HyperdataRow =
 197   HyperdataRowDocument { _hr_abstract           :: !Text
 198                        , _hr_authors            :: !Text
 199                        , _hr_bdd                :: !Text
 200                        , _hr_doi                :: !Text
 201                        , _hr_institutes         :: !Text
 202                        , _hr_language_iso2      :: !Text
 203                        , _hr_page               :: !Int
 204                        , _hr_publication_date   :: !Text
 205                        , _hr_publication_day    :: !Int
 206                        , _hr_publication_hour   :: !Int
 207                        , _hr_publication_minute :: !Int
 208                        , _hr_publication_month  :: !Int
 209                        , _hr_publication_second :: !Int
 210                        , _hr_publication_year   :: !Int
 211                        , _hr_source             :: !Text
 212                        , _hr_title              :: !Text
 213                        , _hr_url                :: !Text
 214                        , _hr_uniqId             :: !Text
 215                        , _hr_uniqIdBdd          :: !Text
 216                        }
 217   | HyperdataRowContact { _hr_firstname :: !Text
 218                         , _hr_lastname  :: !Text
 219                         , _hr_labs      :: !Text
 220                         }
 221   deriving (Generic)
 222 instance FromJSON  HyperdataRow
 223   where
 224     parseJSON = genericParseJSON
 225               ( defaultOptions
 226                 { sumEncoding = defaultTaggedObject
 227                 , fieldLabelModifier = unCapitalize . dropPrefix "_hr_"
 228                 , omitNothingFields = False
 229                 }
 230               )
 231 instance ToJSON  HyperdataRow
 232   where
 233     toJSON = genericToJSON
 234                ( defaultOptions
 235                 { sumEncoding = defaultTaggedObject
 236                 , fieldLabelModifier = unCapitalize . dropPrefix "_hr_"
 237                 , omitNothingFields = False
 238                 }
 239               )
 240
 241 instance Arbitrary HyperdataRow where
 242   arbitrary = arbitrary
 243
 244 instance ToSchema HyperdataRow where
 245   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hr_")
 246
 247 class ToHyperdataRow a where
 248   toHyperdataRow :: a -> HyperdataRow
 249
 250 instance ToHyperdataRow HyperdataDocument where
 251   toHyperdataRow (HyperdataDocument { .. }) =
 252     HyperdataRowDocument
 253       { _hr_abstract = fromMaybe "" _hd_abstract
 254       , _hr_authors = fromMaybe "" _hd_authors
 255       , _hr_bdd = fromMaybe "" _hd_bdd
 256       , _hr_doi = fromMaybe "" _hd_doi
 257       , _hr_institutes = fromMaybe "" _hd_institutes
 258       , _hr_language_iso2 = fromMaybe "EN" _hd_language_iso2
 259       , _hr_page = fromMaybe 0 _hd_page
 260       , _hr_publication_date = fromMaybe "" _hd_publication_date
 261       , _hr_publication_day = fromMaybe 1 _hd_publication_day
 262       , _hr_publication_hour = fromMaybe 1 _hd_publication_hour
 263       , _hr_publication_minute = fromMaybe 1 _hd_publication_minute
 264       , _hr_publication_month = fromMaybe 1 _hd_publication_month
 265       , _hr_publication_second = fromMaybe 1 _hd_publication_second
 266       , _hr_publication_year = fromMaybe 2020 _hd_publication_year
 267       , _hr_source = fromMaybe "" _hd_source
 268       , _hr_title = fromMaybe "Title" _hd_title
 269       , _hr_url = fromMaybe "" _hd_url
 270       , _hr_uniqId = fromMaybe "" _hd_uniqId
 271       , _hr_uniqIdBdd = fromMaybe "" _hd_uniqIdBdd }
 272
 273 instance ToHyperdataRow HyperdataContact where
 274   toHyperdataRow (HyperdataContact { _hc_who = Just (ContactWho _ fn ln _ _), _hc_where = ou} ) =
 275     HyperdataRowContact (fromMaybe "FirstName" fn) (fromMaybe "LastName" ln) ou'
 276       where
 277         ou' = maybe "CNRS" (Text.intercalate " " . _cw_organization) (head ou)
 278   toHyperdataRow (HyperdataContact {}) =
 279     HyperdataRowContact "FirstName" "LastName" "Labs"