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 nId utc t h mc _md sc) =
 189     Document nId utc t (toHyperdataRow h) (fromMaybe 0 mc) (round $ fromMaybe 0 sc)
 190
 191 -- | TODO rename FacetPaired
 192 type FacetContact = FacetPaired Int UTCTime HyperdataContact Int
 193
 194 instance ToRow FacetContact where
 195   toRow annuaireId (FacetPaired nId utc h s) = Contact nId utc (toHyperdataRow h) s annuaireId
 196
 197
 198 --------------------------------------------------------------------
 199 data HyperdataRow =
 200   HyperdataRowDocument { _hr_abstract           :: !Text
 201                        , _hr_authors            :: !Text
 202                        , _hr_bdd                :: !Text
 203                        , _hr_doi                :: !Text
 204                        , _hr_institutes         :: !Text
 205                        , _hr_language_iso2      :: !Text
 206                        , _hr_page               :: !Int
 207                        , _hr_publication_date   :: !Text
 208                        , _hr_publication_day    :: !Int
 209                        , _hr_publication_hour   :: !Int
 210                        , _hr_publication_minute :: !Int
 211                        , _hr_publication_month  :: !Int
 212                        , _hr_publication_second :: !Int
 213                        , _hr_publication_year   :: !Int
 214                        , _hr_source             :: !Text
 215                        , _hr_title              :: !Text
 216                        , _hr_url                :: !Text
 217                        , _hr_uniqId             :: !Text
 218                        , _hr_uniqIdBdd          :: !Text
 219                        }
 220   | HyperdataRowContact { _hr_firstname :: !Text
 221                         , _hr_lastname  :: !Text
 222                         , _hr_labs      :: !Text
 223                         }
 224   deriving (Generic)
 225 instance FromJSON  HyperdataRow
 226   where
 227     parseJSON = genericParseJSON
 228               ( defaultOptions
 229                 { sumEncoding = defaultTaggedObject
 230                 , fieldLabelModifier = unCapitalize . dropPrefix "_hr_"
 231                 , omitNothingFields = False
 232                 }
 233               )
 234 instance ToJSON  HyperdataRow
 235   where
 236     toJSON = genericToJSON
 237                ( defaultOptions
 238                 { sumEncoding = defaultTaggedObject
 239                 , fieldLabelModifier = unCapitalize . dropPrefix "_hr_"
 240                 , omitNothingFields = False
 241                 }
 242               )
 243
 244 instance Arbitrary HyperdataRow where
 245   arbitrary = arbitrary
 246
 247 instance ToSchema HyperdataRow where
 248   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hr_")
 249
 250 class ToHyperdataRow a where
 251   toHyperdataRow :: a -> HyperdataRow
 252
 253 instance ToHyperdataRow HyperdataDocument where
 254   toHyperdataRow (HyperdataDocument b d u ui ub p t a i s abs' pd py pm pda ph pmin psec l) =
 255     HyperdataRowDocument
 256       (fromMaybe "" b)
 257       (fromMaybe "" d)
 258       (fromMaybe "" u)
 259       (fromMaybe "" ui)
 260       (fromMaybe "" ub)
 261       (fromMaybe 0 p)
 262       (fromMaybe "Title" t)
 263       (fromMaybe "" a)
 264       (fromMaybe "" i)
 265       (fromMaybe "" s)
 266       (fromMaybe "" abs')
 267       (fromMaybe "" pd)
 268       (fromMaybe 2020 py)
 269       (fromMaybe 1 pm)
 270       (fromMaybe 1 pda)
 271       (fromMaybe 1 ph)
 272       (fromMaybe 1 pmin)
 273       (fromMaybe 1 psec)
 274       (fromMaybe "EN" l)
 275
 276 instance ToHyperdataRow HyperdataContact where
 277   toHyperdataRow (HyperdataContact _ (Just (ContactWho _ fn ln _ _)) ou _ _ _ _ _ ) =
 278     HyperdataRowContact (fromMaybe "FirstName" fn) (fromMaybe "LastName" ln) ou'
 279       where
 280         ou' = maybe "CNRS" (Text.intercalate " " . _cw_organization) (head ou)
 281   toHyperdataRow (HyperdataContact _ _ _ _ _ _ _ _ ) =
 282     HyperdataRowContact "FirstName" "LastName" "Labs"