[API] Search Author / Contact ok

src/Gargantext/API/Node.hs

@@ -279,7 +279,6 @@ pairWith cId aId lId = do
   _ <- insertNodeNode [ NodeNode cId aId Nothing Nothing]
   pure r
 
-------------------------------------------------------------------------
 
 ------------------------------------------------------------------------
 type TreeAPI   = QueryParams "type" NodeType :> Get '[JSON] (Tree NodeTree)

src/Gargantext/API/Search.hs

@@ -21,7 +21,7 @@ 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)
@@ -30,14 +30,13 @@ 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.Admin.Types.Hyperdata (HyperdataContact(..), HyperdataDocument(..), ContactWho(..))
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Prelude
 import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 
-
 -----------------------------------------------------------------------
 -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
 -- TODO-EVENTS: No event, this is a read-only query.
@@ -52,11 +51,12 @@ api :: NodeId -> GargServer (API SearchResult)
 api nId (SearchQuery q SearchDoc) o l order =
   SearchResult <$> SearchResultDoc <$> map toRow <$> 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
+    Just aId -> SearchResult <$> SearchResultContact <$> map toRow <$> searchInCorpusWithContacts nId aId q o l order
 api _ _ _ _ _ = undefined
 
 -----------------------------------------------------------------------
@@ -104,7 +104,6 @@ instance Arbitrary SearchQuery where
   arbitrary = elements [SearchQuery ["electrodes"] SearchDoc]
   -- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
 -----------------------------------------------------------------------
-
 data SearchResult =
   SearchResult { result :: !SearchResultTypes
               }
@@ -130,7 +129,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 +163,19 @@ 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
+             }
   deriving (Generic)
 
 instance FromJSON  Row
   where
-    parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+    parseJSON = genericParseJSON 
+                 ( defaultOptions { sumEncoding = ObjectWithSingleField 
+                                  }
+                 )
 
 instance ToJSON  Row
   where
@@ -185,11 +187,20 @@ 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 :: a -> Row
 
---------------------------------------------------------------------
+instance ToRow FacetDoc where
+  toRow (FacetDoc nId utc t h mc md) = Document nId utc t (toHyperdataRow h) (fromMaybe 0 mc) (round $ fromMaybe 0 md)
 
+-- | TODO rename FacetPaired
+type FacetContact = FacetPaired Int UTCTime HyperdataContact Int
+
+instance ToRow FacetContact where
+  toRow (FacetPaired nId utc h s) = Contact nId utc (toHyperdataRow h) s
+
+
+--------------------------------------------------------------------
 data HyperdataRow =
   HyperdataRowDocument { _hr_bdd                :: !Text
                        , _hr_doi                :: !Text
@@ -211,7 +222,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 +254,32 @@ 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 _ _)) _ _ _ _ _ _ ) = HyperdataRowContact (fromMaybe "FN" fn) (fromMaybe "LN" ln) "Labs"
+  toHyperdataRow (HyperdataContact _ _ _ _ _ _ _ _ ) = HyperdataRowContact "FirstName" "LastName" "Labs"

src/Gargantext/Database/Action/Flow/Pairing.hs

@@ -36,6 +36,7 @@ import Gargantext.Database.Query.Prelude (leftJoin2, returnA, queryNodeNodeTable
 import Gargantext.Database.Query.Table.Node.Children (getAllContacts)
 import Gargantext.Database.Query.Table.Node.Select (selectNodesWithUsername)
 import Gargantext.Database.Query.Table.Node (defaultList)
+import Gargantext.Database.Query.Table.NodeNode (insertNodeNode)
 import Gargantext.Database.Schema.Ngrams -- (NgramsType(..))
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude hiding (sum)
@@ -50,8 +51,8 @@ import qualified Data.Text as DT
 -- | isPairedWith
 -- All NodeAnnuaire paired with a Corpus of NodeId nId:
 -- isPairedWith NodeAnnuaire corpusId
-isPairedWith :: NodeType -> NodeId -> Cmd err [NodeId]
-isPairedWith nt nId = runOpaQuery (selectQuery nt nId)
+isPairedWith :: NodeId -> NodeType -> Cmd err [NodeId]
+isPairedWith nId nt = runOpaQuery (selectQuery nt nId)
   where
     selectQuery :: NodeType -> NodeId -> Query (Column PGInt4)
     selectQuery nt' nId' = proc () -> do
@@ -72,7 +73,9 @@ pairing a c l' = do
     Nothing -> defaultList c
     Just l'' -> pure l''
   dataPaired <- dataPairing a (c,l,Authors) takeName takeName
-  insertDB $ prepareInsert dataPaired
+  r <- insertDB $ prepareInsert dataPaired
+  _ <- insertNodeNode [ NodeNode c a Nothing Nothing]
+  pure r
 
 
 dataPairing :: AnnuaireId