Merge branch 'dev' into dev-node-board-add-text-cells

src/Gargantext/API/Node/Contact.hs

@@ -55,8 +55,8 @@ type API = "contact" :> Summary "Contact endpoint"
 
 
 api :: UserId -> CorpusId -> GargServer API
-api uid cid =  (api_async   (RootId (NodeId uid)) cid)
-          :<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) uid cid)
+api uid cid =  (api_async   (RootId (NodeId                   uid)) cid)
+          :<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) uid   cid)
 
 type API_Async = AsyncJobs JobLog '[JSON] AddContactParams JobLog
 ------------------------------------------------------------------------

src/Gargantext/API/Routes.hs

@@ -95,10 +95,12 @@ type GargPrivateAPI' =
                            :> Capture "node_id" NodeId
                            :> NodeAPI HyperdataAny
 
+--{-
            -- Corpus endpoints
            :<|> "corpus"   :> Summary "Corpus endpoint"
                            :> Capture "corpus_id" CorpusId
                            :> NodeAPI HyperdataCorpus
+--}
 
            :<|> "corpus"   :> Summary "Corpus endpoint"
                            :> Capture "node1_id" NodeId
@@ -110,6 +112,12 @@ type GargPrivateAPI' =
                            :> Export.API
 
            -- Annuaire endpoint
+{-
+           :<|> "contact"  :> Summary "Contact endpoint"
+                           :> Capture "contact_id" ContactId
+                           :> NodeAPI HyperdataContact
+--}
+
            :<|> "annuaire" :> Summary "Annuaire endpoint"
                            :> Capture "annuaire_id" AnnuaireId
                            :> NodeAPI HyperdataAnnuaire
@@ -117,7 +125,6 @@ type GargPrivateAPI' =
            :<|> "annuaire" :> Summary "Contact endpoint"
                            :> Capture "annuaire_id" NodeId
                            :> Contact.API
-
            -- Document endpoint
            :<|> "document" :> Summary "Document endpoint"
                            :> Capture "doc_id" DocId
@@ -158,11 +165,11 @@ type GargPrivateAPI' =
            :<|> "lists"  :> Summary "List export API"
                          :> Capture "listId" ListId
                          :> List.API
-
+{-
            :<|> "wait"   :> Summary "Wait test"
                          :> Capture "x" Int
                          :> WaitAPI -- Get '[JSON] Int
-
+-}
 -- /mv/<id>/<id>
 -- /merge/<id>/<id>
 -- /rename/<id>
@@ -207,6 +214,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
      :<|> nodeAPI     (Proxy :: Proxy HyperdataCorpus)   uid
      :<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny)      uid
      :<|> Export.getCorpus   -- uid
+ --    :<|> nodeAPI     (Proxy :: Proxy HyperdataContact)  uid
      :<|> nodeAPI     (Proxy :: Proxy HyperdataAnnuaire) uid
      :<|> Contact.api uid
 
@@ -232,7 +240,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
      -- :<|> New.api  uid -- TODO-SECURITY
      -- :<|> New.info uid -- TODO-SECURITY
      :<|> List.api
-     :<|> waitAPI
+--     :<|> waitAPI
 
 
 ----------------------------------------------------------------------

src/Gargantext/API/Search.hs

@@ -10,8 +10,6 @@ Portability : POSIX
 Count API part of Gargantext.
 -}
 
-
-
 {-# LANGUAGE TemplateHaskell    #-}
 {-# LANGUAGE TypeOperators      #-}
 {-# LANGUAGE DeriveAnyClass     #-}
@@ -27,15 +25,17 @@ 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.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
@@ -47,16 +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
   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 <$> map toRow <$> 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
 
 -----------------------------------------------------------------------
@@ -105,8 +114,7 @@ instance Arbitrary SearchQuery where
   -- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
 -----------------------------------------------------------------------
 data SearchResult =
-  SearchResult { result :: !SearchResultTypes
-              }
+  SearchResult { result :: !SearchResultTypes}
   | SearchResultErr !Text
     deriving (Generic)
 
@@ -167,6 +175,7 @@ data Row =
              , c_created    :: !UTCTime
              , c_hyperdata  :: !HyperdataRow
              , c_score      :: !Int
+             , c_annuaireId :: !NodeId
              }
   deriving (Generic)
 
@@ -188,16 +197,17 @@ instance ToSchema Row where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
 
 class ToRow a where
-  toRow :: a -> Row
+  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)
+  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 (FacetPaired nId utc h s) = Contact nId utc (toHyperdataRow h) s
+  toRow annuaireId (FacetPaired nId utc h s) = Contact nId utc (toHyperdataRow h) s annuaireId
 
 
 --------------------------------------------------------------------
@@ -281,5 +291,9 @@ instance ToHyperdataRow HyperdataDocument where
       (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"
+  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"

src/Gargantext/Core/Ext/IMTUser.hs

@@ -13,72 +13,138 @@ Here is writtent a common interface.
 -}
 
 
-module Gargantext.Core.Ext.IMTUser (deserialiseImtUsersFromFile)
+module Gargantext.Core.Ext.IMTUser -- (deserialiseImtUsersFromFile)
   where
 
 import Codec.Serialise
+import Data.Csv
+import Data.Either
 import Data.Maybe (catMaybes)
 import Data.Text (Text)
+import Data.Vector (Vector)
 import GHC.Generics (Generic)
+import Gargantext.Core.Text.Corpus.Parsers.CSV
 import Gargantext.Database.Admin.Types.Hyperdata.Contact
 import Gargantext.Prelude
+import System.FilePath.Posix (takeExtension)
 import System.IO (FilePath)
-import qualified Data.ByteString.Lazy as BSL
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Vector          as Vector
 
 ------------------------------------------------------------------------
+readFile_Annuaire :: FilePath -> IO [HyperdataContact]
+readFile_Annuaire fp = case takeExtension fp of
+    ".csv"  -> readCSVFile_Annuaire fp
+    ".data" -> deserialiseImtUsersFromFile fp
+    _       -> panic "[G.C.E.I.readFile_Annuaire] extension unknown"
 
-instance Serialise IMTUser
-
-deserialiseImtUsersFromFile :: FilePath -> IO [HyperdataContact]
-deserialiseImtUsersFromFile filepath = map imtUser2gargContact <$> deserialiseFromFile' filepath
-
-deserialiseFromFile' :: FilePath -> IO [IMTUser]
-deserialiseFromFile' filepath = deserialise <$> BSL.readFile filepath
-
+------------------------------------------------------------------------
 data IMTUser = IMTUser
-  { id        :: Text
-  , entite    :: Maybe Text
-  , mail      :: Maybe Text
-  , nom       :: Maybe Text
-  , prenom    :: Maybe Text
-  , fonction  :: Maybe Text
-  , tel       :: Maybe Text
-  , fax       :: Maybe Text
-  , service   :: Maybe Text
-  , groupe    :: Maybe Text
-  , bureau    :: Maybe Text
-  , url       :: Maybe Text
-  , pservice  :: Maybe Text
-  , pfonction :: Maybe Text
-  , afonction :: Maybe Text
-  , grprech   :: Maybe Text
-  , lieu      :: Maybe Text
+  { id         :: Maybe Text
+  , entite     :: Maybe Text
+  , mail       :: Maybe Text
+  , nom        :: Maybe Text
+  , prenom     :: Maybe Text
+  , fonction   :: Maybe Text
+  , fonction2  :: Maybe Text
+  , tel        :: Maybe Text
+  , fax        :: Maybe Text
+  , service    :: Maybe Text
+  , groupe     :: Maybe Text
+  , entite2    :: Maybe Text
+  , service2   :: Maybe Text
+  , groupe2    :: Maybe Text
+  , bureau     :: Maybe Text
+  , url        :: Maybe Text
+  , pservice   :: Maybe Text
+  , pfonction  :: Maybe Text
+  , afonction  :: Maybe Text
+  , afonction2 :: Maybe Text
+  , grprech      :: Maybe Text
+  , appellation  :: Maybe Text
+  , lieu         :: Maybe Text
   , aprecision   :: Maybe Text
   , atel         :: Maybe Text
   , sexe         :: Maybe Text
   , statut       :: Maybe Text
   , idutilentite :: Maybe Text
-  , entite2  :: Maybe Text
-  , service2 :: Maybe Text
-  , groupe2  :: Maybe Text
-  , actif    :: Maybe Text
+  , actif             :: Maybe Text
   , idutilsiecoles    :: Maybe Text
   , date_modification :: Maybe Text
   } deriving (Eq, Show, Generic)
 
+-- | CSV instance
+instance FromNamedRecord IMTUser where
+  parseNamedRecord r = IMTUser <$> r .: "id"
+                               <*> r .: "entite"
+                               <*> r .: "mail"
+                               <*> r .: "nom"
+                               <*> r .: "prenom"
+                               <*> r .: "fonction"
+                               <*> r .: "fonction2"
+                               <*> r .: "tel"
+                               <*> r .: "fax"
+                               <*> r .: "service"
+                               <*> r .: "groupe"
+                               <*> r .: "entite2"
+                               <*> r .: "service2"
+                               <*> r .: "groupe2"
+                               <*> r .: "bureau"
+                               <*> r .: "url"
+                               <*> r .: "pservice"
+                               <*> r .: "pfonction"
+                               <*> r .: "afonction"
+                               <*> r .: "afonction2"
+                               <*> r .: "grprech"
+                               <*> r .: "appellation"
+                               <*> r .: "lieu"
+                               <*> r .: "aprecision"
+                               <*> r .: "atel"
+                               <*> r .: "sexe"
+                               <*> r .: "statut"
+                               <*> r .: "idutilentite"
+                               <*> r .: "actif"
+                               <*> r .: "idutilsiecoles"
+                               <*> r .: "date_modification"
+
+headerCSVannuaire :: Header
+headerCSVannuaire =
+  header ["id","entite","mail","nom","prenom","fonction","fonction2","tel","fax","service","groupe","entite2","service2","groupe2","bureau","url","pservice","pfonction","afonction","afonction2","grprech","appellation","lieu","aprecision","atel","sexe","statut","idutilentite","actif","idutilsiecoles","date_modification"]
+
+
+readCSVFile_Annuaire :: FilePath -> IO [HyperdataContact]
+readCSVFile_Annuaire fp = do
+  users <- snd <$> readCSVFile_Annuaire' fp
+  pure $ map imtUser2gargContact $ Vector.toList users
+
+readCSVFile_Annuaire' :: FilePath -> IO (Header, Vector IMTUser)
+readCSVFile_Annuaire' = fmap readCsvHalLazyBS' . BL.readFile
+  where
+    readCsvHalLazyBS' :: BL.ByteString -> (Header, Vector IMTUser)
+    readCsvHalLazyBS' bs = case decodeByNameWith csvDecodeOptions bs of
+          Left  e    -> panic (cs e)
+          Right rows -> rows
+
+------------------------------------------------------------------------
+-- | Serialization for optimization
+instance Serialise IMTUser
+deserialiseImtUsersFromFile :: FilePath -> IO [HyperdataContact]
+deserialiseImtUsersFromFile filepath = map imtUser2gargContact <$> deserialiseFromFile' filepath
+
+deserialiseFromFile' :: FilePath -> IO [IMTUser]
+deserialiseFromFile' filepath = deserialise <$> BL.readFile filepath
+
+------------------------------------------------------------------------
 imtUser2gargContact :: IMTUser -> HyperdataContact
-imtUser2gargContact (IMTUser id' entite' mail' nom' prenom' fonction' tel' _fax'
-                     service' _groupe' bureau' url' _pservice' _pfonction' _afonction'
-                     _grprech' lieu' _aprecision' _atel' _sexe' _statut' _idutilentite'
-                     _entite2' _service2' _group2' _actif' _idutilsiecoles' date_modification')
+imtUser2gargContact (IMTUser id' entite' mail' nom' prenom' fonction' _fonction2' tel' _fax'
+                     service' _groupe' _entite2 _service2 _group2 bureau' url' _pservice' _pfonction' _afonction' _afonction2'
+                     _grprech' _appellation' lieu' _aprecision' _atel' _sexe' _statut' _idutilentite'
+                     _actif' _idutilsiecoles' date_modification')
                   = HyperdataContact (Just "IMT Annuaire") (Just qui) [ou] ((<>) <$> (fmap (\p -> p <> " ") prenom') <*> nom') entite' date_modification' Nothing Nothing
                     where
-                      qui = ContactWho (Just id') prenom' nom' (catMaybes [service']) []
+                      qui = ContactWho id' prenom' nom' (catMaybes [service']) []
                       ou  = ContactWhere (toList entite') (toList service') fonction' bureau' (Just "France") lieu' contact Nothing Nothing
                       contact = Just $ ContactTouch mail' tel' url'
                       -- meta    = ContactMetaData (Just "IMT annuaire") date_modification'
                       toList Nothing  = []
                       toList (Just x) = [x]
-                             
-
-

src/Gargantext/Core/Text/Corpus/Parsers/CSV.hs

@@ -34,7 +34,8 @@ import Gargantext.Core.Text.Context
 
 ---------------------------------------------------------------
 headerCsvGargV3 :: Header
-headerCsvGargV3 = header [ "title"
+headerCsvGargV3 =
+  header [ "title"
          , "source"
          , "publication_year"
          , "publication_month"
@@ -44,9 +45,9 @@ headerCsvGargV3 = header [ "title"
          ]
 ---------------------------------------------------------------
 data CsvGargV3 = CsvGargV3
-    { d_docId  :: !Int
-    , d_title  :: !Text
-    , d_source :: !Text
+    { d_docId             :: !Int
+    , d_title             :: !Text
+    , d_source            :: !Text
     , d_publication_year  :: !Int
     , d_publication_month :: !Int
     , d_publication_day   :: !Int
@@ -115,14 +116,14 @@ splitDoc m splt doc = let docSize = (length $ csv_abstract doc) in
         where
           firstDoc = CsvDoc t s py pm pd firstAbstract auth
           firstAbstract = head' "splitDoc'1" abstracts
-          
+
           nextDocs = map (\txt -> CsvDoc
                                     (head' "splitDoc'2" $ sentences txt)
                                     s py pm pd 
                                     (unsentences $ tail' "splitDoc'1" $ sentences txt)
                                     auth
                           ) (tail' "splitDoc'2" abstracts)
-          
+
           abstracts    = (splitBy $ contextSize) abst
 
 ---------------------------------------------------------------
@@ -226,7 +227,6 @@ readCsvLazyBS bs = case decodeByNameWith csvDecodeOptions bs of
       Right csvDocs -> csvDocs
 
 ------------------------------------------------------------------------
-
 -- | TODO use readFileLazy
 readCsvHal :: FilePath -> IO (Header, Vector CsvHal)
 readCsvHal = fmap readCsvHalLazyBS . BL.readFile
@@ -307,11 +307,11 @@ instance ToNamedRecord CsvHal where
   toNamedRecord (CsvHal t s py  pm pd abst aut  url isbn iss j lang  doi auth inst dept lab team doct) = 
     namedRecord [ "title"  .= t
                 , "source" .= s
-                
+
                 , "publication_year"  .= py
                 , "publication_month" .= pm
                 , "publication_day"   .= pd
-                
+
                 , "abstract"          .= abst
                 , "authors"           .= aut
 
@@ -320,13 +320,13 @@ instance ToNamedRecord CsvHal where
                 , "issue_s"            .= iss
                 , "journalPublisher_s" .= j
                 , "language_s"         .= lang
-                
+
                 , "doiId_s"            .= doi
                 , "authId_i"           .= auth
                 , "instStructId_i"     .= inst
                 , "deptStructId_i"     .= dept
                 , "labStructId_i"      .= lab
-                
+ 
                 , "rteamStructId_i"    .= team
                 , "docType_s"          .= doct
                ]
@@ -389,7 +389,6 @@ parseHal' :: BL.ByteString -> [HyperdataDocument]
 parseHal' = V.toList . V.map csvHal2doc . snd . readCsvHalLazyBS 
 
 ------------------------------------------------------------------------
-
 parseCsv :: FilePath -> IO [HyperdataDocument]
 parseCsv fp = V.toList <$> V.map csv2doc <$> snd <$> readFile fp
 

src/Gargantext/Database/Action/Flow.hs

@@ -66,7 +66,7 @@ import qualified Data.Map as Map
 
 import Gargantext.Core (Lang(..), PosTagAlgo(..))
 import Gargantext.Core.Ext.IMT (toSchoolName)
-import Gargantext.Core.Ext.IMTUser (deserialiseImtUsersFromFile)
+import Gargantext.Core.Ext.IMTUser (readFile_Annuaire)
 import Gargantext.Core.Flow.Types
 import Gargantext.Core.Text
 import Gargantext.Core.Text.List.Group.WithStem ({-StopSize(..),-} GroupParams(..))
@@ -166,7 +166,7 @@ flowAnnuaire :: (FlowCmdM env err m)
              -> FilePath
              -> m AnnuaireId
 flowAnnuaire u n l filePath = do
-  docs <- liftBase $ (( splitEvery 500 <$> deserialiseImtUsersFromFile filePath) :: IO [[HyperdataContact]])
+  docs <- liftBase $ (( splitEvery 500 <$> readFile_Annuaire filePath) :: IO [[HyperdataContact]])
   flow (Nothing :: Maybe HyperdataAnnuaire) u n l docs
 
 ------------------------------------------------------------------------

src/Gargantext/Database/Query/Facet.hs

@@ -232,13 +232,23 @@ instance Arbitrary OrderBy
 -- TODO-SECURITY check
 
 --{-
-runViewAuthorsDoc :: HasDBid NodeType => ContactId -> IsTrash -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err [FacetDoc]
+runViewAuthorsDoc :: HasDBid NodeType
+                  => ContactId
+                  -> IsTrash
+                  -> Maybe Offset
+                  -> Maybe Limit
+                  -> Maybe OrderBy
+                  -> Cmd err [FacetDoc]
 runViewAuthorsDoc cId t o l order = runOpaQuery $ filterWith o l order $ viewAuthorsDoc cId t ntId
   where
     ntId = NodeDocument
 
 -- TODO add delete ?
-viewAuthorsDoc :: HasDBid NodeType => ContactId -> IsTrash -> NodeType -> Query FacetDocRead
+viewAuthorsDoc :: HasDBid NodeType
+               => ContactId
+               -> IsTrash
+               -> NodeType
+               -> Query FacetDocRead
 viewAuthorsDoc cId _ nt = proc () -> do
   (doc,(_,(_,(_,contact')))) <- queryAuthorsDoc      -< ()