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 ?
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)
-- 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)
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
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
-- | 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
+
+
+