Skip to content

haskell-gargantext
haskell-gargantext
Commit b2bad24e authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[DB][FIX] SQL NodeNgrams query.

parent 2604c7a4
Hide whitespace changes
Inline Side-by-side
Showing with 57 additions and 43 deletions
devops/postgres/schema.sql
View file @ b2bad24e
......@@ -148,6 +148,7 @@ CREATE UNIQUE INDEX ON public.nodes USING btree (typename, parent_id, ((hyperdat
CREATE UNIQUE INDEX ON public.ngrams (terms); -- TEST GIN
CREATE INDEX ON public.ngrams USING btree (id, terms);
CREATE UNIQUE INDEX ON public.node_ngrams USING btree (node_id,node_subtype, ngrams_id);
CREATE INDEX ON public.nodes_nodes USING btree (node1_id, node2_id, category);
CREATE UNIQUE INDEX ON public.nodes_nodes USING btree (node1_id, node2_id);
......
src/Gargantext/API/Node.hs
View file @ b2bad24e
......@@ -60,7 +60,7 @@ import Gargantext.Core.Types.Main (Tree, NodeTree, ListType)
import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Database.Facet (FacetDoc, OrderBy(..))
import Gargantext.Database.Node.Children (getChildren)
import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNode, getNode', deleteNode, deleteNodes, mkNodeWithParent, JSONB, HasNodeError(..))
import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNodeWith, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, HasNodeError(..))
import Gargantext.Database.Schema.NodeNode (nodeNodesCategory)
import Gargantext.Database.Tree (treeDB)
import Gargantext.Database.Types.Node
......@@ -169,7 +169,7 @@ nodeNodeAPI :: forall proxy a. (JSONB a, ToJSON a) => proxy a -> UserId -> Corpu
nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uId (PathNodeNode cId nId) nodeNodeAPI'
where
nodeNodeAPI' :: GargServer (NodeNodeAPI a)
nodeNodeAPI' = getNode nId p
nodeNodeAPI' = getNodeWith nId p
......@@ -179,7 +179,7 @@ nodeAPI :: forall proxy a. (JSONB a, ToJSON a) => proxy a -> UserId -> NodeId ->
nodeAPI p uId id = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode id) nodeAPI'
where
nodeAPI' :: GargServer (NodeAPI a)
nodeAPI' = getNode id p
nodeAPI' = getNodeWith id p
:<|> rename id
:<|> postNode uId id
:<|> putNode id
......@@ -205,7 +205,7 @@ nodeAPI p uId id = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode i
-- :<|> postUpload id
deleteNodeApi id' = do
node <- getNode' id'
node <- getNode id'
if _node_typename node == nodeTypeId NodeUser
then panic "not allowed" -- TODO add proper Right Management Type
else deleteNode id'
......@@ -337,7 +337,7 @@ rename nId (RenameNode name') = U.update (U.Rename nId name')
postNode :: HasNodeError err => UserId -> NodeId -> PostNode -> Cmd err [NodeId]
postNode uId pId (PostNode nodeName nt) = do
nodeUser <- getNode (NodeId uId) HyperdataUser
nodeUser <- getNodeWith (NodeId uId) HyperdataUser
let uId' = nodeUser ^. node_userId
mkNodeWithParent nt (Just pId) uId' nodeName
......
src/Gargantext/Database/Config.hs
View file @ b2bad24e
......@@ -57,14 +57,15 @@ nodeTypeId n =
---- Lists
NodeList -> 5
NodeListModel -> 10
NodeListCooc -> 50
NodeListModel -> 52
---- Scores
-- NodeOccurrences -> 10
NodeGraph -> 9
NodePhylo -> 90
NodeDashboard -> 7
NodeChart -> 51
NodeChart -> 7
NodeDashboard -> 71
NodeNoteBook -> 88
-- Cooccurrences -> 9
......
src/Gargantext/Database/Flow.hs
View file @ b2bad24e
......@@ -221,20 +221,21 @@ flowCorpusUser l userName corpusName ctype ids = do
-- User Flow
(userId, _rootId, userCorpusId) <- getOrMkRootWithCorpus userName corpusName ctype
listId <- getOrMkList userCorpusId userId
_cooc <- mkNode NodeListCooc listId userId
-- TODO: check if present already, ignore
_ <- Doc.add userCorpusId ids
tId <- mkNode NodeTexts userCorpusId userId
printDebug "Node Text Id" tId
_tId <- mkNode NodeTexts userCorpusId userId
-- printDebug "Node Text Id" tId
-- User List Flow
--{-
(_masterUserId, _masterRootId, masterCorpusId) <- getOrMkRootWithCorpus userMaster (Left "") ctype
ngs <- buildNgramsLists l 2 3 (StopSize 3) userCorpusId masterCorpusId
userListId <- flowList listId ngs
_userListId <- flowList listId ngs
--mastListId <- getOrMkList masterCorpusId masterUserId
-- _ <- insertOccsUpdates userCorpusId mastListId
printDebug "userListId" userListId
-- printDebug "userListId" userListId
-- User Graph Flow
_ <- mkDashboard userCorpusId userId
_ <- mkGraph userCorpusId userId
......@@ -284,6 +285,7 @@ insertMasterDocs c lang hs = do
let indexedNgrams = Map.mapKeys (indexNgrams terms2id) maps
lId <- getOrMkList masterCorpusId masterUserId
_cooc <- mkNode NodeListCooc lId masterUserId
_ <- insertDocNgrams lId indexedNgrams
pure $ map reId ids
......@@ -494,7 +496,8 @@ flowList :: FlowCmdM env err m
flowList lId ngs = do
printDebug "listId flowList" lId
-- TODO save in database
_ <- listInsertDb lId toNodeNgramsW (Map.toList ngs)
r <- listInsertDb lId toNodeNgramsW (Map.toList ngs)
printDebug "result " r
listInsert lId ngs
--trace (show $ List.filter (\n -> _ne_ngrams n == "versatile") $ List.concat $ Map.elems ngs) $ listInsert lId ngs
pure lId
......
src/Gargantext/Database/Schema/Node.hs
View file @ b2bad24e
......@@ -281,6 +281,7 @@ nodeTableSearch = Table "nodes" (pNodeSearch NodeSearch { _ns_id = optio
}
)
queryNodeSearchTable :: Query NodeSearchRead
queryNodeSearchTable = queryTable nodeTableSearch
......@@ -371,8 +372,13 @@ selectNodesWithType type_id = proc () -> do
type JSONB = QueryRunnerColumnDefault PGJsonb
getNode :: JSONB a => NodeId -> proxy a -> Cmd err (Node a)
getNode nId _ = do
getNode :: NodeId -> Cmd err (Node Value)
getNode nId = fromMaybe (error $ "Node does not exist: " <> show nId) . headMay
<$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
getNodeWith :: JSONB a => NodeId -> proxy a -> Cmd err (Node a)
getNodeWith nId _ = do
fromMaybe (error $ "Node does not exist: " <> show nId) . headMay
<$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
......@@ -382,11 +388,6 @@ getNodePhylo nId = do
<$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
getNode' :: NodeId -> Cmd err (Node Value)
getNode' nId = fromMaybe (error $ "Node does not exist: " <> show nId) . headMay
<$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
getNodesWithType :: Column PGInt4 -> Cmd err [Node HyperdataDocument]
getNodesWithType = runOpaQuery . selectNodesWithType
......@@ -464,12 +465,14 @@ instance HasDefault NodeType where
hasDefaultData nt = case nt of
NodeTexts -> HyperdataTexts (Just "Preferences")
NodeList -> HyperdataList' (Just "Preferences")
NodeListCooc -> HyperdataList' (Just "Preferences")
_ -> undefined
--NodeAnnuaire -> HyperdataAnnuaire (Just "Title") (Just "Description")
hasDefaultName nt = case nt of
NodeTexts -> "Texts"
NodeList -> "Lists"
NodeListCooc -> "Cooc"
_ -> undefined
------------------------------------------------------------------------
......@@ -717,3 +720,4 @@ pgNodeId = pgInt4 . id2int
getListsWithParentId :: NodeId -> Cmd err [Node HyperdataList]
getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)
src/Gargantext/Database/Schema/NodeNgrams.hs
View file @ b2bad24e
......@@ -30,13 +30,14 @@ import Data.Text (Text)
import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Database.PostgreSQL.Simple.FromRow (fromRow, field)
import Database.PostgreSQL.Simple.ToField (toField)
import Database.PostgreSQL.Simple (FromRow)
import Database.PostgreSQL.Simple.SqlQQ (sql)
-- import Control.Lens.TH (makeLenses)
import Data.Maybe (Maybe, fromMaybe)
import Gargantext.Core.Types
import Gargantext.Database.Utils
import Gargantext.Database.Schema.Ngrams (NgramsType, NgramsTypeId, ngramsTypeId)
import Gargantext.Database.Schema.Ngrams (NgramsType, ngramsTypeId)
import Gargantext.Prelude
data NodeNgramsPoly id
......@@ -114,7 +115,7 @@ instance FromRow Returning where
fromRow = Returning <$> field <*> field
-- insertDb :: ListId -> Map NgramsType [NgramsElemet] -> Cmd err [Result]
listInsertDb :: ListId
listInsertDb :: Show a => ListId
-> (ListId -> a -> [NodeNgramsW])
-> a
-> Cmd err [Returning]
......@@ -127,26 +128,30 @@ insertNodeNgrams nns = runPGSQuery query (PGS.Only $ Values fields nns')
fields = map (\t-> QualifiedIdentifier Nothing t) [ "int4","int4","text","int4"
,"int4","int4","int4","int4"
,"float8"]
nns' :: [(Int, ListTypeId, NgramsText, NgramsTypeId ,NgramsField, NgramsTag, NgramsClass, Double)]
-- nns' :: [(Int, ListTypeId, NgramsText, NgramsTypeId ,NgramsField, NgramsTag, NgramsClass, Double)]
nns' = map (\(NodeNgrams _id (NodeId node_id'') node_subtype ngrams_terms ngrams_type ngrams_field ngrams_tag ngrams_class weight)
-> ( node_id''
, listTypeId node_subtype
, ngrams_terms
, ngramsTypeId ngrams_type
, fromMaybe 0 ngrams_field
, fromMaybe 0 ngrams_tag
, fromMaybe 0 ngrams_class
, weight
)
-> [ toField node_id''
, toField $ listTypeId node_subtype
, toField $ ngrams_terms
, toField $ ngramsTypeId ngrams_type
, toField $ fromMaybe 0 ngrams_field
, toField $ fromMaybe 0 ngrams_tag
, toField $ fromMaybe 0 ngrams_class
, toField weight
]
) nns
query :: PGS.Query
query = [sql|
INSERT INTO node_ngrams_ngrams nnn VALUES (node_id, node_type, ngrams_id, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight)
SELECT n.node_id, n.node_type, ng.ngrams_id, n.ngrams_type, n.ngrams_field, n.ngrams_tag, n.ngrams_class, n.weight FROM (?)
AS n(node_id, node_type, ngrams_terms, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight)
INNER JOIN ngrams as ng ON ng.terms = n.ngrams_terms
ON CONFLICT(node_id, ngrams_id)
DO UPDATE SET node_type = excluded.node_type, ngrams_type = excluded.ngrams_type, ngrams_field = excluded.ngrams_field, ngrams_tag = excluded.ngrams_tag, ngrams_class = excluded.ngrams_class, weight = excluded.weight
RETURNING nnn.id, n.ngrams_terms
WITH input(node_id, node_subtype, ngrams_terms, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight) AS (?),
return(id, ngrams_id) AS (
INSERT INTO node_ngrams (node_id, node_subtype, ngrams_id, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight)
SELECT i.node_id, i.node_subtype, ng.id, i.ngrams_type, i.ngrams_field, i.ngrams_tag, i.ngrams_class, i.weight FROM input as i
INNER JOIN ngrams as ng ON ng.terms = i.ngrams_terms
ON CONFLICT(node_id, node_subtype, ngrams_id)
DO UPDATE SET node_subtype = excluded.node_subtype, ngrams_type = excluded.ngrams_type, ngrams_field = excluded.ngrams_field, ngrams_tag = excluded.ngrams_tag, ngrams_class = excluded.ngrams_class, weight = excluded.weight
RETURNING id, ngrams_id
)
SELECT ng.terms, return.id FROM return
INNER JOIN ngrams ng ON return.ngrams_id = ng.id;
|]
src/Gargantext/Database/Schema/Node_NodeNgrams_NodeNgrams.hs
View file @ b2bad24e
......@@ -119,4 +119,3 @@ insert_Node_NodeNgrams_NodeNgrams_W ns =
, iReturning = rCount
, iOnConflict = (Just DoNothing)
}
src/Gargantext/Database/Types/Node.hs
View file @ b2bad24e
......@@ -444,6 +444,7 @@ data NodeType = NodeUser
| NodeGraph | NodePhylo
| NodeDashboard | NodeChart | NodeNoteBook
| NodeList | NodeListModel
| NodeListCooc
deriving (Show, Read, Eq, Generic, Bounded, Enum)
......
src/Gargantext/Viz/Graph/API.hs
View file @ b2bad24e
......@@ -36,7 +36,7 @@ import Gargantext.Database.Config
import Gargantext.Database.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
import Gargantext.Database.Schema.Ngrams
import Gargantext.Database.Node.Select
import Gargantext.Database.Schema.Node (getNode, defaultList, insertGraph)
import Gargantext.Database.Schema.Node (getNodeWith, defaultList, insertGraph)
import Gargantext.Database.Types.Node hiding (node_id) -- (GraphId, ListId, CorpusId, NodeId)
import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Prelude
......@@ -63,7 +63,7 @@ graphAPI u n = getGraph u n
getGraph :: UserId -> NodeId -> GargServer (Get '[JSON] Graph)
getGraph uId nId = do
nodeGraph <- getNode nId HyperdataGraph
nodeGraph <- getNodeWith nId HyperdataGraph
let graph = nodeGraph ^. node_hyperdata . hyperdataGraph
let graphVersion = graph ^? _Just
. graph_metadata
......@@ -71,7 +71,7 @@ getGraph uId nId = do
. gm_version
v <- currentVersion
nodeUser <- getNode (NodeId uId) HyperdataUser
nodeUser <- getNodeWith (NodeId uId) HyperdataUser
let uId' = nodeUser ^. node_userId
......
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