[Annuaire] Contact adding uniq id.

src/Gargantext/Database/Flow.hs

@@ -28,9 +28,9 @@ 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.Node.Document.Add    (add)
-import Gargantext.Database.Node.Document.Insert (insertDocuments, ReturnId(..), addUniqIds, ToDbData(..))
+import Gargantext.Database.Node.Document.Insert (insertDocuments, ReturnId(..), addUniqIdsDoc, ToDbData(..))
 import Gargantext.Database.NodeNgram (NodeNgramPoly(..), insertNodeNgrams)
 import Gargantext.Database.NodeNgramsNgrams (NodeNgramsNgramsPoly(..), insertNodeNgramsNgramsNew)
 import Gargantext.Database.Types.Node (HyperdataDocument(..))
@@ -44,23 +44,30 @@ type UserId = Int
 type RootId = Int
 type CorpusId = Int
 
+{-
+flowCorpus :: [ToDbData] -> CorpusName -> IO CorpusId
+flowCorpus = undefined
+--}
+
 flowDatabase :: FileFormat -> FilePath -> CorpusName -> IO Int
 flowDatabase ff fp cName = do
-
   -- Corpus Flow
   (masterUserId, _, corpusId) <- subFlowCorpus userMaster corpusMasterName
 
   -- Documents Flow
-  hyperdataDocuments <- map addUniqIds <$> parseDocs ff fp
+  hyperdataDocuments <- map addUniqIdsDoc <$> parseDocs ff fp
   let hyperdataDocuments' = map (\h -> ToDbDocument h) hyperdataDocuments
   printDebug "hyperdataDocuments" (length hyperdataDocuments)
 
+
+
+
   ids  <- runCmd' $ insertDocuments masterUserId corpusId hyperdataDocuments'
   -- printDebug "Docs IDs : " (ids)
   -- idsRepeat  <- runCmd' $ insertDocuments masterUserId corpusId hyperdataDocuments'
   -- printDebug "Repeated Docs IDs : " (length idsRepeat)
   let idsNotRepeated = filter (\r -> reInserted r == True) ids
--- {-
+--{-
   -- Ngrams Flow
   -- todo: flow for new documents only
   let tids = toInserted ids
@@ -87,17 +94,16 @@ flowDatabase ff fp cName = do
   listId2 <- runCmd' $ listFlow masterUserId corpusId indexedNgrams
   printDebug "list id : " listId2
 
-  --(userId, rootUserId, corpusId2) <- subFlowCorpus userArbitrary cName
   --}
   (userId, _, corpusId2) <- subFlowCorpus userArbitrary cName
   
   userListId <- runCmd' $ listFlowUser userId corpusId2
   printDebug "UserList : " userListId
   inserted <- runCmd' $ add corpusId2 (map reId ids)
-  printDebug "Inserted : " (length inserted)
+  printDebug "Added : " (length inserted)
   
-  --_ <- runCmd' $ mkDashboard corpusId2 userId
-  --_ <- runCmd' $ mkGraph     corpusId2 userId
+  _ <- runCmd' $ mkDashboard corpusId2 userId
+  _ <- runCmd' $ mkGraph     corpusId2 userId
   
   -- Annuaire Flow
   -- _ <- runCmd' $ mkAnnuaire  rootUserId userId

src/Gargantext/Database/Node/Contact.hs

@@ -20,32 +20,35 @@ Portability : POSIX
 module Gargantext.Database.Node.Contact
   where
 
-import GHC.Generics (Generic)
+import Control.Lens (makeLenses)
 import Data.Aeson.TH (deriveJSON)
 import Data.Text (Text)
 import Data.Time (UTCTime)
--- import Control.Lens (makeLenses)
-import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
-import Gargantext.Database.Utils (fromField')
+import Database.PostgreSQL.Simple.FromField (FromField, fromField)
+import GHC.Generics (Generic)
 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 Database.PostgreSQL.Simple.FromField (FromField, fromField)
+import Gargantext.Database.Utils (fromField')
+import Gargantext.Prelude
+import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
 
 ------------------------------------------------------------------------
 
 type NodeContact  = Node HyperdataContact
 
 data HyperdataContact =
-     HyperdataContact { _hc_who    :: Maybe ContactWho
+     HyperdataContact { _hc_bdd    :: Maybe Text           -- ID of Database source
+                      , _hc_who    :: Maybe ContactWho
                       , _hc_where  :: Maybe [ContactWhere]
                       , _hc_lastValidation  :: Maybe Text
+                      , _hc_uniqIdBdd       :: Maybe Text
+                      , _hc_uniqId          :: Maybe Text
 
   } deriving (Eq, Show, Generic)
 
 arbitraryHyperdataContact :: HyperdataContact
-arbitraryHyperdataContact = HyperdataContact Nothing Nothing Nothing
+arbitraryHyperdataContact = HyperdataContact Nothing Nothing Nothing Nothing Nothing Nothing
 
 data ContactWho = 
      ContactWho { _cw_id          :: Maybe Int
@@ -90,12 +93,10 @@ instance FromField HyperdataContact where
 instance QueryRunnerColumnDefault PGJsonb HyperdataContact   where
   queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-{-
 makeLenses ''ContactWho
 makeLenses ''ContactWhere
 makeLenses ''ContactTouch
 makeLenses ''HyperdataContact
--}
 
 $(deriveJSON (unPrefix "_cw_") ''ContactWho)
 $(deriveJSON (unPrefix "_cw_") ''ContactWhere)

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

@@ -59,7 +59,10 @@ the concatenation of the parameters defined by @hashParameters@.
 ------------------------------------------------------------------------
 module Gargantext.Database.Node.Document.Insert where
 
-import Control.Lens (set)
+import Control.Lens (set, view)
+import Control.Lens.Prism
+import Control.Lens.Cons
+import Control.Monad (join)
 import Data.Aeson (toJSON, Value)
 import Data.Maybe (maybe)
 import Data.Text (Text)
@@ -73,7 +76,7 @@ import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import GHC.Generics (Generic)
 import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Node (mkCmd, Cmd(..))
-import Gargantext.Database.Node.Contact (HyperdataContact(..))
+import Gargantext.Database.Node.Contact -- (HyperdataContact(..), ContactWho(..))
 import Gargantext.Database.Types.Node
 import Gargantext.Prelude
 import qualified Data.ByteString.Lazy.Char8  as DC (pack)
@@ -208,23 +211,44 @@ instance ToRow InputData where
 ---------------------------------------------------------------------------
 -- * Uniqueness of document definition
 
-addUniqIds :: HyperdataDocument -> HyperdataDocument
-addUniqIds doc = set hyperdataDocument_uniqIdBdd (Just hashBdd)
-              $ set hyperdataDocument_uniqId    (Just hash) doc
+addUniqIdsDoc :: HyperdataDocument -> HyperdataDocument
+addUniqIdsDoc doc = set hyperdataDocument_uniqIdBdd (Just hashBdd)
+               $ set hyperdataDocument_uniqId    (Just hash) doc
   where
-    hash    = uniqId $ DT.concat $ map ($ doc) hashParameters
-    hashBdd = uniqId $ DT.concat $ map ($ doc) ([(\d -> maybe' (_hyperdataDocument_bdd d))] <> hashParameters)
+    hash    = uniqId $ DT.concat $ map ($ doc) hashParametersDoc
+    hashBdd = uniqId $ DT.concat $ map ($ doc) ([(\d -> maybe' (_hyperdataDocument_bdd d))] <> hashParametersDoc)
 
     uniqId :: Text -> Text
     uniqId = DT.pack . SHA.showDigest . SHA.sha256 . DC.pack . DT.unpack
 
 
-hashParameters :: [(HyperdataDocument -> Text)]
-hashParameters = [ \d -> maybe' (_hyperdataDocument_title    d)
-                 , \d -> maybe' (_hyperdataDocument_abstract d)
-                 , \d -> maybe' (_hyperdataDocument_source   d)
-                 , \d -> maybe' (_hyperdataDocument_publication_date   d)
-                 ]
+hashParametersDoc :: [(HyperdataDocument -> Text)]
+hashParametersDoc = [ \d -> maybe' (_hyperdataDocument_title    d)
+                    , \d -> maybe' (_hyperdataDocument_abstract d)
+                    , \d -> maybe' (_hyperdataDocument_source   d)
+                    , \d -> maybe' (_hyperdataDocument_publication_date   d)
+                    ]
+---------------------------------------------------------------------------
+-- * Uniqueness of document definition
+-- TODO factorize with above (use the function below for tests)
+addUniqIdsContact :: HyperdataContact -> HyperdataContact
+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_bdd d))] <> hashParametersContact)
+
+    uniqId :: Text -> Text
+    uniqId = DT.pack . SHA.showDigest . SHA.sha256 . DC.pack . DT.unpack
+
+-- | TODO add more hashparameters
+hashParametersContact :: [(HyperdataContact -> Text)]
+hashParametersContact = [ \d -> maybe' $ view (hc_who . _Just . cw_firstName) d
+                        , \d -> maybe' $ view (hc_who . _Just . cw_lastName ) d
+                        , \d -> maybe' $ view (hc_where . _Just . _head . cw_touch . _Just . ct_mail) d
+                        ]
+
+
 
 maybe' :: Maybe Text -> Text
 maybe' = maybe (DT.pack "") identity