[ANNUAIRE] Contact type and mkAnnuaire function.

package.yaml

@@ -39,6 +39,7 @@ library:
   - Gargantext.Database.Bashql
   - Gargantext.Database.Node.Document.Insert
   - Gargantext.Database.Node.Document.Add
+  - Gargantext.Database.Node.Contact
   - Gargantext.Database.Types.Node
   - Gargantext.Database.User
   - Gargantext.Database.Cooc

src/Gargantext/Database/Flow.hs

@@ -8,14 +8,6 @@ Stability   : experimental
 Portability : POSIX
 
 
-Map (NgramsId, NodeId) -> insert
-data NgramsType = Sources | Authors | Terms
-nodes_ngrams : column type, column list
-
-documents
-sources
-authors
-
 -}
 
 {-# LANGUAGE DeriveGeneric     #-}
@@ -36,7 +28,7 @@ import qualified Data.Map as DM
 import Gargantext.Core.Types (NodePoly(..), ListType(..), listTypeId)
 import Gargantext.Database.Bashql (runCmd') -- , del)
 import Gargantext.Database.Ngrams (insertNgrams, Ngrams(..), NgramsT(..), NgramsIndexed(..), indexNgramsT, ngramsTypeId, NgramsType(..), text2ngrams)
-import Gargantext.Database.Node (getRoot, mkRoot, mkCorpus, Cmd(..), mkList, mkGraph, mkDashboard)
+import Gargantext.Database.Node (getRoot, mkRoot, mkCorpus, Cmd(..), mkList, mkGraph, mkDashboard, mkAnnuaire)
 import Gargantext.Database.Node.Document.Add    (add)
 import Gargantext.Database.Node.Document.Insert (insertDocuments, ReturnId(..), addUniqIds)
 import Gargantext.Database.NodeNgram (NodeNgramPoly(..), insertNodeNgrams)
@@ -56,12 +48,12 @@ flowDatabase :: FileFormat -> FilePath -> CorpusName -> IO Int
 flowDatabase ff fp cName = do
   
   -- Corus Flow
-  (masterUserId, _, corpusId) <- subFlow userMaster corpusMasterName
+  (masterUserId, _, corpusId) <- subFlowCorpus userMaster corpusMasterName
 
   -- Documents Flow
   hyperdataDocuments <- map addUniqIds <$> parseDocs ff fp
 
-  --printDebug "hyperdataDocuments" hyperdataDocuments
+  printDebug "hyperdataDocuments" hyperdataDocuments
 
   ids  <- runCmd' $ insertDocuments masterUserId corpusId hyperdataDocuments
   --printDebug "Docs IDs : " (ids)
@@ -70,14 +62,14 @@ flowDatabase ff fp cName = do
 
   -- Ngrams Flow
   -- todo: flow for new documents only
-  -- let tids = toInserted ids
-  --printDebug "toInserted ids" (length tids, tids)
+  let tids = toInserted ids
+  printDebug "toInserted ids" (length tids, tids)
 
-  -- let tihs = toInsert hyperdataDocuments
-  --printDebug "toInsert hyperdataDocuments" (length tihs, tihs)
+  let tihs = toInsert hyperdataDocuments
+  printDebug "toInsert hyperdataDocuments" (length tihs, tihs)
 
   let documentsWithId = mergeData (toInserted ids) (toInsert hyperdataDocuments)
-  -- printDebug "documentsWithId" documentsWithId
+  printDebug "documentsWithId" documentsWithId
 
   -- docsWithNgrams <- documentIdWithNgrams documentsWithId extractNgramsT
   let docsWithNgrams  = documentIdWithNgrams extractNgramsT documentsWithId
@@ -94,7 +86,7 @@ flowDatabase ff fp cName = do
   listId2 <- runCmd' $ listFlow masterUserId corpusId indexedNgrams
   printDebug "list id : " listId2
 
-  (userId, _, corpusId2) <- subFlow userArbitrary cName
+  (userId, rootUserId, corpusId2) <- subFlowCorpus userArbitrary cName
   
   userListId <- runCmd' $ listFlowUser userId corpusId2
   printDebug "UserList : " userListId
@@ -103,15 +95,18 @@ flowDatabase ff fp cName = do
   printDebug "Inserted : " (length inserted)
   
   _ <- runCmd' $ mkDashboard corpusId2 userId
-  _ <- runCmd' $ mkGraph corpusId2 userId
+  _ <- runCmd' $ mkGraph     corpusId2 userId
+  
+  -- Annuaire Flow
+  annuaireId <- runCmd' $ mkAnnuaire  rootUserId userId
 
   pure corpusId2
   -- runCmd' $ del [corpusId2, corpusId]
 
 type CorpusName = Text
 
-subFlow :: Username -> CorpusName -> IO (UserId, RootId, CorpusId)
-subFlow username cName = do
+subFlowCorpus :: Username -> CorpusName -> IO (UserId, RootId, CorpusId)
+subFlowCorpus username cName = do
   maybeUserId <- runCmd' (getUser username)
 
   let userId = case maybeUserId of

src/Gargantext/Database/Ngrams.hs

@@ -234,22 +234,24 @@ getNgramsTableData conn nodeT ngrmT (NgramsTableParam ul uc) (NgramsTableParam m
 querySelectTableNgrams :: DPS.Query
 querySelectTableNgrams = [sql|
 
-    WITH tableUser AS (select ngs.terms, ngs.n, nn1.ngrams_type,nn2.weight FROM ngrams ngs
-      JOIN nodes_ngrams nn1 ON nn1.ngram_id = ngs.id
-      JOIN nodes_ngrams nn2 ON nn2.ngram_id = ngs.id
-      JOIN nodes        n   ON n.id         = nn2.node_id
-      WHERE nn1.node_id   = ?   -- User listId
-      AND n.parent_id     = ?   -- User CorpusId or AnnuaireId
-      AND n.typename      = ?   -- both type of childs (Documents or Contacts)
-      AND nn2.ngrams_type = ?   -- both type of ngrams (Authors or Terms?)
-    ), tableMaster AS (select ngs.terms, ngs.n, nn1.ngrams_type,nn2.weight FROM ngrams ngs
-      JOIN nodes_ngrams nn1 ON nn1.ngram_id = ngs.id
-      JOIN nodes_ngrams nn2 ON nn2.ngram_id = ngs.id
-      JOIN nodes        n   ON n.id         = nn2.node_id
-      WHERE nn1.node_id   = ?   -- Master listId
-      AND n.parent_id     = ?   -- Master CorpusId or AnnuaireId
-      AND n.typename      = ?   -- both type of childs (Documents or Contacts)
-      AND nn2.ngrams_type = ?   -- both type of ngrams (Authors or Terms?)
+    WITH tableUser AS (
+      SELECT ngs.terms, ngs.n, nn1.ngrams_type,nn2.weight FROM ngrams ngs
+        JOIN nodes_ngrams nn1 ON nn1.ngram_id = ngs.id
+        JOIN nodes_ngrams nn2 ON nn2.ngram_id = ngs.id
+        JOIN nodes        n   ON n.id         = nn2.node_id
+      WHERE nn1.node_id     = ?   -- User listId
+        AND n.parent_id     = ?   -- User CorpusId or AnnuaireId
+        AND n.typename      = ?   -- both type of childs (Documents or Contacts)
+        AND nn2.ngrams_type = ?   -- both type of ngrams (Authors or Terms?)
+    ), tableMaster AS (
+      SELECT ngs.terms, ngs.n, nn1.ngrams_type,nn2.weight FROM ngrams ngs
+        JOIN nodes_ngrams nn1 ON nn1.ngram_id = ngs.id
+        JOIN nodes_ngrams nn2 ON nn2.ngram_id = ngs.id
+        JOIN nodes        n   ON n.id         = nn2.node_id
+      WHERE nn1.node_id     = ?   -- Master listId
+        AND n.parent_id     = ?   -- Master CorpusId or AnnuaireId
+        AND n.typename      = ?   -- both type of childs (Documents or Contacts)
+        AND nn2.ngrams_type = ?   -- both type of ngrams (Authors or Terms?)
     )
     
   SELECT COALESCE(tu.terms,tm.terms) AS terms

src/Gargantext/Database/Node.hs

@@ -40,6 +40,7 @@ import Prelude hiding (null, id, map, sum)
 
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Types
+import Gargantext.Database.Utils (fromField')
 import Gargantext.Database.Types.Node (NodeType, defaultCorpus, Hyperdata)
 import Gargantext.Database.Queries
 import Gargantext.Database.Config (nodeTypeId)
@@ -139,16 +140,6 @@ instance QueryRunnerColumnDefault PGJsonb HyperdataAnnuaire where
   queryRunnerColumnDefault = fieldQueryRunnerColumn
 ------------------------------------------------------------------------
 
-fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DB.ByteString -> Conversion b
-fromField' field mb = do
-    v <- fromField field mb
-    valueToHyperdata v
-      where
-          valueToHyperdata v = case fromJSON v of
-             Success a  -> pure a
-             Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
-
-
 $(makeAdaptorAndInstance "pNode" ''NodePoly)
 $(makeLensesWith abbreviatedFields ''NodePoly)
 
@@ -372,14 +363,7 @@ nodeAnnuaireW maybeName maybeAnnuaire pId = node NodeAnnuaire name annuaire (Jus
     name     = maybe "Annuaire" identity maybeName
     annuaire = maybe defaultAnnuaire identity maybeAnnuaire
                    --------------------------
-defaultContact :: HyperdataContact
-defaultContact = HyperdataContact (Just "Name") (Just "email@here")
 
-nodeContactW :: Maybe Name -> Maybe HyperdataContact -> AnnuaireId -> UserId -> NodeWrite'
-nodeContactW maybeName maybeContact aId = node NodeContact name contact (Just aId)
-  where
-    name    = maybe "Contact" identity maybeName
-    contact = maybe defaultContact identity maybeContact
 ------------------------------------------------------------------------
 arbitraryList :: HyperdataList
 arbitraryList = HyperdataList (Just "Preferences")
@@ -566,7 +550,8 @@ mkGraph p u = insertNodesR' [nodeGraphW Nothing Nothing p u]
 mkDashboard :: ParentId -> UserId -> Cmd [Int]
 mkDashboard p u = insertNodesR' [nodeDashboardW Nothing Nothing p u]
 
+mkAnnuaire :: ParentId -> UserId -> Cmd [Int]
+mkAnnuaire p u = insertNodesR' [nodeAnnuaireW Nothing Nothing p u]
 
 -- | Default CorpusId Master and ListId Master
 
-

src/Gargantext/Database/Node/Contact.hs

+{-|
+Module      : Gargantext.Database.Node.Contact
+Description : Update Node in Database (Postgres)
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE DeriveGeneric          #-}
+{-# LANGUAGE NoImplicitPrelude      #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE OverloadedStrings      #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE TemplateHaskell        #-}
+
+module Gargantext.Database.Node.Contact (NodeContact,HyperdataContact, ContactWho, ContactWhere, ContactTouch)
+  where
+
+import GHC.Generics (Generic)
+import Data.Aeson.TH (deriveJSON)
+import Data.Text (Text)
+import qualified Data.Text as DT
+import Control.Lens (makeLenses)
+import Database.PostgreSQL.Simple
+import Opaleye (QueryRunnerColumnDefault
+               , queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
+import Gargantext.Database.Utils (fromField')
+import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Database.Node (NodeWrite', AnnuaireId, UserId, Name, node)
+import Gargantext.Prelude
+import Gargantext.Database.Types.Node (Node,Hyperdata,NodeType(..))
+import Data.Aeson (Result(Error,Success), fromJSON, FromJSON, ToJSON)
+import Database.PostgreSQL.Simple.FromField ( Conversion
+                                            , ResultError(ConversionFailed)
+                                            , FromField
+                                            , fromField
+                                            , returnError
+                                            )
+
+------------------------------------------------------------------------
+
+type NodeContact  = Node HyperdataContact
+
+data HyperdataContact =
+     HyperdataContact { _hc_who    :: Maybe ContactWho
+                      , _hc_where  :: Maybe [ContactWhere]
+                      , _hc_lastValidation  :: Maybe Text
+
+  } deriving (Eq, Show, Generic)
+
+arbitraryHyperdataContact :: HyperdataContact
+arbitraryHyperdataContact = HyperdataContact Nothing Nothing Nothing
+
+data ContactWho = 
+     ContactWho { _cw_id          :: Maybe Int
+                , _cw_firstName   :: Maybe Text
+                , _cw_lastName    :: Maybe Text
+                , _cw_keywords :: Maybe [Text]
+                , _cw_freetags :: Maybe [Text]
+  } deriving (Eq, Show, Generic)
+
+
+data ContactWhere =
+     ContactWhere { _cw_organization :: Maybe [Text]
+                  , _cw_labTeamDepts :: Maybe [Text]
+                  , _cw_role         :: Maybe Text
+                  , _cw_office       :: Maybe Text
+                  , _cw_country      :: Maybe Text
+                  , _cw_city         :: Maybe Text
+                  , _cw_touch        :: Maybe ContactTouch
+  } deriving (Eq, Show, Generic)
+
+data ContactTouch =
+     ContactTouch { _ct_mail      :: Maybe Text
+                  , _ct_phone     :: Maybe Text
+                  , _ct_url       :: Maybe Text
+  } deriving (Eq, Show, Generic)
+
+
+nodeContactW :: Maybe Name -> Maybe HyperdataContact
+             -> AnnuaireId -> UserId -> NodeWrite'
+nodeContactW maybeName maybeContact aId = 
+  node NodeContact name contact (Just aId)
+    where
+      name    = maybe "Contact" identity maybeName
+      contact = maybe arbitraryHyperdataContact identity maybeContact
+
+
+
+instance Hyperdata HyperdataContact
+instance FromField HyperdataContact where
+  fromField = fromField'
+instance QueryRunnerColumnDefault PGJsonb HyperdataContact   where
+  queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+{-
+makeLenses ''ContactWho
+makeLenses ''ContactWhere
+makeLenses ''ContactTouch
+makeLenses ''HyperdataContact
+-}
+
+$(deriveJSON (unPrefix "_cw_") ''ContactWho)
+$(deriveJSON (unPrefix "_cw_") ''ContactWhere)
+$(deriveJSON (unPrefix "_ct_") ''ContactTouch)
+$(deriveJSON (unPrefix "_hc_") ''HyperdataContact)
+
+

src/Gargantext/Database/Types/Node.hs

@@ -54,7 +54,6 @@ import           Test.QuickCheck (elements)
 
 import           Gargantext.Prelude
 import           Gargantext.Core.Utils.Prefix (unPrefix)
-
 ------------------------------------------------------------------------
 
 type UTCTime' = UTCTime
@@ -260,13 +259,6 @@ hyperdataAnnuaire = HyperdataAnnuaire (Just "Annuaire Title") (Just "Annuaire De
 instance Arbitrary HyperdataAnnuaire where
     arbitrary = pure hyperdataAnnuaire -- TODO
 
-------------------------------------------------------------------------
-data HyperdataContact = HyperdataContact { hyperdataContact_name        :: Maybe Text
-                                         , hyperdataContact_mail        :: Maybe Text
-                                         } deriving (Show, Generic)
-$(deriveJSON (unPrefix "hyperdataContact_") ''HyperdataContact)
-
-instance Hyperdata HyperdataContact
 ------------------------------------------------------------------------
 newtype HyperdataAny = HyperdataAny Object
   deriving (Show, Generic, ToJSON, FromJSON)
@@ -352,7 +344,6 @@ type NodeCorpusV3 = Node HyperdataCorpus
 type NodeDocument = Node HyperdataDocument
 
 type NodeAnnuaire = Node HyperdataAnnuaire
-type NodeContact  = Node HyperdataContact
 
 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
 type NodeList     = Node HyperdataList

src/Gargantext/Database/Utils.hs

@@ -19,15 +19,26 @@ module Gargantext.Database.Utils where
 
 import qualified Database.PostgreSQL.Simple as PGS
 
+import Data.Aeson (Result(Error,Success), fromJSON, FromJSON)
+import Data.Typeable (Typeable)
 import Data.Monoid ((<>))
 import Data.Either.Extra (Either(Left, Right))
-import Gargantext.Prelude
-import Data.Text (unpack, pack)
-import Text.Read (read)
+import Database.PostgreSQL.Simple.Internal  (Field)
+import qualified Data.ByteString      as DB
+import Database.PostgreSQL.Simple.FromField ( Conversion
+                                            , ResultError(ConversionFailed)
+                                            , FromField
+                                            , fromField
+                                            , returnError
+                                            )
+
 import Data.Ini (readIniFile, lookupValue)
+import Data.Text (unpack, pack)
 import Data.Word (Word16)
-import System.IO (FilePath)
 import Database.PostgreSQL.Simple (Connection, connect)
+import Gargantext.Prelude
+import System.IO (FilePath)
+import Text.Read (read)
 
 -- Utilities
 import Opaleye (Query, Unpackspec, showSqlForPostgres)
@@ -60,4 +71,14 @@ connectGargandb fp = databaseParameters fp >>= \params -> connect params
 printSql :: Default Unpackspec a a => Query a -> IO ()
 printSql = putStrLn . maybe "Empty query" identity . showSqlForPostgres
 
+fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DB.ByteString -> Conversion b
+fromField' field mb = do
+    v <- fromField field mb
+    valueToHyperdata v
+      where
+          valueToHyperdata v = case fromJSON v of
+             Success a  -> pure a
+             Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
+
+