[Annuaire] Flow insertion ok, needs to fix API.

src/Gargantext/API/Ngrams.hs

@@ -69,7 +69,8 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
 ------------------------------------------------------------------------
 --data FacetFormat = Table | Chart
-data TabType   = Docs   | Terms  | Sources | Authors | Institutes | Trash
+data TabType   = Docs     | Terms  | Sources | Authors | Institutes | Trash
+               | Contacts
   deriving (Generic, Enum, Bounded)
 
 instance FromHttpApiData TabType
@@ -80,6 +81,9 @@ instance FromHttpApiData TabType
     parseUrlPiece "Institutes" = pure Institutes
     parseUrlPiece "Authors"    = pure Authors
     parseUrlPiece "Trash"      = pure Trash
+    
+    parseUrlPiece "Contacts"   = pure Contacts
+    
     parseUrlPiece _            = Left "Unexpected value of TabType"
 
 instance ToParamSchema   TabType

src/Gargantext/API/Node.hs

@@ -147,6 +147,7 @@ nodeAPI conn p id
               :<|> getChart      conn id
               :<|> favApi        conn id
               :<|> delDocs       conn id
+              -- Annuaire
               -- :<|> upload
               -- :<|> query
 ------------------------------------------------------------------------

src/Gargantext/Database/Flow.hs

@@ -28,7 +28,7 @@ import Gargantext.Core.Types (NodePoly(..), ListType(..), listTypeId)
 import Gargantext.Database.Bashql (runCmd') -- , del)
 import Gargantext.Database.Config (userMaster, userArbitrary, corpusMasterName)
 import Gargantext.Database.Ngrams (insertNgrams, Ngrams(..), NgramsT(..), NgramsIndexed(..), indexNgramsT, ngramsTypeId, NgramsType(..), text2ngrams)
-import Gargantext.Database.Node (getRoot, mkRoot, mkCorpus, Cmd(..), mkList, mkGraph, mkDashboard)--, mkAnnuaire)
+import Gargantext.Database.Node (getRoot, mkRoot, mkCorpus, Cmd(..), mkList, mkGraph, mkDashboard, mkAnnuaire)
 import Gargantext.Database.Types.Node (NodeType(..))
 import Gargantext.Database.Node.Document.Add    (add)
 import Gargantext.Database.Node.Document.Insert (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..))
@@ -38,6 +38,7 @@ import Gargantext.Database.Types.Node (HyperdataDocument(..))
 import Gargantext.Database.Node.Contact (HyperdataContact(..))
 import Gargantext.Database.User (getUser, UserLight(..), Username)
 import Gargantext.Ext.IMT (toSchoolName)
+import Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile)
 import Gargantext.Prelude
 import Gargantext.Text.Parsers (parseDocs, FileFormat)
 
@@ -46,7 +47,7 @@ type MasterUserId = Int
 
 type RootId   = Int
 type CorpusId = Int
-
+type MasterCorpusId = Int
 
 flowDatabase :: FileFormat -> FilePath -> CorpusName -> IO CorpusId
 flowDatabase ff fp cName = do
@@ -57,7 +58,7 @@ flowDatabase ff fp cName = do
 
 
 flowInsert :: NodeType -> [HyperdataDocument] -> CorpusName
-     -> IO ([ReturnId], MasterUserId, UserId, CorpusId)
+     -> IO ([ReturnId], MasterUserId, MasterCorpusId, UserId, CorpusId)
 flowInsert nt hyperdataDocuments cName = do
   let hyperdataDocuments' = case nt of
         NodeCorpus   -> map (\h -> ToDbDocument h) hyperdataDocuments
@@ -69,7 +70,12 @@ flowInsert nt hyperdataDocuments cName = do
   (userId, _, userCorpusId) <- subFlowCorpus userArbitrary cName
   _ <- runCmd' $ add userCorpusId (map reId ids)
   
-  pure (ids, masterUserId, userId, userCorpusId)
+  pure (ids, masterUserId, masterCorpusId, userId, userCorpusId)
+
+flowAnnuaire filePath = do
+  contacts <- deserialiseImtUsersFromFile filePath
+  ps <- flowInsertAnnuaire "Annuaire" $ take 10 $ map (\h-> ToDbContact h) $ map addUniqIdsContact contacts 
+  printDebug "length annuaire" (ps)
 
 --{-
 flowInsertAnnuaire name children = do
@@ -77,19 +83,19 @@ flowInsertAnnuaire name children = do
   (masterUserId, _, masterCorpusId) <- subFlowCorpus userMaster corpusMasterName
   ids  <- runCmd' $ insertDocuments masterUserId masterCorpusId children
   
-  (userId, _, userCorpusId) <- subFlowCorpus userArbitrary name
+  (userId, _, userCorpusId) <- subFlowAnnuaire userArbitrary name
   _ <- runCmd' $ add userCorpusId (map reId ids)
   
   printDebug "AnnuaireID" userCorpusId
 
-  pure (ids, masterUserId, userId, userCorpusId)
+  pure (ids, masterUserId, masterCorpusId, userId, userCorpusId)
 
 
 --}
 
 --{-
 -- flowCorpus :: NodeType -> [HyperdataDocument] -> ([ReturnId],MasterUserId,UserId,CorpusId) -> IO CorpusId
-flowCorpus NodeCorpus hyperdataDocuments (ids,masterUserId,userId,userCorpusId) = do
+flowCorpus NodeCorpus hyperdataDocuments (ids,masterUserId,masterCorpusId, userId,userCorpusId) = do
 --}
 --------------------------------------------------
   -- List Ngrams Flow
@@ -107,7 +113,7 @@ flowCorpus NodeCorpus hyperdataDocuments (ids,masterUserId,userId,userCorpusId)
   -- printDebug "inserted ngrams" indexedNgrams
   _             <- runCmd' $ insertToNodeNgrams indexedNgrams
   
-  listId2    <- runCmd' $ listFlow masterUserId userCorpusId indexedNgrams
+  listId2    <- runCmd' $ listFlow masterUserId masterCorpusId indexedNgrams
   printDebug "Working on ListId : " listId2
   --}
 
@@ -121,7 +127,7 @@ flowCorpus NodeCorpus hyperdataDocuments (ids,masterUserId,userId,userCorpusId)
   pure userCorpusId
   -- runCmd' $ del [corpusId2, corpusId]
 
-flowCorpus NodeAnnuaire _hyperdataDocuments (_ids,_masterUserId,_userId,_userCorpusId) = undefined
+flowCorpus NodeAnnuaire _hyperdataDocuments (_ids,_masterUserId,_masterCorpusId,_userId,_userCorpusId) = undefined
 flowCorpus _ _ _ = undefined
 
 
@@ -152,6 +158,34 @@ subFlowCorpus username cName = do
               (username, userId, rootId, corpusId)
   pure (userId, rootId, corpusId)
 
+
+subFlowAnnuaire :: Username -> CorpusName -> IO (UserId, RootId, CorpusId)
+subFlowAnnuaire username cName = do
+  maybeUserId <- runCmd' (getUser username)
+
+  let userId = case maybeUserId of
+        Nothing   -> panic "Error: User does not exist (yet)"
+        -- mk NodeUser gargantua_id "Node Gargantua"
+        Just user -> userLight_id user
+
+  rootId' <- map _node_id <$> runCmd' (getRoot userId)
+
+  rootId'' <- case rootId' of
+        []  -> runCmd' (mkRoot username userId)
+        n   -> case length n >= 2 of
+            True  -> panic "Error: more than 1 userNode / user"
+            False -> pure rootId'
+  let rootId = maybe (panic "error rootId") identity (head rootId'')
+
+  corpusId' <- runCmd' $ mkAnnuaire rootId userId
+  let corpusId = maybe (panic "error corpusId") identity (head corpusId')
+
+  printDebug "(username, userId, rootId, corpusId)"
+              (username, userId, rootId, corpusId)
+  pure (userId, rootId, corpusId)
+
+
+
 ------------------------------------------------------------------------
 
 type HashId   = Text

src/Gargantext/Database/Node/Contact.hs

@@ -41,19 +41,20 @@ data HyperdataContact =
      HyperdataContact { _hc_who      :: Maybe ContactWho
                       , _hc_where    :: Maybe [ContactWhere]
                       , _hc_metaData :: Maybe ContactMetaData
+                      , _hc_uniqId    :: Maybe Text
+                      , _hc_uniqIdBdd :: Maybe Text
 
   } deriving (Eq, Show, Generic)
 
 data ContactMetaData =
      ContactMetaData { _cm_bdd :: Maybe Text
                      , _cm_lastValidation  :: Maybe Text
-                     , _cm_uniqIdBdd       :: Maybe Text
-                     , _cm_uniqId          :: Maybe Text
   } deriving (Eq, Show, Generic)
 
 
 arbitraryHyperdataContact :: HyperdataContact
 arbitraryHyperdataContact = HyperdataContact Nothing Nothing Nothing
+                                             Nothing Nothing
 
 data ContactWho = 
      ContactWho { _cw_id          :: Maybe Text

src/Gargantext/Database/Node/Document/Insert.hs

@@ -212,7 +212,7 @@ instance ToRow InputData where
 
 addUniqIdsDoc :: HyperdataDocument -> HyperdataDocument
 addUniqIdsDoc doc = set hyperdataDocument_uniqIdBdd (Just hashBdd)
-               $ set hyperdataDocument_uniqId    (Just hash) doc
+                  $ set hyperdataDocument_uniqId    (Just hash) doc
   where
     hash    = uniqId $ DT.concat $ map ($ doc) hashParametersDoc
     hashBdd = uniqId $ DT.concat $ map ($ doc) ([(\d -> maybe' (_hyperdataDocument_bdd d))] <> hashParametersDoc)
@@ -231,8 +231,8 @@ hashParametersDoc = [ \d -> maybe' (_hyperdataDocument_title    d)
 -- * Uniqueness of document definition
 -- TODO factorize with above (use the function below for tests)
 addUniqIdsContact :: HyperdataContact -> HyperdataContact
-addUniqIdsContact hc = set  (hc_metaData . _Just . cm_uniqIdBdd . _Just) hashBdd
-                      $ set (hc_metaData . _Just . cm_uniqId    . _Just) hash    hc
+addUniqIdsContact hc = set (hc_uniqIdBdd) (Just hashBdd)
+                     $ set (hc_uniqId)    (Just hash)    hc
   where
     hash    = uniqId $ DT.concat $ map ($ hc) hashParametersContact
     hashBdd = uniqId $ DT.concat $ map ($ hc) ([\d -> maybe' (view (hc_metaData . _Just . cm_bdd) d)] <> hashParametersContact)

src/Gargantext/Ext/IMTUser.hs

@@ -77,12 +77,12 @@ 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')
-                  = HyperdataContact (Just qui) (Just [ou]) (Just meta)
+                  = HyperdataContact (Just qui) (Just [ou]) (Just meta) Nothing Nothing
                     where
                       qui = ContactWho (Just id') prenom' nom' (Just $ catMaybes [service']) Nothing
                       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' Nothing Nothing
+                      meta    = ContactMetaData (Just "IMT annuaire") date_modification'
                       toList Nothing  = Nothing
                       toList (Just x) = Just [x]