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
  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 Servant
  36 import Test.QuickCheck (elements)
  37 import Test.QuickCheck.Arbitrary
  38 import qualified Data.Text as Text
  39
  40 -----------------------------------------------------------------------
  41 -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
  42 -- TODO-EVENTS: No event, this is a read-only query.
  43 type API results = Summary "Search endpoint"
  44                  :> ReqBody '[JSON] SearchQuery
  45                  :> QueryParam "offset" Int
  46                  :> QueryParam "limit"  Int
  47                  :> QueryParam "order"  OrderBy
  48                  :> Post '[JSON] results
  49 -----------------------------------------------------------------------
  50 api :: NodeId -> GargServer (API SearchResult)
  51 api nId (SearchQuery q SearchDoc) o l order =
  52   SearchResult <$> SearchResultDoc <$> map toRow <$> searchInCorpus nId False q o l order
  53 api nId (SearchQuery q SearchContact) o l order = do
  54   printDebug "isPairedWith" nId
  55   aIds <- isPairedWith nId NodeAnnuaire
  56   -- TODO if paired with several corpus
  57   case head aIds of
  58     Nothing  -> pure $ SearchResult $ SearchNoResult "[G.A.Search] pair corpus with an Annuaire"
  59     Just aId -> SearchResult <$> SearchResultContact <$> map toRow <$> searchInCorpusWithContacts nId aId q o l order
  60 api _ _ _ _ _ = undefined
  61
  62 -----------------------------------------------------------------------
  63 -----------------------------------------------------------------------
  64 -- | Main Types
  65 -----------------------------------------------------------------------
  66 data SearchType = SearchDoc | SearchContact
  67   deriving (Generic)
  68
  69 instance FromJSON  SearchType
  70   where
  71     parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  72
  73 instance ToJSON  SearchType
  74   where
  75     toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  76
  77 instance ToSchema SearchType
  78 instance Arbitrary SearchType where
  79   arbitrary = elements [SearchDoc, SearchContact]
  80
  81 -----------------------------------------------------------------------
  82 data SearchQuery =
  83   SearchQuery { query    :: ![Text]
  84               , expected :: !SearchType
  85               }
  86   | SearchQueryErr !Text
  87     deriving (Generic)
  88
  89 instance FromJSON  SearchQuery
  90   where
  91     parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  92
  93 instance ToJSON  SearchQuery
  94   where
  95     toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  96
  97 instance ToSchema SearchQuery
  98 {-
  99   where
 100     declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
 101 -}
 102
 103 instance Arbitrary SearchQuery where
 104   arbitrary = elements [SearchQuery ["electrodes"] SearchDoc]
 105   -- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
 106 -----------------------------------------------------------------------
 107 data SearchResult =
 108   SearchResult { result :: !SearchResultTypes}
 109   | SearchResultErr !Text
 110     deriving (Generic)
 111
 112 instance FromJSON  SearchResult
 113   where
 114     parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
 115
 116 instance ToJSON  SearchResult
 117   where
 118     toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
 119
 120 instance ToSchema SearchResult
 121 {-
 122   where
 123     declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
 124 -}
 125
 126 instance Arbitrary SearchResult where
 127   arbitrary = SearchResult <$> arbitrary
 128
 129
 130 data SearchResultTypes = SearchResultDoc { docs     :: ![Row]}
 131                   | SearchResultContact  { contacts :: ![Row] }
 132                   | SearchNoResult      { message  :: !Text }
 133
 134   deriving (Generic)
 135
 136 instance FromJSON  SearchResultTypes
 137   where
 138     parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
 139
 140 instance ToJSON  SearchResultTypes
 141   where
 142     toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
 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              }
 170   deriving (Generic)
 171
 172 instance FromJSON  Row
 173   where
 174     parseJSON = genericParseJSON
 175                  ( defaultOptions { sumEncoding = ObjectWithSingleField
 176                                   }
 177                  )
 178
 179 instance ToJSON  Row
 180   where
 181     toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
 182
 183 instance Arbitrary Row where
 184   arbitrary = arbitrary
 185
 186 instance ToSchema Row where
 187   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
 188
 189 class ToRow a where
 190   toRow :: a -> Row
 191
 192 instance ToRow FacetDoc where
 193   toRow (FacetDoc nId utc t h mc _md sc) = Document nId utc t (toHyperdataRow h) (fromMaybe 0 mc) (round $ fromMaybe 0 sc)
 194
 195 -- | TODO rename FacetPaired
 196 type FacetContact = FacetPaired Int UTCTime HyperdataContact Int
 197
 198 instance ToRow FacetContact where
 199   toRow (FacetPaired nId utc h s) = Contact nId utc (toHyperdataRow h) s
 200
 201
 202 --------------------------------------------------------------------
 203 data HyperdataRow =
 204   HyperdataRowDocument { _hr_bdd                :: !Text
 205                        , _hr_doi                :: !Text
 206                        , _hr_url                :: !Text
 207                        , _hr_uniqId             :: !Text
 208                        , _hr_uniqIdBdd          :: !Text
 209                        , _hr_page               :: !Int
 210                        , _hr_title              :: !Text
 211                        , _hr_authors            :: !Text
 212                        , _hr_institutes         :: !Text
 213                        , _hr_source             :: !Text
 214                        , _hr_abstract           :: !Text
 215                        , _hr_publication_date   :: !Text
 216                        , _hr_publication_year   :: !Int
 217                        , _hr_publication_month  :: !Int
 218                        , _hr_publication_day    :: !Int
 219                        , _hr_publication_hour   :: !Int
 220                        , _hr_publication_minute :: !Int
 221                        , _hr_publication_second :: !Int
 222                        , _hr_language_iso2      :: !Text
 223                        }
 224   | HyperdataRowContact { _hr_firstname :: !Text
 225                         , _hr_lastname  :: !Text
 226                         , _hr_labs      :: !Text
 227                         }
 228   deriving (Generic)
 229
 230 instance FromJSON  HyperdataRow
 231   where
 232     parseJSON = genericParseJSON
 233               ( defaultOptions
 234                 { sumEncoding = ObjectWithSingleField
 235                 , fieldLabelModifier = unCapitalize . dropPrefix "_hr_"
 236                 , omitNothingFields = False
 237                 }
 238               )
 239
 240 instance ToJSON  HyperdataRow
 241   where
 242     toJSON = genericToJSON
 243                ( defaultOptions
 244                 { sumEncoding = ObjectWithSingleField
 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 b d u ui ub p t a i s abs' pd py pm pda ph pmin psec l) =
 261     HyperdataRowDocument
 262       (fromMaybe "" b)
 263       (fromMaybe "" d)
 264       (fromMaybe "" u)
 265       (fromMaybe "" ui)
 266       (fromMaybe "" ub)
 267       (fromMaybe 0 p)
 268       (fromMaybe "Title" t)
 269       (fromMaybe "" a)
 270       (fromMaybe "" i)
 271       (fromMaybe "" s)
 272       (fromMaybe "" abs')
 273       (fromMaybe "" pd)
 274       (fromMaybe 2020 py)
 275       (fromMaybe 1 pm)
 276       (fromMaybe 1 pda)
 277       (fromMaybe 1 ph)
 278       (fromMaybe 1 pmin)
 279       (fromMaybe 1 psec)
 280       (fromMaybe "EN" l)
 281
 282 instance ToHyperdataRow HyperdataContact where
 283   toHyperdataRow (HyperdataContact _ (Just (ContactWho _ fn ln _ _)) ou _ _ _ _ _ ) =
 284     HyperdataRowContact (fromMaybe "FirstName" fn) (fromMaybe "LastName" ln) ou'
 285       where
 286         ou' = maybe "IMT" (Text.intercalate " " . _cw_organization) (head ou)
 287   toHyperdataRow (HyperdataContact _ _ _ _ _ _ _ _ ) =
 288     HyperdataRowContact "FirstName" "LastName" "Labs"