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 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  14
  15 {-# LANGUAGE TemplateHaskell    #-}
  16 {-# LANGUAGE TypeOperators      #-}
  17 {-# LANGUAGE DeriveAnyClass     #-}
  18
  19 module Gargantext.API.Search
  20       where
  21
  22 import Data.Aeson
  23 import Data.Maybe (fromMaybe)
  24 import Data.Swagger hiding (fieldLabelModifier)
  25 import Data.Text (Text)
  26 import Data.Time (UTCTime)
  27 import GHC.Generics (Generic)
  28 import Gargantext.API.Prelude (GargServer)
  29 import Gargantext.Core.Utils.Prefix (unPrefixSwagger, unCapitalize, dropPrefix)
  30 import Gargantext.Database.Query.Facet
  31 import Gargantext.Database.Action.Search
  32 import Gargantext.Database.Action.Flow.Pairing (isPairedWith)
  33 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataContact, HyperdataDocument(..))
  34 import Gargantext.Database.Admin.Types.Node
  35 import Gargantext.Prelude
  36 import Servant
  37 import Test.QuickCheck (elements)
  38 import Test.QuickCheck.Arbitrary
  39
  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 :: NodeId -> GargServer (API SearchResult)
  52 api nId (SearchQuery q SearchDoc) o l order =
  53   SearchResult <$> SearchResultDoc <$> map toRow <$> searchInCorpus nId False q o l order
  54 api nId (SearchQuery q SearchContact) o l order = do
  55   aIds <- isPairedWith NodeAnnuaire nId
  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 <$> 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
 108 data SearchResult =
 109   SearchResult { result :: !SearchResultTypes
 110               }
 111   | SearchResultErr !Text
 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 = SearchResultDoc { docs     :: ![Row]}
 133                   | SearchResultContact  { contacts :: ![FacetPaired Int UTCTime HyperdataContact Int] }
 134                   | SearchNoResult      { message  :: !Text }
 135
 136   deriving (Generic)
 137
 138 instance FromJSON  SearchResultTypes
 139   where
 140     parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
 141
 142 instance ToJSON  SearchResultTypes
 143   where
 144     toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
 145
 146 instance Arbitrary SearchResultTypes where
 147   arbitrary = do
 148     srd <- SearchResultDoc     <$> arbitrary
 149     src <- SearchResultContact <$> arbitrary
 150     srn <- pure $ SearchNoResult "No result because.."
 151     elements [srd, src, srn]
 152
 153 instance ToSchema SearchResultTypes where
 154   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
 155
 156
 157 --------------------------------------------------------------------
 158
 159 data Row =
 160   Document { id         :: !NodeId
 161            , created    :: !UTCTime
 162            , title      :: !Text
 163            , hyperdata  :: !HyperdataRow
 164            , category   :: !Int
 165            , score      :: !Int
 166            }
 167   | Contact  { c_id       :: !Int
 168            , c_created    :: !Text
 169            , c_hyperdata  :: !HyperdataContact
 170            , c_score      :: !Int
 171            }
 172   deriving (Generic)
 173
 174 instance FromJSON  Row
 175   where
 176     parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
 177
 178 instance ToJSON  Row
 179   where
 180     toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
 181
 182 instance Arbitrary Row where
 183   arbitrary = arbitrary
 184
 185 instance ToSchema Row where
 186   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
 187
 188 toRow :: FacetDoc -> Row
 189 toRow (FacetDoc nId utc t h mc md) = Document nId utc t (toHyperdataRow h) (fromMaybe 0 mc) (round $ fromMaybe 0 md)
 190
 191 --------------------------------------------------------------------
 192
 193 data HyperdataRow =
 194   HyperdataRowDocument { _hr_bdd                :: !Text
 195                        , _hr_doi                :: !Text
 196                        , _hr_url                :: !Text
 197                        , _hr_uniqId             :: !Text
 198                        , _hr_uniqIdBdd          :: !Text
 199                        , _hr_page               :: !Int
 200                        , _hr_title              :: !Text
 201                        , _hr_authors            :: !Text
 202                        , _hr_institutes         :: !Text
 203                        , _hr_source             :: !Text
 204                        , _hr_abstract           :: !Text
 205                        , _hr_publication_date   :: !Text
 206                        , _hr_publication_year   :: !Int
 207                        , _hr_publication_month  :: !Int
 208                        , _hr_publication_day    :: !Int
 209                        , _hr_publication_hour   :: !Int
 210                        , _hr_publication_minute :: !Int
 211                        , _hr_publication_second :: !Int
 212                        , _hr_language_iso2      :: !Text
 213                        }
 214   | HyperdataRowContact { _hr_name :: !Text }
 215   deriving (Generic)
 216
 217 instance FromJSON  HyperdataRow
 218   where
 219     parseJSON = genericParseJSON
 220               ( defaultOptions
 221                 { sumEncoding = ObjectWithSingleField
 222                 , fieldLabelModifier = unCapitalize . dropPrefix "_hr_"
 223                 , omitNothingFields = True
 224                 }
 225               )
 226
 227 instance ToJSON  HyperdataRow
 228   where
 229     toJSON = genericToJSON
 230                ( defaultOptions
 231                 { sumEncoding = ObjectWithSingleField
 232                 , fieldLabelModifier = unCapitalize . dropPrefix "_hr_"
 233                 , omitNothingFields = True
 234                 }
 235               )
 236
 237 instance Arbitrary HyperdataRow where
 238   arbitrary = arbitrary
 239
 240 instance ToSchema HyperdataRow where
 241   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hr_")
 242
 243 toHyperdataRow :: HyperdataDocument -> HyperdataRow
 244 toHyperdataRow (HyperdataDocument b d u ui ub p t a i s abs pd py pm pda ph pmin psec l) =
 245   HyperdataRowDocument
 246     (fromMaybe "" b)
 247     (fromMaybe "" d)
 248     (fromMaybe "" u)
 249     (fromMaybe "" ui)
 250     (fromMaybe "" ub)
 251     (fromMaybe 0 p)
 252     (fromMaybe "Title" t)
 253     (fromMaybe "" a)
 254     (fromMaybe "" i)
 255     (fromMaybe "" s)
 256     (fromMaybe "" abs)
 257     (fromMaybe "" pd)
 258     (fromMaybe 2020 py)
 259     (fromMaybe 1 pm)
 260     (fromMaybe 1 pda)
 261     (fromMaybe 1 ph)
 262     (fromMaybe 1 pmin)
 263     (fromMaybe 1 psec)
 264     (fromMaybe "EN" l)
 265