Commit 262a880b authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] data import, database upsert returning ids

parent 4838c6b8
...@@ -908,9 +908,9 @@ putListNgrams' :: RepoCmdM env err m ...@@ -908,9 +908,9 @@ putListNgrams' :: RepoCmdM env err m
-> Map NgramsTerm NgramsRepoElement -> Map NgramsTerm NgramsRepoElement
-> m () -> m ()
putListNgrams' nodeId ngramsType ns = do putListNgrams' nodeId ngramsType ns = do
printDebug "[putLictNgrams'] nodeId" nodeId -- printDebug "[putLictNgrams'] nodeId" nodeId
printDebug "[putLictNgrams'] ngramsType" ngramsType -- printDebug "[putLictNgrams'] ngramsType" ngramsType
printDebug "[putListNgrams'] ns" ns -- printDebug "[putListNgrams'] ns" ns
var <- view repoVar var <- view repoVar
liftBase $ modifyMVar_ var $ \r -> do liftBase $ modifyMVar_ var $ \r -> do
pure $ r & r_version +~ 1 pure $ r & r_version +~ 1
......
...@@ -156,7 +156,7 @@ buildNgramsTermsList _l _n _m s uCid mCid = do ...@@ -156,7 +156,7 @@ buildNgramsTermsList _l _n _m s uCid mCid = do
(map (toGargList ((isStopTerm s) .fst) MapTerm) candidatesHead) (map (toGargList ((isStopTerm s) .fst) MapTerm) candidatesHead)
<> (map (toGargList ((isStopTerm s) .fst) CandidateTerm) candidatesTail) <> (map (toGargList ((isStopTerm s) .fst) CandidateTerm) candidatesTail)
ngs = List.concat $ map toNgramsElement $ map (\(lt, (t,d)) -> (lt, ((t, (d,empty))))) termList ngs = List.concat $ map toNgramsElement $ map (\(lt, (t,d)) -> (lt, ((t, (d,Set.singleton t))))) termList
pure $ Map.fromList [(NgramsTerms, ngs)] pure $ Map.fromList [(NgramsTerms, ngs)]
......
...@@ -47,7 +47,7 @@ import Control.Lens ((^.), view, _Just, makeLenses) ...@@ -47,7 +47,7 @@ import Control.Lens ((^.), view, _Just, makeLenses)
import Data.Aeson.TH (deriveJSON) import Data.Aeson.TH (deriveJSON)
import Data.Either import Data.Either
import Data.List (concat) import Data.List (concat)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Map (Map, lookup) import Data.Map (Map, lookup)
import Data.Maybe (Maybe(..), catMaybes) import Data.Maybe (Maybe(..), catMaybes)
import Data.Monoid import Data.Monoid
...@@ -206,7 +206,7 @@ flowCorpusUser l user corpusName ctype ids = do ...@@ -206,7 +206,7 @@ flowCorpusUser l user corpusName ctype ids = do
-- TODO: check if present already, ignore -- TODO: check if present already, ignore
_ <- Doc.add userCorpusId ids _ <- Doc.add userCorpusId ids
_tId <- insertDefaultNode NodeTexts userCorpusId userId -- tId <- insertDefaultNode NodeTexts userCorpusId userId
-- printDebug "Node Text Id" tId -- printDebug "Node Text Id" tId
-- User List Flow -- User List Flow
...@@ -233,8 +233,11 @@ insertDocs :: ( FlowCmdM env err m ...@@ -233,8 +233,11 @@ insertDocs :: ( FlowCmdM env err m
-> CorpusId -> CorpusId
-> m ([DocId], [DocumentWithId a]) -> m ([DocId], [DocumentWithId a])
insertDocs hs uId cId = do insertDocs hs uId cId = do
printDebug "hs" (length hs)
let docs = map addUniqId hs let docs = map addUniqId hs
printDebug "docs" (length docs)
ids <- insertDb uId cId docs ids <- insertDb uId cId docs
printDebug "ids" (length ids)
let let
ids' = map reId ids ids' = map reId ids
documentsWithId = mergeData (toInserted ids) (Map.fromList $ map viewUniqId' docs) documentsWithId = mergeData (toInserted ids) (Map.fromList $ map viewUniqId' docs)
......
...@@ -153,7 +153,8 @@ queryInsert = [sql| ...@@ -153,7 +153,8 @@ queryInsert = [sql|
, ins AS ( , ins AS (
INSERT INTO nodes (typename,user_id,parent_id,name,date,hyperdata) INSERT INTO nodes (typename,user_id,parent_id,name,date,hyperdata)
SELECT * FROM input_rows SELECT * FROM input_rows
ON CONFLICT ((hyperdata ->> 'uniqIdBdd')) DO NOTHING -- on unique index ON CONFLICT ((hyperdata ->> 'uniqIdBdd')) DO UPDATE SET user_id=EXCLUDED.user_id -- on unique index
-- ON CONFLICT ((hyperdata ->> 'uniqIdBdd')) DO NOTHING -- on unique index -- this does not return the ids
-- ON CONFLICT (typename, parent_id, (hyperdata ->> 'uniqId')) DO NOTHING -- on unique index -- ON CONFLICT (typename, parent_id, (hyperdata ->> 'uniqId')) DO NOTHING -- on unique index
RETURNING id,hyperdata RETURNING id,hyperdata
) )
...@@ -205,11 +206,11 @@ instance AddUniqId HyperdataDocument ...@@ -205,11 +206,11 @@ instance AddUniqId HyperdataDocument
shaBdd = hash $ DT.concat $ map ($ doc) ([(\d -> maybeText (_hd_bdd d))] <> shaParametersDoc) shaBdd = hash $ DT.concat $ map ($ doc) ([(\d -> maybeText (_hd_bdd d))] <> shaParametersDoc)
shaParametersDoc :: [(HyperdataDocument -> Text)] shaParametersDoc :: [(HyperdataDocument -> Text)]
shaParametersDoc = [ \d -> maybeText (_hd_title d) shaParametersDoc = [ \d -> maybeText (_hd_title d)
, \d -> maybeText (_hd_abstract d) , \d -> maybeText (_hd_abstract d)
, \d -> maybeText (_hd_source d) , \d -> maybeText (_hd_source d)
, \d -> maybeText (_hd_publication_date d) , \d -> maybeText (_hd_publication_date d)
] ]
--------------------------------------------------------------------------- ---------------------------------------------------------------------------
-- * Uniqueness of document definition -- * Uniqueness of document definition
......
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