[FLOW] more polymorphism to insert Hyperdata in database (preparing Annuaire...

[FLOW] more polymorphism to insert Hyperdata in database (preparing Annuaire and Contacts insertion).

src/Gargantext/Database/Flow.hs

@@ -7,7 +7,6 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
-
 -}
 
 {-# LANGUAGE DeriveGeneric     #-}
@@ -27,18 +26,19 @@ import qualified Data.Map as DM
 
 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.Document.Add    (add)
-import Gargantext.Database.Node.Document.Insert (insertDocuments, ReturnId(..), addUniqIds)
+import Gargantext.Database.Node.Document.Insert (insertDocuments, ReturnId(..), addUniqIds, Hyper(HyperDocument))
 import Gargantext.Database.NodeNgram (NodeNgramPoly(..), insertNodeNgrams)
 import Gargantext.Database.NodeNgramsNgrams (NodeNgramsNgramsPoly(..), insertNodeNgramsNgramsNew)
 import Gargantext.Database.Types.Node (HyperdataDocument(..))
+import Gargantext.Database.Node.Contact (HyperdataContact(..))
 import Gargantext.Database.User (getUser, UserLight(..), Username)
-import Gargantext.Database.Config (userMaster, userArbitrary, corpusMasterName)
+import Gargantext.Ext.IMT (toSchoolName)
 import Gargantext.Prelude
 import Gargantext.Text.Parsers (parseDocs, FileFormat)
-import Gargantext.Ext.IMT (toSchoolName)
 
 type UserId = Int
 type RootId = Int
@@ -46,27 +46,27 @@ type CorpusId = Int
 
 flowDatabase :: FileFormat -> FilePath -> CorpusName -> IO Int
 flowDatabase ff fp cName = do
-  
+
   -- Corus Flow
   (masterUserId, _, corpusId) <- subFlowCorpus userMaster corpusMasterName
 
   -- Documents Flow
   hyperdataDocuments <- map addUniqIds <$> parseDocs ff fp
-
+  let hyperdataDocuments' = map (\h -> HyperDocument h) hyperdataDocuments
   printDebug "hyperdataDocuments" hyperdataDocuments
 
-  ids  <- runCmd' $ insertDocuments masterUserId corpusId hyperdataDocuments
+  ids  <- runCmd' $ insertDocuments masterUserId corpusId hyperdataDocuments'
   --printDebug "Docs IDs : " (ids)
-  idsRepeat  <- runCmd' $ insertDocuments masterUserId corpusId hyperdataDocuments
+  idsRepeat  <- runCmd' $ insertDocuments masterUserId corpusId hyperdataDocuments'
   printDebug "Repeated Docs IDs : " (length idsRepeat)
 
   -- Ngrams Flow
   -- todo: flow for new documents only
   let tids = toInserted ids
-  printDebug "toInserted ids" (length tids, tids)
+  printDebug "toInserted ids" (length tids)
 
   let tihs = toInsert hyperdataDocuments
-  printDebug "toInsert hyperdataDocuments" (length tihs, tihs)
+  printDebug "toInsert hyperdataDocuments" (length tihs)
 
   let documentsWithId = mergeData (toInserted ids) (toInsert hyperdataDocuments)
   printDebug "documentsWithId" documentsWithId

src/Gargantext/Database/Node.hs

@@ -97,47 +97,61 @@ type DocId  = Int
 type UserId = Int
 type TypeId = Int
 ------------------------------------------------------------------------
-instance FromField HyperdataAny where
+instance FromField HyperdataAny
+  where
     fromField = fromField'
 
-instance FromField HyperdataCorpus where
+instance FromField HyperdataCorpus
+  where
     fromField = fromField'
 
-instance FromField HyperdataDocument where
+instance FromField HyperdataDocument
+  where
     fromField = fromField'
 
-instance FromField HyperdataDocumentV3 where
+instance FromField HyperdataDocumentV3
+  where
     fromField = fromField'
 
-instance FromField HyperdataUser where
+instance FromField HyperdataUser
+  where
     fromField = fromField'
 
-instance FromField HyperdataList where
+instance FromField HyperdataList
+  where
     fromField = fromField'
 
-instance FromField HyperdataAnnuaire where
+instance FromField HyperdataAnnuaire
+  where
     fromField = fromField'
 ------------------------------------------------------------------------
-instance QueryRunnerColumnDefault PGJsonb HyperdataAny where
-  queryRunnerColumnDefault = fieldQueryRunnerColumn
+instance QueryRunnerColumnDefault PGJsonb HyperdataAny
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGJsonb HyperdataDocument where
-  queryRunnerColumnDefault = fieldQueryRunnerColumn
+instance QueryRunnerColumnDefault PGJsonb HyperdataDocument
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGJsonb HyperdataDocumentV3 where
-  queryRunnerColumnDefault = fieldQueryRunnerColumn
+instance QueryRunnerColumnDefault PGJsonb HyperdataDocumentV3
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus   where
-  queryRunnerColumnDefault = fieldQueryRunnerColumn
+instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGJsonb HyperdataUser     where
-  queryRunnerColumnDefault = fieldQueryRunnerColumn
+instance QueryRunnerColumnDefault PGJsonb HyperdataUser
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGJsonb HyperdataList     where
-  queryRunnerColumnDefault = fieldQueryRunnerColumn
+instance QueryRunnerColumnDefault PGJsonb HyperdataList
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGJsonb HyperdataAnnuaire where
-  queryRunnerColumnDefault = fieldQueryRunnerColumn
+instance QueryRunnerColumnDefault PGJsonb HyperdataAnnuaire
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
 ------------------------------------------------------------------------
 
 $(makeAdaptorAndInstance "pNode" ''NodePoly)

src/Gargantext/Database/Node/Contact.hs

@@ -63,7 +63,6 @@ data ContactWho =
                 , _cw_freetags :: Maybe [Text]
   } deriving (Eq, Show, Generic)
 
-
 data ContactWhere =
      ContactWhere { _cw_organization :: Maybe [Text]
                   , _cw_labTeamDepts :: Maybe [Text]

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

@@ -61,7 +61,7 @@ module Gargantext.Database.Node.Document.Insert where
 
 import Control.Lens (set)
 
-import Data.Aeson (toJSON, Value)
+import Data.Aeson (toJSON, Value, ToJSON)
 import Data.ByteString.Internal (ByteString)
 import Data.Maybe (maybe)
 import Data.Typeable (Typeable)
@@ -79,6 +79,7 @@ import qualified Data.ByteString.Lazy.Char8  as DC (pack)
 
 import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Node (mkCmd, Cmd(..))
+import Gargantext.Database.Node.Contact (HyperdataContact(..))
 import Gargantext.Database.Types.Node
 -- TODO : the import of Document constructor below does not work
 -- import Gargantext.Database.Types.Node (Document)
@@ -105,20 +106,29 @@ import GHC.Generics (Generic)
 -- | Insert Document main function
 -- UserId : user who is inserting the documents
 -- ParentId : folder ID which is parent of the inserted documents
-insertDocuments :: UserId -> ParentId -> [HyperdataDocument] -> Cmd [ReturnId]
+
+
+data Hyper = HyperDocument HyperdataDocument | HyperContact HyperdataContact
+
+insertDocuments :: UserId -> ParentId -> [Hyper] -> Cmd [ReturnId]
 insertDocuments uId pId hs = mkCmd $ \c -> query c queryInsert (Only $ Values fields inputData)
   where
     fields    = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
-    inputData = prepare uId pId hs
+    inputData = case hs of
+                  [HyperDocument _] -> prepare _hyperdataDocument_title uId pId $ map (\(HyperDocument h) -> h) hs
+                  [HyperContact  _] -> prepare (\_ -> Just "name") uId pId $ map (\(HyperContact h) -> h) hs
+                  _                 -> panic "error"
 
 -- | Debug SQL function
 --
 -- to print rendered query (Debug purpose) use @formatQuery@ function.
-insertDocuments_Debug :: UserId -> ParentId -> [HyperdataDocument] -> Cmd ByteString
+{-
+insertDocuments_Debug :: (Hyperdata a, ToJSON a, ToRow a) => UserId -> ParentId -> [a] -> Cmd ByteString
 insertDocuments_Debug uId pId hs = mkCmd $ \conn -> formatQuery conn queryInsert (Only $ Values fields inputData)
   where
     fields    = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
     inputData = prepare uId pId hs
+-}
 
 
 -- | Input Tables: types of the tables
@@ -149,9 +159,9 @@ queryInsert = [sql|
     JOIN   nodes c USING (hyperdata);         -- columns of unique index
            |]
 
-prepare :: UserId -> ParentId -> [HyperdataDocument] -> [InputData]
-prepare uId pId = map (\h -> InputData tId uId pId 
-                            (DT.take 255 <$> maybe "No Title of Document" identity $ _hyperdataDocument_title h)
+prepare :: (Hyperdata a, ToJSON a) => (a -> Maybe Text) -> UserId -> ParentId -> [a] -> [InputData]
+prepare f uId pId = map (\h -> InputData tId uId pId 
+                            (DT.take 255 <$> maybe "No Title" identity $ f h)
                                                    (toJSON h)
                       )
   where

src/Gargantext/Database/Types/Node.hs

@@ -20,7 +20,8 @@ Portability : POSIX
 {-# LANGUAGE TemplateHaskell            #-}
 -- {-# LANGUAGE DuplicateRecordFields #-}
 
-module Gargantext.Database.Types.Node where
+module Gargantext.Database.Types.Node
+  where
 
 import Prelude (Enum, Bounded, minBound, maxBound)
 
@@ -107,6 +108,7 @@ $(deriveJSON (unPrefix "hyperdataDocumentV3_") ''HyperdataDocumentV3)
 instance Hyperdata HyperdataDocumentV3
 ------------------------------------------------------------------------
 
+
 data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd                :: Maybe Text
                                            , _hyperdataDocument_doi                :: Maybe Text
                                            , _hyperdataDocument_url                :: Maybe Text