[FLOW] preparing Hyperdata ToNode instance

src/Gargantext/Core/Flow/Types.hs

@@ -23,10 +23,11 @@ import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Schema.Ngrams (Ngrams, NgramsType)
 import Gargantext.Prelude
+import Gargantext.Prelude.Crypto.Hash (Hash)
 
 class UniqId a
   where
-    uniqId :: Lens' a (Maybe HashId)
+    uniqId :: Lens' a (Maybe Hash)
 
 instance UniqId HyperdataDocument
   where

src/Gargantext/Core/Text.hs

@@ -21,7 +21,6 @@ import NLP.FullStop (segment)
 import qualified Data.Text as DT
 
 -----------------------------------------------------------------
-
 class HasText h
   where
     hasText :: h -> [Text]

src/Gargantext/Database/Action/Flow.hs

@@ -49,10 +49,11 @@ import Data.Either
 import Data.List (concat)
 import qualified Data.Map as Map
 import Data.Map (Map, lookup)
-import Data.Maybe (Maybe(..), catMaybes)
+import Data.Maybe (Maybe(..), catMaybes, fromMaybe)
 import Data.Monoid
 import Data.Swagger
 import Data.Text (splitOn, intercalate)
+import Data.Time.Segment (jour)
 import Data.Traversable (traverse)
 import Data.Tuple.Extra (first, second)
 import GHC.Generics (Generic)
@@ -70,7 +71,7 @@ import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Document.Insert -- (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..))
 import Gargantext.Database.Query.Tree.Root (getOrMkRoot, getOrMk_RootWithCorpus)
 import Gargantext.Database.Action.Search (searchDocInDatabase)
-import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
+import Gargantext.Database.Admin.Config (userMaster, corpusMasterName, nodeTypeId)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
@@ -78,17 +79,20 @@ import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Ngrams
 import Gargantext.Database.Query.Table.NodeNgrams (listInsertDb , getCgramsId)
 import Gargantext.Database.Query.Table.NodeNodeNgrams2
+import Gargantext.Database.Schema.Node (NodePoly(..))
 import Gargantext.Core.Ext.IMT (toSchoolName)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Core.Ext.IMTUser (deserialiseImtUsersFromFile)
 import Gargantext.Core.Text
 import Gargantext.Prelude
+import Gargantext.Prelude.Crypto.Hash (Hash)
 import Gargantext.Core.Text.Corpus.Parsers (parseFile, FileFormat)
 import Gargantext.Core.Text.List (buildNgramsLists,StopSize(..))
 import Gargantext.Core.Text.Terms.Mono.Stem.En (stemIt)
 import Gargantext.Core.Text.Terms
 import qualified Gargantext.Database.Query.Table.Node.Document.Add  as Doc  (add)
 import qualified Gargantext.Core.Text.Corpus.API as API
+import qualified Data.Text as DT
 
 ------------------------------------------------------------------------
 -- TODO use internal with API name (could be old data)
@@ -242,6 +246,19 @@ insertDocs uId cId hs = do
   _ <- Doc.add cId newIds'
   pure (newIds', documentsWithId)
 
+{-
+-- TODO Maybe NodeId
+toNode :: Hyperdata a => NodeType -> ParentId -> UserId -> a -> Node a
+toNode NodeDocument p u h = Node 0 "" (nodeTypeId nt) u (Just p) n date h
+  where
+    n    = maybe "No Title" (DT.take 255) (_hd_title h)
+    date  = jour y m d
+    y = maybe 0 fromIntegral $ _hd_publication_year  h
+    m = fromMaybe 1 $ _hd_publication_month h
+    d = fromMaybe 1 $ _hd_publication_day   h
+toNode _ _ _ _ = undefined
+-}
+
 
 insertMasterDocs :: ( FlowCmdM env err m
                     , FlowCorpus a
@@ -254,6 +271,7 @@ insertMasterDocs :: ( FlowCmdM env err m
 insertMasterDocs c lang hs  =  do
   (masterUserId, _, masterCorpusId) <- getOrMk_RootWithCorpus (UserName userMaster) (Left corpusMasterName) c
   (ids', documentsWithId) <- insertDocs masterUserId masterCorpusId hs
+  -- (ids', documentsWithId) <- insertDocs masterUserId masterCorpusId (map (toNode NodeDocument masterCorpusId masterUserId ) hs )
   _ <- Doc.add masterCorpusId ids'
   -- TODO
   -- create a corpus with database name (CSV or PubMed)
@@ -292,20 +310,20 @@ insertMasterDocs c lang hs  =  do
 ------------------------------------------------------------------------
 viewUniqId' :: UniqId a
             => a
-            -> (HashId, a)
+            -> (Hash, a)
 viewUniqId' d = maybe err (\h -> (h,d)) (view uniqId d)
       where
         err = panic "[ERROR] Database.Flow.toInsert"
 
 
 toInserted :: [ReturnId]
-           -> Map HashId ReturnId
+           -> Map Hash ReturnId
 toInserted =
   Map.fromList . map    (\r -> (reUniqId r, r)     )
                . filter (\r -> reInserted r == True)
 
-mergeData :: Map HashId ReturnId
-          -> Map HashId a
+mergeData :: Map Hash ReturnId
+          -> Map Hash a
           -> [DocumentWithId a]
 mergeData rs = catMaybes . map toDocumentWithId . Map.toList
   where
@@ -350,6 +368,16 @@ instance HasText HyperdataDocument
                           , _hd_abstract h
                           ]
 
+instance HasText (Node HyperdataDocument)
+  where
+    hasText n = catMaybes [ _hd_title    h
+                          , _hd_abstract h
+                          ]
+      where
+        h = _node_hyperdata n
+
+
+
 instance ExtractNgramsT HyperdataDocument
   where
     extractNgramsT :: TermType Lang

src/Gargantext/Database/Action/Flow/Types.hs

@@ -39,5 +39,6 @@ type FlowCorpus a = ( AddUniqId      a
                     , InsertDb       a
                     , ExtractNgramsT a
                     , HasText        a
+                    -- , ToNode         a
                     )
 

src/Gargantext/Database/Admin/Types/Node.hs

@@ -38,6 +38,7 @@ import Servant
 import qualified Opaleye as O
 import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGInt4, PGTSVector, Nullable, fieldQueryRunnerColumn)
 import Test.QuickCheck (elements)
+import Gargantext.Prelude.Crypto.Hash (Hash)
 import Test.QuickCheck.Arbitrary
 import Test.QuickCheck.Instances.Text ()
 import Test.QuickCheck.Instances.Time ()
@@ -51,10 +52,9 @@ import Gargantext.Prelude
 
 type UserId = Int
 type MasterUserId = UserId
-type HashId = Text
 ------------------------------------------------------------------------
 -- | NodePoly indicates that Node has a Polymorphism Type
-type Node json   = NodePoly NodeId HashId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
+type Node json   = NodePoly NodeId Hash NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
 
 -- | NodeSearch (queries)
 -- type NodeSearch json   = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json (Maybe TSVector)
@@ -62,7 +62,7 @@ type Node json   = NodePoly NodeId HashId NodeTypeId UserId (Maybe ParentId) Nod
 ------------------------------------------------------------------------
 
 instance (Typeable hyperdata, ToSchema hyperdata) =>
-         ToSchema (NodePoly NodeId HashId NodeTypeId
+         ToSchema (NodePoly NodeId Hash NodeTypeId
                             (Maybe UserId)
                             ParentId NodeName
                             UTCTime hyperdata
@@ -70,7 +70,7 @@ instance (Typeable hyperdata, ToSchema hyperdata) =>
   declareNamedSchema = wellNamedSchema "_node_"
 
 instance (Typeable hyperdata, ToSchema hyperdata) =>
-         ToSchema (NodePoly NodeId HashId NodeTypeId
+         ToSchema (NodePoly NodeId Hash NodeTypeId
                             UserId
                             (Maybe ParentId) NodeName
                             UTCTime hyperdata
@@ -93,12 +93,12 @@ instance (Typeable hyperdata, ToSchema hyperdata) =>
                   ) where
   declareNamedSchema = wellNamedSchema "_ns_"
 
-instance (Arbitrary hyperdata
-         ,Arbitrary nodeId
+instance (Arbitrary nodeId
          ,Arbitrary hashId
          ,Arbitrary nodeTypeId
          ,Arbitrary userId
          ,Arbitrary nodeParentId
+         , Arbitrary hyperdata
          ) => Arbitrary (NodePoly nodeId hashId nodeTypeId userId nodeParentId
                                   NodeName UTCTime hyperdata) where
     --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")

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

@@ -57,7 +57,7 @@ module Gargantext.Database.Query.Table.Node.Document.Insert
 import Control.Lens (set, view)
 import Control.Lens.Cons
 import Control.Lens.Prism
-import Data.Aeson (toJSON{-, ToJSON-})
+import Data.Aeson (toJSON, encode{-, ToJSON-})
 import Data.Maybe (maybe)
 import Data.Text (Text)
 -- import Data.ByteString (ByteString)
@@ -73,22 +73,11 @@ import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (Cmd, runPGSQuery{-, formatPGSQuery-})
+import Gargantext.Database.Schema.Node (NodePoly(..))
 import Gargantext.Prelude
 import Gargantext.Prelude.Crypto.Hash (hash)
 import qualified Data.Text                   as DT (pack, concat, take)
 
--- TODO : the import of Document constructor below does not work
--- import Gargantext.Database.Types.Node (Document)
---import Gargantext.Database.Types.Node (docExample, hyperdataDocument, HyperdataDocument(..)
---                                  , hyperdataDocument_uniqId
---                                  , hyperdataDocument_title
---                                  , hyperdataDocument_abstract
---                                  , hyperdataDocument_source
---                                  , Node(..), node_typename
---                                            , node_userId
---                                            , node_parentId, node_name, node_hyperdata, hyperdataDocuments
---                                  , NodeTypeId
---                                  )
 {-| To Print result query
 import Data.ByteString.Internal (ByteString)
 import Database.PostgreSQL.Simple (formatQuery)
@@ -134,6 +123,17 @@ instance InsertDb HyperdataContact
                       , (toField . toJSON) h
                       ]
 
+instance InsertDb (Node HyperdataDocument)
+  where
+    insertDb' _u _p (Node _nid hashId t u p n d h) = [ toField hashId
+                                                     , toField t
+                                                     , toField u
+                                                     , toField p
+                                                     , toField n
+                                                     , toField d
+                                                     , toField h
+                                                     ]
+
 -- | Debug SQL function
 --
 -- to print rendered query (Debug purpose) use @formatQuery@ function.
@@ -212,6 +212,22 @@ instance AddUniqId HyperdataDocument
                            , \d -> maybeText (_hd_source           d)
                            , \d -> maybeText (_hd_publication_date d)
                            ]
+-- TODO put this elsewhere (fix bin/gargantext-init/Main.hs too)
+secret :: Text
+secret = "Database secret to change"
+
+
+instance AddUniqId (Node HyperdataDocument)
+  where
+    addUniqId (Node nid _ t u p n d h)  = Node nid hashId t u p n d h
+      where
+        hashId = "\\x" <> (hash $ DT.concat params)
+        params = [ secret
+                 , cs $ show $ nodeTypeId NodeDocument
+                 , n
+                 , cs $ show p
+                 , cs $ encode h
+                 ]
 
     ---------------------------------------------------------------------------
 -- * Uniqueness of document definition