Commit bdf919f2 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge remote-tracking branch 'origin/374-dev-document-fix' into dev

parents b87c1360 fd45f6ca
...@@ -5,6 +5,7 @@ services: ...@@ -5,6 +5,7 @@ services:
#image: 'postgres:latest' #image: 'postgres:latest'
image: 'postgres:11' image: 'postgres:11'
network_mode: host network_mode: host
#command: ["postgres", "-c", "log_statement=all"]
#ports: #ports:
#- 5432:5432 #- 5432:5432
environment: environment:
......
...@@ -349,7 +349,7 @@ insertMasterDocs :: ( FlowCmdM env err m ...@@ -349,7 +349,7 @@ insertMasterDocs :: ( FlowCmdM env err m
-> m [DocId] -> m [DocId]
insertMasterDocs c lang hs = do insertMasterDocs c lang hs = do
(masterUserId, _, masterCorpusId) <- getOrMk_RootWithCorpus (UserName userMaster) (Left corpusMasterName) c (masterUserId, _, masterCorpusId) <- getOrMk_RootWithCorpus (UserName userMaster) (Left corpusMasterName) c
(ids', documentsWithId) <- insertDocs masterUserId masterCorpusId (map (toNode masterUserId masterCorpusId) hs ) (ids', documentsWithId) <- insertDocs masterUserId masterCorpusId (map (toNode masterUserId Nothing) hs )
_ <- Doc.add masterCorpusId ids' _ <- Doc.add masterCorpusId ids'
-- TODO -- TODO
-- create a corpus with database name (CSV or PubMed) -- create a corpus with database name (CSV or PubMed)
...@@ -413,7 +413,7 @@ insertDocs :: ( FlowCmdM env err m ...@@ -413,7 +413,7 @@ insertDocs :: ( FlowCmdM env err m
-> m ([ContextId], [Indexed ContextId a]) -> m ([ContextId], [Indexed ContextId a])
insertDocs uId cId hs = do insertDocs uId cId hs = do
let docs = map addUniqId hs let docs = map addUniqId hs
newIds <- insertDb uId cId docs newIds <- insertDb uId Nothing docs
-- printDebug "newIds" newIds -- printDebug "newIds" newIds
let let
newIds' = map reId newIds newIds' = map reId newIds
......
...@@ -92,14 +92,14 @@ import Database.PostgreSQL.Simple (formatQuery) ...@@ -92,14 +92,14 @@ import Database.PostgreSQL.Simple (formatQuery)
-- ParentId : folder ID which is parent of the inserted 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: -- Administrator of the database has to create a uniq index as following SQL command:
-- `create unique index on contexts table (typename, parent_id, (hyperdata ->> 'uniqId'));` -- `create unique index on contexts table (typename, parent_id, (hyperdata ->> 'uniqId'));`
insertDb :: (InsertDb a, HasDBid NodeType) => UserId -> ParentId -> [a] -> Cmd err [ReturnId] insertDb :: (InsertDb a, HasDBid NodeType) => UserId -> Maybe ParentId -> [a] -> Cmd err [ReturnId]
insertDb u p = runPGSQuery queryInsert . Only . Values fields . map (insertDb' u p) insertDb u p = runPGSQuery queryInsert . Only . Values fields . map (insertDb' u p)
where where
fields = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes fields = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
class InsertDb a class InsertDb a
where where
insertDb' :: HasDBid NodeType => UserId -> ParentId -> a -> [Action] insertDb' :: HasDBid NodeType => UserId -> Maybe ParentId -> a -> [Action]
instance InsertDb HyperdataDocument instance InsertDb HyperdataDocument
...@@ -273,10 +273,10 @@ maybeText = maybe (DT.pack "") identity ...@@ -273,10 +273,10 @@ maybeText = maybe (DT.pack "") identity
class ToNode a class ToNode a
where where
-- TODO Maybe NodeId -- TODO Maybe NodeId
toNode :: HasDBid NodeType => UserId -> ParentId -> a -> Node a toNode :: HasDBid NodeType => UserId -> Maybe ParentId -> a -> Node a
instance ToNode HyperdataDocument where instance ToNode HyperdataDocument where
toNode u p h = Node 0 Nothing (toDBid NodeDocument) u (Just p) n date h toNode u p h = Node 0 Nothing (toDBid NodeDocument) u p n date h
where where
n = maybe "No Title" (DT.take 255) (_hd_title h) n = maybe "No Title" (DT.take 255) (_hd_title h)
date = jour y m d date = jour y m d
...@@ -289,7 +289,7 @@ instance ToNode HyperdataDocument where ...@@ -289,7 +289,7 @@ instance ToNode HyperdataDocument where
-- TODO better Node -- TODO better Node
instance ToNode HyperdataContact where instance ToNode HyperdataContact where
toNode u p h = Node 0 Nothing (toDBid NodeContact) u (Just p) "Contact" date h toNode u p h = Node 0 Nothing (toDBid NodeContact) u p "Contact" date h
where where
date = jour 2020 01 01 date = jour 2020 01 01
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment