Search.hs 10.5 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
{-|
Module      : Gargantext.API.Count
Description : Server API
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

Count API part of Gargantext.
-}

{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeOperators      #-}
{-# LANGUAGE DeriveAnyClass     #-}

module Gargantext.API.Search
      where

20
import Data.Aeson hiding (defaultTaggedObject)
21
-- import Data.List (concat)
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 29
import Gargantext.Core.Utils.Prefix (unPrefixSwagger, unCapitalize, dropPrefix)
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 qualified Gargantext.Defaults as Defaults
36
import Gargantext.Prelude
37
import Gargantext.Utils.Aeson (defaultTaggedObject)
38 39 40
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
41
import qualified Data.Text as Text
42

43 44 45 46 47 48 49 50 51 52
-----------------------------------------------------------------------
-- TODO-ACCESS: CanSearch? or is it part of CanGetNode
-- TODO-EVENTS: No event, this is a read-only query.
type API results = Summary "Search endpoint"
                 :> ReqBody '[JSON] SearchQuery
                 :> QueryParam "offset" Int
                 :> QueryParam "limit"  Int
                 :> QueryParam "order"  OrderBy
                 :> Post '[JSON] results
-----------------------------------------------------------------------
Alexandre Delanoë's avatar
Alexandre Delanoë committed
53
-- | Api search function
54
api :: NodeId -> GargServer (API SearchResult)
Alexandre Delanoë's avatar
Alexandre Delanoë committed
55

56
api nId (SearchQuery q SearchDoc) o l order =
Alexandre Delanoë's avatar
Alexandre Delanoë committed
57 58
  SearchResult <$> SearchResultDoc
               <$> map (toRow nId)
59 60
               <$> searchInCorpus nId False q o l order
               -- <$> searchInCorpus nId False (concat q) o l order
Alexandre Delanoë's avatar
Alexandre Delanoë committed
61

62
api nId (SearchQuery q SearchContact) o l order = do
63 64
  printDebug "isPairedWith" nId
  aIds <- isPairedWith nId NodeAnnuaire
65 66
  -- TODO if paired with several corpus
  case head aIds of
Alexandre Delanoë's avatar
Alexandre Delanoë committed
67 68 69 70 71
    Nothing  -> pure $ SearchResult
              $ SearchNoResult "[G.A.Search] pair corpus with an Annuaire"
    Just aId -> SearchResult
            <$> SearchResultContact
            <$> map (toRow aId)
72
            <$> searchInCorpusWithContacts nId aId q o l order
73

74
api _nId (SearchQuery _q SearchDocWithNgrams) _o _l _order = undefined
75

76 77 78
-----------------------------------------------------------------------
-----------------------------------------------------------------------
-- | Main Types
79
-----------------------------------------------------------------------
80
data SearchType = SearchDoc | SearchContact | SearchDocWithNgrams
81
  deriving (Generic)
82 83 84 85
instance FromJSON SearchType where
  parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToJSON SearchType where
  toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
86 87 88 89
instance ToSchema SearchType
instance Arbitrary SearchType where
  arbitrary = elements [SearchDoc, SearchContact]

90
-----------------------------------------------------------------------
91
data SearchQuery =
92
  SearchQuery { query    :: ![Text]
93
              , expected :: !SearchType
94 95
              }
    deriving (Generic)
96 97 98 99
instance FromJSON SearchQuery where
  parseJSON = genericParseJSON defaultOptions
instance ToJSON SearchQuery where
  toJSON = genericToJSON defaultOptions
100 101 102 103 104
instance ToSchema SearchQuery
{-
  where
    declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
-}
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 115
instance FromJSON SearchResult where
  parseJSON = genericParseJSON defaultOptions
116

117 118
instance ToJSON SearchResult where
  toJSON = genericToJSON defaultOptions
119 120 121 122 123

instance ToSchema SearchResult
{-
  where
    declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
124
-}
125

126
instance Arbitrary SearchResult where
127 128 129
  arbitrary = SearchResult <$> arbitrary


130 131 132 133
data SearchResultTypes =
    SearchResultDoc { docs     :: ![Row] }
  | SearchResultContact  { contacts :: ![Row] }
  | SearchNoResult      { message  :: !Text }
134
  deriving (Generic)
135 136 137 138
instance FromJSON SearchResultTypes where
  parseJSON = genericParseJSON (defaultOptions { sumEncoding = defaultTaggedObject })
instance ToJSON SearchResultTypes where
  toJSON = genericToJSON (defaultOptions { sumEncoding = defaultTaggedObject })
139

140
instance Arbitrary SearchResultTypes where
141 142
  arbitrary = do
    srd <- SearchResultDoc     <$> arbitrary
143 144 145 146 147 148 149 150 151 152 153
    src <- SearchResultContact <$> arbitrary
    srn <- pure $ SearchNoResult "No result because.."
    elements [srd, src, srn]

instance ToSchema SearchResultTypes where
  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")


--------------------------------------------------------------------

data Row =
154 155 156 157 158 159 160
    Document { id         :: !NodeId
             , created    :: !UTCTime
             , title      :: !Text
             , hyperdata  :: !HyperdataRow
             , category   :: !Int
             , score      :: !Int
             }
161 162 163 164
  | Contact  { c_id         :: !Int
             , c_created    :: !UTCTime
             , c_hyperdata  :: !HyperdataRow
             , c_score      :: !Int
Alexandre Delanoë's avatar
Alexandre Delanoë committed
165
             , c_annuaireId :: !NodeId
166
             }
167 168 169
  deriving (Generic)
instance FromJSON  Row
  where
170
    parseJSON = genericParseJSON
171
                 ( defaultOptions { sumEncoding = defaultTaggedObject } )
172 173
instance ToJSON  Row
  where
174
    toJSON = genericToJSON (defaultOptions { sumEncoding = defaultTaggedObject })
175 176 177 178 179 180
instance Arbitrary Row where
  arbitrary = arbitrary

instance ToSchema Row where
  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")

181
class ToRow a where
Alexandre Delanoë's avatar
Alexandre Delanoë committed
182
  toRow :: NodeId -> a -> Row
183

184
instance ToRow FacetDoc where
185 186 187 188 189 190 191
  toRow _ (FacetDoc { .. }) =
    Document { id = facetDoc_id
             , created = facetDoc_created
             , title = facetDoc_title
             , hyperdata = toHyperdataRow facetDoc_hyperdata
             , category = fromMaybe 0 facetDoc_category
             , score = round $ fromMaybe 0 facetDoc_score }
192

193 194 195 196
-- | TODO rename FacetPaired
type FacetContact = FacetPaired Int UTCTime HyperdataContact Int

instance ToRow FacetContact where
Alexandre Delanoë's avatar
Alexandre Delanoë committed
197
  toRow annuaireId (FacetPaired nId utc h s) = Contact nId utc (toHyperdataRow h) s annuaireId
198 199 200


--------------------------------------------------------------------
201
data HyperdataRow =
202
  HyperdataRowDocument { _hr_abstract           :: !Text
203
                       , _hr_authors            :: !Text
204 205
                       , _hr_bdd                :: !Text
                       , _hr_doi                :: !Text
206
                       , _hr_institutes         :: !Text
207 208
                       , _hr_language_iso2      :: !Text
                       , _hr_page               :: !Int
209 210 211 212
                       , _hr_publication_date   :: !Text
                       , _hr_publication_day    :: !Int
                       , _hr_publication_hour   :: !Int
                       , _hr_publication_minute :: !Int
213
                       , _hr_publication_month  :: !Int
214
                       , _hr_publication_second :: !Int
215 216 217 218 219 220
                       , _hr_publication_year   :: !Int
                       , _hr_source             :: !Text
                       , _hr_title              :: !Text
                       , _hr_url                :: !Text
                       , _hr_uniqId             :: !Text
                       , _hr_uniqIdBdd          :: !Text
221
                       }
222 223 224 225
  | HyperdataRowContact { _hr_firstname :: !Text
                        , _hr_lastname  :: !Text
                        , _hr_labs      :: !Text
                        }
226 227 228 229 230
  deriving (Generic)
instance FromJSON  HyperdataRow
  where
    parseJSON = genericParseJSON
              ( defaultOptions
231
                { sumEncoding = defaultTaggedObject
232
                , fieldLabelModifier = unCapitalize . dropPrefix "_hr_"
233
                , omitNothingFields = False
234 235 236 237 238 239
                }
              )
instance ToJSON  HyperdataRow
  where
    toJSON = genericToJSON
               ( defaultOptions
240
                { sumEncoding = defaultTaggedObject
241
                , fieldLabelModifier = unCapitalize . dropPrefix "_hr_"
242
                , omitNothingFields = False
243 244 245 246 247
                }
              )

instance Arbitrary HyperdataRow where
  arbitrary = arbitrary
248

249 250
instance ToSchema HyperdataRow where
  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hr_")
251

252 253 254 255
class ToHyperdataRow a where
  toHyperdataRow :: a -> HyperdataRow

instance ToHyperdataRow HyperdataDocument where
256
  toHyperdataRow (HyperdataDocument { .. }) =
257
    HyperdataRowDocument
258 259 260 261 262 263 264 265
      { _hr_abstract = fromMaybe "" _hd_abstract
      , _hr_authors = fromMaybe "" _hd_authors
      , _hr_bdd = fromMaybe "" _hd_bdd
      , _hr_doi = fromMaybe "" _hd_doi
      , _hr_institutes = fromMaybe "" _hd_institutes
      , _hr_language_iso2 = fromMaybe "EN" _hd_language_iso2
      , _hr_page = fromMaybe 0 _hd_page
      , _hr_publication_date = fromMaybe "" _hd_publication_date
266 267 268 269 270 271
      , _hr_publication_year = fromMaybe (fromIntegral Defaults.year) _hd_publication_year
      , _hr_publication_month = fromMaybe Defaults.month _hd_publication_month
      , _hr_publication_day = fromMaybe Defaults.day _hd_publication_day
      , _hr_publication_hour = fromMaybe 0 _hd_publication_hour
      , _hr_publication_minute = fromMaybe 0 _hd_publication_minute
      , _hr_publication_second = fromMaybe 0 _hd_publication_second
272 273 274 275 276
      , _hr_source = fromMaybe "" _hd_source
      , _hr_title = fromMaybe "Title" _hd_title
      , _hr_url = fromMaybe "" _hd_url
      , _hr_uniqId = fromMaybe "" _hd_uniqId
      , _hr_uniqIdBdd = fromMaybe "" _hd_uniqIdBdd }
277 278

instance ToHyperdataRow HyperdataContact where
Karen Konou's avatar
Karen Konou committed
279
  toHyperdataRow (HyperdataContact { _hc_who = Just (ContactWho _ fn ln _ _ _), _hc_where = ou} ) =
280 281
    HyperdataRowContact (fromMaybe "FirstName" fn) (fromMaybe "LastName" ln) ou'
      where
282
        ou' = maybe "CNRS" (Text.intercalate " " . _cw_organization) (head ou)
283
  toHyperdataRow (HyperdataContact {}) =
284
    HyperdataRowContact "FirstName" "LastName" "Labs"