Merge remote-tracking branch 'origin/121-dev-arxiv' into dev-merge
[gargantext.git] / src / Gargantext / Database / Query / Table / Node / Document / Insert.hs
index 636dfd48646601f928089dceacdeb5a46d3570e0..4503ae49acc34020ea8c7da3ae730a7c7f7800e1 100644 (file)
@@ -14,7 +14,7 @@ Enabling "common goods" of text data and respecting privacy.
 Gargantext shares as "common good" the links between context of texts
 and terms / words / ngrams.
 
-Basically a context of text can be defined as a document (see 'Gargantext.Text').
+Basically a context of text can be defined as a document (see 'Gargantext.Core.Text').
 
 Issue to tackle in that module: each global document of Gargantext has
 to be unique, then shared, but how to respect privacy if needed ?
@@ -57,36 +57,27 @@ 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)
-import Data.Maybe (maybe)
+import Data.Aeson (toJSON, encode, ToJSON)
+import Data.Maybe (fromMaybe)
 import Data.Text (Text)
+-- import Data.ByteString (ByteString)
 import Data.Time.Segment (jour)
 import Database.PostgreSQL.Simple (FromRow, Query, Only(..))
 import Database.PostgreSQL.Simple.FromRow (fromRow, field)
+-- import Database.PostgreSQL.Simple.ToRow (toRow, ToRow)
 import Database.PostgreSQL.Simple.SqlQQ
-import Database.PostgreSQL.Simple.ToField (toField, Action)
+import Database.PostgreSQL.Simple.ToField (toField, Action{-, ToField-})
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import GHC.Generics (Generic)
-import Gargantext.Database.Admin.Config (nodeTypeId)
+import Gargantext.Core (HasDBid(toDBid))
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd, runPGSQuery)
+import Gargantext.Database.Prelude (Cmd, runPGSQuery{-, formatPGSQuery-})
+import Gargantext.Database.Schema.Node (NodePoly(..))
 import Gargantext.Prelude
-import Gargantext.Core.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
---                                  )
+import Gargantext.Prelude.Crypto.Hash (hash)
+import qualified Data.Text as DT (pack, concat, take)
+
 {-| To Print result query
 import Data.ByteString.Internal (ByteString)
 import Database.PostgreSQL.Simple (formatQuery)
@@ -99,20 +90,21 @@ import Database.PostgreSQL.Simple (formatQuery)
 -- UserId : user who is inserting the documents
 -- ParentId : folder ID which is parent of the inserted documents
 -- Administrator of the database has to create a uniq index as following SQL command:
--- `create unique index on nodes (typename, parent_id, (hyperdata ->> 'uniqId'));`
-insertDb :: InsertDb a => UserId -> ParentId -> [a] -> Cmd err [ReturnId]
+-- `create unique index on contexts table (typename, parent_id, (hyperdata ->> 'uniqId'));`
+insertDb :: (InsertDb a, HasDBid NodeType) => UserId -> ParentId -> [a] -> Cmd err [ReturnId]
 insertDb u p = runPGSQuery queryInsert . Only . Values fields . map (insertDb' u p)
       where
         fields    = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
 
 class InsertDb a
   where
-    insertDb' :: UserId -> ParentId -> a -> [Action]
+    insertDb' :: HasDBid NodeType => UserId -> ParentId -> a -> [Action]
 
 
 instance InsertDb HyperdataDocument
   where
-    insertDb' u p h = [ toField $ nodeTypeId NodeDocument
+    insertDb' u p h = [ toField ("" :: Text)
+                      , toField $ toDBid NodeDocument
                       , toField u
                       , toField p
                       , toField $ maybe "No Title" (DT.take 255)  (_hd_title h)
@@ -122,57 +114,67 @@ instance InsertDb HyperdataDocument
 
 instance InsertDb HyperdataContact
   where
-    insertDb' u p h = [ toField $ nodeTypeId NodeContact
+    insertDb' u p h = [ toField ("" :: Text)
+                      , toField $ toDBid NodeContact
                       , toField u
                       , toField p
                       , toField $ maybe "Contact" (DT.take 255) (Just "Name") -- (_hc_name h)
-                      , toField $ jour 2010 1 1 -- TODO put default date
+                      , toField $ jour 0 1 1 -- TODO put default date
                       , (toField . toJSON) h
                       ]
 
+instance ToJSON a => InsertDb (Node a)
+  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 . toJSON) h
+                                                     ]
+
 -- | Debug SQL function
 --
 -- to print rendered query (Debug purpose) use @formatQuery@ function.
 {-
-insertDocuments_Debug :: (Hyperdata a, ToJSON a, ToRow a) => UserId -> ParentId -> [a] -> Cmd ByteString
+insertDocuments_Debug :: (Hyperdata a, ToJSON a, ToRow a, InsertDb [a])
+                      => UserId -> ParentId -> [a] -> Cmd err ByteString
 insertDocuments_Debug uId pId hs = formatPGSQuery queryInsert (Only $ Values fields inputData)
   where
     fields    = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
-    inputData = prepare uId pId hs
+    inputData = insertDb' uId pId hs
 -}
 
-
 -- | Input Tables: types of the tables
 inputSqlTypes :: [Text]
-inputSqlTypes = map DT.pack ["int4","int4","int4","text","date","jsonb"]
+inputSqlTypes = map DT.pack ["text", "int4","int4","int4","text","date","jsonb"]
 
 -- | SQL query to insert documents inside the database
 queryInsert :: Query
 queryInsert = [sql|
-    WITH input_rows(typename,user_id,parent_id,name,date,hyperdata) AS (?)
+    WITH input_rows(hash_id,typename,user_id,parent_id,name,date,hyperdata) AS (?)
     , ins AS (
-       INSERT INTO nodes (typename,user_id,parent_id,name,date,hyperdata)
+       INSERT INTO contexts (hash_id, typename,user_id,parent_id,name,date,hyperdata)
        SELECT * FROM input_rows
-       ON CONFLICT ((hyperdata ->> 'uniqIdBdd')) DO NOTHING -- on unique index
-       -- ON CONFLICT (typename, parent_id, (hyperdata ->> 'uniqId')) DO NOTHING -- on unique index
-       RETURNING id,hyperdata
+       ON CONFLICT (hash_id) DO NOTHING -- on unique index -- this does not return the ids
+       RETURNING id,hash_id
        )
 
     SELECT true AS source                     -- true for 'newly inserted'
          , id
-         , hyperdata ->> 'uniqId'  as doi
+         , hash_id
     FROM   ins
     UNION  ALL
     SELECT false AS source                    -- false for 'not inserted'
-         , c.id
-         , hyperdata ->> 'uniqId' as doi
+         , n.id
+         , hash_id
     FROM   input_rows
-    JOIN   nodes c USING (hyperdata);         -- columns of unique index
+    JOIN   contexts n USING (hash_id);         -- columns of unique index
            |]
 
 ------------------------------------------------------------------------
 -- * Main Types used
-
 -- ** Return Types
 
 -- | When documents are inserted
@@ -205,11 +207,41 @@ instance AddUniqId HyperdataDocument
             shaBdd = hash $ DT.concat $ map ($ doc) ([(\d -> maybeText (_hd_bdd d))] <> shaParametersDoc)
 
         shaParametersDoc :: [(HyperdataDocument -> Text)]
-        shaParametersDoc = [ \d -> maybeText (_hd_title    d)
-                            , \d -> maybeText (_hd_abstract d)
-                            , \d -> maybeText (_hd_source   d)
-                            , \d -> maybeText (_hd_publication_date   d)
-                            ]
+        shaParametersDoc = [ \d -> maybeText (_hd_title            d)
+                           , \d -> maybeText (_hd_abstract         d)
+                           , \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 a, ToJSON a, HasDBid NodeType) => AddUniqId (Node a)
+  where
+    addUniqId (Node nid _ t u p n d h) = Node nid hashId t u p n d h
+                              where
+                                hashId = Just $ "\\x" <> (hash $ DT.concat params)
+                                params = [ secret
+                                         , cs $ show $ toDBid NodeDocument
+                                         , n
+                                         , cs $ show p
+                                         , cs $ encode h
+                                         ]
+    {-
+    addUniqId n@(Node nid _ t u p n d h)  =
+      case n of
+        Node HyperdataDocument -> Node nid hashId t u p n d h
+                              where
+                                hashId = "\\x" <> (hash $ DT.concat params)
+                                params = [ secret
+                                         , cs $ show $ toDBid NodeDocument
+                                         , n
+                                         , cs $ show p
+                                         , cs $ encode h
+                                         ]
+       _ -> undefined
+-}
 
     ---------------------------------------------------------------------------
 -- * Uniqueness of document definition
@@ -228,14 +260,37 @@ addUniqIdsContact hc = set (hc_uniqIdBdd) (Just shaBdd)
 
     -- | TODO add more shaparameters
     shaParametersContact :: [(HyperdataContact -> Text)]
-    shaParametersContact = [ \d -> maybeText $ view (hc_who . _Just . cw_firstName) d
-                            , \d -> maybeText $ view (hc_who . _Just . cw_lastName ) d
-                            , \d -> maybeText $ view (hc_where . _head . cw_touch . _Just . ct_mail) d
-                            ]
-
-
+    shaParametersContact = [ \d -> maybeText $ view (hc_who   . _Just . cw_firstName              ) d
+                           , \d -> maybeText $ view (hc_who   . _Just . cw_lastName               ) d
+                           , \d -> maybeText $ view (hc_where . _head . cw_touch . _Just . ct_mail) d
+                           ]
 
 maybeText :: Maybe Text -> Text
 maybeText = maybe (DT.pack "") identity
 
 ---------------------------------------------------------------------------
+class ToNode a
+  where
+    -- TODO Maybe NodeId
+    toNode :: HasDBid NodeType => UserId -> ParentId -> a -> Node a
+
+instance ToNode HyperdataDocument where
+  toNode u p h = Node 0 Nothing (toDBid NodeDocument) u (Just p) n date h
+    where
+      n    = maybe "No Title" (DT.take 255) (_hd_title h)
+      date  = jour y m d
+      -- NOTE: There is no year '0' in postgres, there is year 1 AD and beofre that year 1 BC:
+      -- select '0001-01-01'::date, '0001-01-01'::date - '1 day'::interval;
+      -- 0001-01-01    0001-12-31 00:00:00 BC
+      y = maybe 1 fromIntegral $ _hd_publication_year  h
+      m = fromMaybe 1 $ _hd_publication_month h
+      d = fromMaybe 1 $ _hd_publication_day   h
+
+-- TODO better Node
+instance ToNode HyperdataContact where
+  toNode u p h = Node 0 Nothing (toDBid NodeContact) u (Just p) "Contact" date h
+    where
+      date  = jour 2020 01 01
+
+
+