Count API part of Gargantext.
-}
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveAnyClass #-}
import Data.Aeson
import Data.Maybe (fromMaybe)
-import Data.Swagger hiding (fieldLabelModifier)
+import Data.Swagger hiding (fieldLabelModifier, Contact)
import Data.Text (Text)
import Data.Time (UTCTime)
import GHC.Generics (Generic)
import Gargantext.API.Prelude (GargServer)
import Gargantext.Core.Utils.Prefix (unPrefixSwagger, unCapitalize, dropPrefix)
-import Gargantext.Database.Query.Facet
-import Gargantext.Database.Action.Search
import Gargantext.Database.Action.Flow.Pairing (isPairedWith)
-import Gargantext.Database.Admin.Types.Hyperdata (HyperdataContact, HyperdataDocument(..))
+import Gargantext.Database.Action.Search
+import Gargantext.Database.Admin.Types.Hyperdata (HyperdataContact(..), HyperdataDocument(..), ContactWho(..))
+import Gargantext.Database.Admin.Types.Hyperdata.Contact (_cw_organization)
import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Query.Facet
import Gargantext.Prelude
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
-
+import qualified Data.Text as Text
-----------------------------------------------------------------------
-- TODO-ACCESS: CanSearch? or is it part of CanGetNode
:> QueryParam "order" OrderBy
:> Post '[JSON] results
-----------------------------------------------------------------------
+-- | Api search function
api :: NodeId -> GargServer (API SearchResult)
+
api nId (SearchQuery q SearchDoc) o l order =
- SearchResult <$> SearchResultDoc <$> map toRow <$> searchInCorpus nId False q o l order
+ SearchResult <$> SearchResultDoc
+ <$> map (toRow nId)
+ <$> searchInCorpus nId False q o l order
+
api nId (SearchQuery q SearchContact) o l order = do
- aIds <- isPairedWith NodeAnnuaire nId
+ printDebug "isPairedWith" nId
+ aIds <- isPairedWith nId NodeAnnuaire
-- TODO if paired with several corpus
case head aIds of
- Nothing -> pure $ SearchResult $ SearchNoResult "[G.A.Search] pair corpus with an Annuaire"
- Just aId -> SearchResult <$> SearchResultContact <$> searchInCorpusWithContacts nId aId q o l order
+ Nothing -> pure $ SearchResult
+ $ SearchNoResult "[G.A.Search] pair corpus with an Annuaire"
+ Just aId -> SearchResult
+ <$> SearchResultContact
+ <$> map (toRow aId)
+ <$> searchInCorpusWithContacts nId aId q o l order
api _ _ _ _ _ = undefined
-----------------------------------------------------------------------
arbitrary = elements [SearchQuery ["electrodes"] SearchDoc]
-- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
-----------------------------------------------------------------------
-
data SearchResult =
- SearchResult { result :: !SearchResultTypes
- }
+ SearchResult { result :: !SearchResultTypes}
| SearchResultErr !Text
deriving (Generic)
data SearchResultTypes = SearchResultDoc { docs :: ![Row]}
- | SearchResultContact { contacts :: ![FacetPaired Int UTCTime HyperdataContact Int] }
+ | SearchResultContact { contacts :: ![Row] }
| SearchNoResult { message :: !Text }
deriving (Generic)
, category :: !Int
, score :: !Int
}
- | Contact { c_id :: !Int
- , c_created :: !Text
- , c_hyperdata :: !HyperdataContact
- , c_score :: !Int
- }
+ | Contact { c_id :: !Int
+ , c_created :: !UTCTime
+ , c_hyperdata :: !HyperdataRow
+ , c_score :: !Int
+ , c_annuaireId :: !NodeId
+ }
deriving (Generic)
instance FromJSON Row
where
- parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+ parseJSON = genericParseJSON
+ ( defaultOptions { sumEncoding = ObjectWithSingleField
+ }
+ )
instance ToJSON Row
where
instance ToSchema Row where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
-toRow :: FacetDoc -> Row
-toRow (FacetDoc nId utc t h mc md) = Document nId utc t (toHyperdataRow h) (fromMaybe 0 mc) (round $ fromMaybe 0 md)
+class ToRow a where
+ toRow :: NodeId -> a -> Row
---------------------------------------------------------------------
+instance ToRow FacetDoc where
+ toRow _ (FacetDoc nId utc t h mc _md sc) =
+ Document nId utc t (toHyperdataRow h) (fromMaybe 0 mc) (round $ fromMaybe 0 sc)
+
+-- | TODO rename FacetPaired
+type FacetContact = FacetPaired Int UTCTime HyperdataContact Int
+
+instance ToRow FacetContact where
+ toRow annuaireId (FacetPaired nId utc h s) = Contact nId utc (toHyperdataRow h) s annuaireId
+
+--------------------------------------------------------------------
data HyperdataRow =
HyperdataRowDocument { _hr_bdd :: !Text
, _hr_doi :: !Text
, _hr_publication_second :: !Int
, _hr_language_iso2 :: !Text
}
- | HyperdataRowContact { _hr_name :: !Text }
+ | HyperdataRowContact { _hr_firstname :: !Text
+ , _hr_lastname :: !Text
+ , _hr_labs :: !Text
+ }
deriving (Generic)
instance FromJSON HyperdataRow
instance ToSchema HyperdataRow where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hr_")
-toHyperdataRow :: HyperdataDocument -> HyperdataRow
-toHyperdataRow (HyperdataDocument b d u ui ub p t a i s abs pd py pm pda ph pmin psec l) =
- HyperdataRowDocument
- (fromMaybe "" b)
- (fromMaybe "" d)
- (fromMaybe "" u)
- (fromMaybe "" ui)
- (fromMaybe "" ub)
- (fromMaybe 0 p)
- (fromMaybe "Title" t)
- (fromMaybe "" a)
- (fromMaybe "" i)
- (fromMaybe "" s)
- (fromMaybe "" abs)
- (fromMaybe "" pd)
- (fromMaybe 2020 py)
- (fromMaybe 1 pm)
- (fromMaybe 1 pda)
- (fromMaybe 1 ph)
- (fromMaybe 1 pmin)
- (fromMaybe 1 psec)
- (fromMaybe "EN" l)
-
+class ToHyperdataRow a where
+ toHyperdataRow :: a -> HyperdataRow
+
+instance ToHyperdataRow HyperdataDocument where
+ toHyperdataRow (HyperdataDocument b d u ui ub p t a i s abs' pd py pm pda ph pmin psec l) =
+ HyperdataRowDocument
+ (fromMaybe "" b)
+ (fromMaybe "" d)
+ (fromMaybe "" u)
+ (fromMaybe "" ui)
+ (fromMaybe "" ub)
+ (fromMaybe 0 p)
+ (fromMaybe "Title" t)
+ (fromMaybe "" a)
+ (fromMaybe "" i)
+ (fromMaybe "" s)
+ (fromMaybe "" abs')
+ (fromMaybe "" pd)
+ (fromMaybe 2020 py)
+ (fromMaybe 1 pm)
+ (fromMaybe 1 pda)
+ (fromMaybe 1 ph)
+ (fromMaybe 1 pmin)
+ (fromMaybe 1 psec)
+ (fromMaybe "EN" l)
+
+instance ToHyperdataRow HyperdataContact where
+ toHyperdataRow (HyperdataContact _ (Just (ContactWho _ fn ln _ _)) ou _ _ _ _ _ ) =
+ HyperdataRowContact (fromMaybe "FirstName" fn) (fromMaybe "LastName" ln) ou'
+ where
+ ou' = maybe "CNRS" (Text.intercalate " " . _cw_organization) (head ou)
+ toHyperdataRow (HyperdataContact _ _ _ _ _ _ _ _ ) =
+ HyperdataRowContact "FirstName" "LastName" "Labs"