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
Pipeline #670 failed with stage
    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