[FEAT] Adding Visio micro-service (Jitsi)
[gargantext.git] / src / Gargantext / API / Search.hs
index bedc35fb645139eda379cf10bf513063011ef543..4c175a005934fddd20798dbc841ba45876df7253 100644 (file)
@@ -10,8 +10,6 @@ Portability : POSIX
 Count API part of Gargantext.
 -}
 
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-
 {-# LANGUAGE TemplateHaskell    #-}
 {-# LANGUAGE TypeOperators      #-}
 {-# LANGUAGE DeriveAnyClass     #-}
@@ -21,22 +19,23 @@ module Gargantext.API.Search
 
 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
@@ -48,15 +47,25 @@ type API results = Summary "Search endpoint"
                  :> 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
 
 -----------------------------------------------------------------------
@@ -104,10 +113,8 @@ instance Arbitrary SearchQuery where
   arbitrary = elements [SearchQuery ["electrodes"] SearchDoc]
   -- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
 -----------------------------------------------------------------------
-
 data SearchResult =
-  SearchResult { result :: !SearchResultTypes
-              }
+  SearchResult { result :: !SearchResultTypes}
   | SearchResultErr !Text
     deriving (Generic)
 
@@ -130,7 +137,7 @@ instance Arbitrary SearchResult where
 
 
 data SearchResultTypes = SearchResultDoc { docs     :: ![Row]}
-                  | SearchResultContact  { contacts :: ![FacetPaired Int UTCTime HyperdataContact Int] }
+                  | SearchResultContact  { contacts :: ![Row] }
                   | SearchNoResult      { message  :: !Text }
 
   deriving (Generic)
@@ -164,16 +171,20 @@ data Row =
            , 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
@@ -185,11 +196,21 @@ instance Arbitrary 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
@@ -211,7 +232,10 @@ data HyperdataRow =
                        , _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
@@ -240,26 +264,36 @@ instance Arbitrary HyperdataRow where
 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"