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

[FIX] Docs Table scores

parent d807de52
...@@ -343,10 +343,10 @@ tableNgramsPull listId ngramsType p_version = do ...@@ -343,10 +343,10 @@ tableNgramsPull listId ngramsType p_version = do
-- Apply the given patch to the DB and returns the patch to be applied on the -- Apply the given patch to the DB and returns the patch to be applied on the
-- client. -- client.
-- TODO-ACCESS check -- TODO-ACCESS check
tableNgramsPut :: ( HasNodeStory env err m tableNgramsPut :: ( HasNodeStory env err m
, HasInvalidError err , HasInvalidError err
, HasSettings env , HasSettings env
, HasMail env , HasMail env
) )
=> TabType => TabType
-> ListId -> ListId
......
...@@ -64,6 +64,7 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..)) ...@@ -64,6 +64,7 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Query.Table.Node.Update (Update(..), update) import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata) import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Query.Table.NodeNode import Gargantext.Database.Query.Table.NodeNode
import Gargantext.Database.Query.Table.NodeContext (nodeContextsCategory, nodeContextsScore)
import Gargantext.Database.Query.Tree (tree, TreeMode(..)) import Gargantext.Database.Query.Tree (tree, TreeMode(..))
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Core.Viz.Phylo.Legacy.LegacyAPI (PhyloAPI, phyloAPI) import Gargantext.Core.Viz.Phylo.Legacy.LegacyAPI (PhyloAPI, phyloAPI)
...@@ -271,7 +272,7 @@ catApi :: CorpusId -> GargServer CatApi ...@@ -271,7 +272,7 @@ catApi :: CorpusId -> GargServer CatApi
catApi = putCat catApi = putCat
where where
putCat :: CorpusId -> NodesToCategory -> Cmd err [Int] putCat :: CorpusId -> NodesToCategory -> Cmd err [Int]
putCat cId cs' = nodeNodesCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs') putCat cId cs' = nodeContextsCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
------------------------------------------------------------------------ ------------------------------------------------------------------------
type ScoreApi = Summary " To Score NodeNodes" type ScoreApi = Summary " To Score NodeNodes"
...@@ -292,7 +293,7 @@ scoreApi :: CorpusId -> GargServer ScoreApi ...@@ -292,7 +293,7 @@ scoreApi :: CorpusId -> GargServer ScoreApi
scoreApi = putScore scoreApi = putScore
where where
putScore :: CorpusId -> NodesToScore -> Cmd err [Int] putScore :: CorpusId -> NodesToScore -> Cmd err [Int]
putScore cId cs' = nodeNodesScore $ map (\n -> (cId, n, nts_score cs')) (nts_nodesId cs') putScore cId cs' = nodeContextsScore $ map (\n -> (cId, n, nts_score cs')) (nts_nodesId cs')
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- TODO adapt FacetDoc -> ListDoc (and add type of document as column) -- TODO adapt FacetDoc -> ListDoc (and add type of document as column)
......
...@@ -268,6 +268,8 @@ flowCorpusUser l user corpusName ctype ids mfslw = do ...@@ -268,6 +268,8 @@ flowCorpusUser l user corpusName ctype ids mfslw = do
let gp = GroupWithPosTag l CoreNLP HashMap.empty let gp = GroupWithPosTag l CoreNLP HashMap.empty
ngs <- buildNgramsLists user userCorpusId masterCorpusId mfslw gp ngs <- buildNgramsLists user userCorpusId masterCorpusId mfslw gp
printDebug "flowCorpusUser:ngs" ngs
_userListId <- flowList_DbRepo listId ngs _userListId <- flowList_DbRepo listId ngs
_mastListId <- getOrMkList masterCorpusId masterUserId _mastListId <- getOrMkList masterCorpusId masterUserId
-- _ <- insertOccsUpdates userCorpusId mastListId -- _ <- insertOccsUpdates userCorpusId mastListId
...@@ -327,6 +329,8 @@ saveDocNgramsWith lId mapNgramsDocs' = do ...@@ -327,6 +329,8 @@ saveDocNgramsWith lId mapNgramsDocs' = do
$ map (first _ngramsTerms . second Map.keys) $ map (first _ngramsTerms . second Map.keys)
$ HashMap.toList mapNgramsDocs $ HashMap.toList mapNgramsDocs
printDebug "saveDocNgramsWith" mapCgramsId
-- insertDocNgrams -- insertDocNgrams
_return <- insertContextNodeNgrams2 _return <- insertContextNodeNgrams2
$ catMaybes [ ContextNodeNgrams2 <$> Just nId $ catMaybes [ ContextNodeNgrams2 <$> Just nId
...@@ -336,6 +340,7 @@ saveDocNgramsWith lId mapNgramsDocs' = do ...@@ -336,6 +340,7 @@ saveDocNgramsWith lId mapNgramsDocs' = do
, (ngrams_type, mapNodeIdWeight) <- Map.toList mapNgramsTypes , (ngrams_type, mapNodeIdWeight) <- Map.toList mapNgramsTypes
, (nId, w) <- Map.toList mapNodeIdWeight , (nId, w) <- Map.toList mapNodeIdWeight
] ]
-- to be removed -- to be removed
_ <- insertDocNgrams lId indexedNgrams _ <- insertDocNgrams lId indexedNgrams
......
...@@ -100,6 +100,7 @@ flowList_DbRepo lId ngs = do ...@@ -100,6 +100,7 @@ flowList_DbRepo lId ngs = do
_r <- insert_Node_NodeNgrams_NodeNgrams _r <- insert_Node_NodeNgrams_NodeNgrams
$ map (\(a,b) -> Node_NodeNgrams_NodeNgrams lId a b Nothing) toInsert $ map (\(a,b) -> Node_NodeNgrams_NodeNgrams lId a b Nothing) toInsert
printDebug "flowList_Tficf':ngs" ngs
listInsert lId ngs listInsert lId ngs
--trace (show $ List.filter (\n -> _ne_ngrams n == "versatile") $ List.concat $ Map.elems ngs) $ listInsert lId ngs --trace (show $ List.filter (\n -> _ne_ngrams n == "versatile") $ List.concat $ Map.elems ngs) $ listInsert lId ngs
......
...@@ -101,40 +101,22 @@ deleteNodeContext n c = mkCmd $ \conn -> ...@@ -101,40 +101,22 @@ deleteNodeContext n c = mkCmd $ \conn ->
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Favorite management -- | Favorite management
_nodeContextCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
_nodeContextCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
where
favQuery :: PGS.Query
favQuery = [sql|UPDATE nodes_contexts SET category = ?
WHERE node_id = ? AND context_id = ?
RETURNING context_id;
|]
nodeContextsCategory :: [(CorpusId, DocId, Int)] -> Cmd err [Int] nodeContextsCategory :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
nodeContextsCategory inputData = map (\(PGS.Only a) -> a) nodeContextsCategory inputData = map (\(PGS.Only a) -> a)
<$> runPGSQuery catQuery (PGS.Only $ Values fields inputData) <$> runPGSQuery catSelect (PGS.Only $ Values fields inputData)
where where
fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"] fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
catQuery :: PGS.Query catSelect :: PGS.Query
catQuery = [sql| UPDATE nodes_contexts as nn0 catSelect = [sql| UPDATE nodes_contexts as nn0
SET category = nn1.category SET category = nn1.category
FROM (?) as nn1(node_id,context_id,category) FROM (?) as nn1(node_id,context_id,category)
WHERE nn0.node1_id = nn1.node_id WHERE nn0.node_id = nn1.node_id
AND nn0.node2_id = nn1.context_id AND nn0.context_id = nn1.context_id
RETURNING nn1.context_id RETURNING nn1.node_id
|] |]
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Score management -- | Score management
_nodeContextScore :: CorpusId -> DocId -> Int -> Cmd err [Int]
_nodeContextScore cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery scoreQuery (c,cId,dId)
where
scoreQuery :: PGS.Query
scoreQuery = [sql|UPDATE nodes_contexts SET score = ?
WHERE node_id = ? AND context_id = ?
RETURNING context_id;
|]
nodeContextsScore :: [(CorpusId, DocId, Int)] -> Cmd err [Int] nodeContextsScore :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
nodeContextsScore inputData = map (\(PGS.Only a) -> a) nodeContextsScore inputData = map (\(PGS.Only a) -> a)
<$> runPGSQuery catScore (PGS.Only $ Values fields inputData) <$> runPGSQuery catScore (PGS.Only $ Values fields inputData)
...@@ -144,11 +126,12 @@ nodeContextsScore inputData = map (\(PGS.Only a) -> a) ...@@ -144,11 +126,12 @@ nodeContextsScore inputData = map (\(PGS.Only a) -> a)
catScore = [sql| UPDATE nodes_contexts as nn0 catScore = [sql| UPDATE nodes_contexts as nn0
SET score = nn1.score SET score = nn1.score
FROM (?) as nn1(node_id, context_id, score) FROM (?) as nn1(node_id, context_id, score)
WHERE nn0.node_id = nn1.node_id WHERE nn0.node_id = nn1.node_id
AND nn0.context_id = nn1.context_id AND nn0.context_id = nn1.context_id
RETURNING nn1.context_id RETURNING nn1.context_id
|] |]
------------------------------------------------------------------------ ------------------------------------------------------------------------
selectCountDocs :: HasDBid NodeType => CorpusId -> Cmd err Int selectCountDocs :: HasDBid NodeType => CorpusId -> Cmd err Int
selectCountDocs cId = runCountOpaQuery (queryCountDocs cId) selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
......
...@@ -24,8 +24,6 @@ module Gargantext.Database.Query.Table.NodeNode ...@@ -24,8 +24,6 @@ module Gargantext.Database.Query.Table.NodeNode
, selectDocsDates , selectDocsDates
, selectDocNodes , selectDocNodes
, selectDocs , selectDocs
, nodeNodesCategory
, nodeNodesScore
, getNodeNode , getNodeNode
, insertNodeNode , insertNodeNode
, deleteNodeNode , deleteNodeNode
...@@ -38,9 +36,6 @@ import Control.Arrow (returnA) ...@@ -38,9 +36,6 @@ import Control.Arrow (returnA)
import Control.Lens (view, (^.)) import Control.Lens (view, (^.))
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import Data.Text (Text, splitOn) import Data.Text (Text, splitOn)
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
import qualified Opaleye as O import qualified Opaleye as O
import Opaleye import Opaleye
...@@ -124,56 +119,6 @@ deleteNodeNode n1 n2 = mkCmd $ \conn -> ...@@ -124,56 +119,6 @@ deleteNodeNode n1 n2 = mkCmd $ \conn ->
rCount rCount
) )
------------------------------------------------------------------------
-- | Favorite management
_nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
_nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favSelect (c,cId,dId)
where
favSelect :: PGS.Query
favSelect = [sql|UPDATE nodes_nodes SET category = ?
WHERE node1_id = ? AND node2_id = ?
RETURNING node2_id;
|]
nodeNodesCategory :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
<$> runPGSQuery catSelect (PGS.Only $ Values fields inputData)
where
fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
catSelect :: PGS.Query
catSelect = [sql| UPDATE nodes_nodes as nn0
SET category = nn1.category
FROM (?) as nn1(node1_id,node2_id,category)
WHERE nn0.node1_id = nn1.node1_id
AND nn0.node2_id = nn1.node2_id
RETURNING nn1.node2_id
|]
------------------------------------------------------------------------
-- | Score management
_nodeNodeScore :: CorpusId -> DocId -> Int -> Cmd err [Int]
_nodeNodeScore cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery scoreSelect (c,cId,dId)
where
scoreSelect :: PGS.Query
scoreSelect = [sql|UPDATE nodes_nodes SET score = ?
WHERE node1_id = ? AND node2_id = ?
RETURNING node2_id;
|]
nodeNodesScore :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
nodeNodesScore inputData = map (\(PGS.Only a) -> a)
<$> runPGSQuery catScore (PGS.Only $ Values fields inputData)
where
fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
catScore :: PGS.Query
catScore = [sql| UPDATE nodes_nodes as nn0
SET score = nn1.score
FROM (?) as nn1(node1_id, node2_id, score)
WHERE nn0.node1_id = nn1.node1_id
AND nn0.node2_id = nn1.node2_id
RETURNING nn1.node2_id
|]
------------------------------------------------------------------------ ------------------------------------------------------------------------
selectCountDocs :: HasDBid NodeType => CorpusId -> Cmd err Int selectCountDocs :: HasDBid NodeType => CorpusId -> Cmd err Int
selectCountDocs cId = runCountOpaQuery (queryCountDocs cId) selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
......
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