From 65bc93a8672a3ce231aa22c79b8ed296318c2823 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Alexandre=20Delano=C3=AB?= <devel+git@delanoe.org>
Date: Tue, 27 Nov 2018 21:09:13 +0100
Subject: [PATCH] [ANNUAIRE] Contact type and mkAnnuaire function.
---
package.yaml | 1 +
src/Gargantext/Database/Flow.hs | 35 ++++----
src/Gargantext/Database/Ngrams.hs | 34 +++----
src/Gargantext/Database/Node.hs | 21 +----
src/Gargantext/Database/Node/Contact.hs | 112 ++++++++++++++++++++++++
src/Gargantext/Database/Types/Node.hs | 9 --
src/Gargantext/Database/Utils.hs | 29 +++++-
7 files changed, 174 insertions(+), 67 deletions(-)
create mode 100644 src/Gargantext/Database/Node/Contact.hs
diff --git a/package.yaml b/package.yaml
index a82b20ee..bfc1b253 100644
--- a/package.yaml
+++ b/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
diff --git a/src/Gargantext/Database/Flow.hs b/src/Gargantext/Database/Flow.hs
index 9fe21b2a..fc1e61f8 100644
--- a/src/Gargantext/Database/Flow.hs
+++ b/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
diff --git a/src/Gargantext/Database/Ngrams.hs b/src/Gargantext/Database/Ngrams.hs
index 30eb2307..307cd7f5 100644
--- a/src/Gargantext/Database/Ngrams.hs
+++ b/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
diff --git a/src/Gargantext/Database/Node.hs b/src/Gargantext/Database/Node.hs
index b21cc316..80661ecb 100644
--- a/src/Gargantext/Database/Node.hs
+++ b/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
-
diff --git a/src/Gargantext/Database/Node/Contact.hs b/src/Gargantext/Database/Node/Contact.hs
new file mode 100644
index 00000000..b8ccff59
--- /dev/null
+++ b/src/Gargantext/Database/Node/Contact.hs
@@ -0,0 +1,112 @@
+{-|
+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)
+
+
diff --git a/src/Gargantext/Database/Types/Node.hs b/src/Gargantext/Database/Types/Node.hs
index d87ff755..ae3923dc 100644
--- a/src/Gargantext/Database/Types/Node.hs
+++ b/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
diff --git a/src/Gargantext/Database/Utils.hs b/src/Gargantext/Database/Utils.hs
index 76ef6476..beff14f8 100644
--- a/src/Gargantext/Database/Utils.hs
+++ b/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"
+
+
--
2.21.0