Skip to content

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

[API/DB] Fav AND Delete in NodeNode => category as Int wher 0 = Deleted, 1 or... 

[API/DB] Fav AND Delete in NodeNode => category as Int wher 0 = Deleted, 1 or null = Neutral, 2 = Favorite.
parent c7a1072d
Pipeline #523 failed with stage
    Hide whitespace changes
    Inline Side-by-side
    Showing with 67 additions and 99 deletions
    devops/postgres/schema.sql
    View file @ bb3587d3
    ......@@ -84,8 +84,7 @@ CREATE TABLE public.nodes_nodes (
    node1_id integer NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE,
    node2_id integer NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE,
    score real,
    favorite boolean,
    delete boolean,
    category integer,
    PRIMARY KEY (node1_id,node2_id)
    );
    ALTER TABLE public.nodes_nodes OWNER TO gargantua;
    ......@@ -141,7 +140,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.nodes_nodes USING btree (node1_id, node2_id, delete);
    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);
    CREATE UNIQUE INDEX ON public.node_node_ngrams USING btree (node1_id, node2_id, ngrams_id, ngrams_type);
    ......
    src/Gargantext/API/Node.hs
    View file @ bb3587d3
    ......@@ -59,7 +59,7 @@ import Gargantext.Database.Config (nodeTypeId)
    import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..),runViewAuthorsDoc)
    import Gargantext.Database.Node.Children (getChildren)
    import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNode, getNode', deleteNode, deleteNodes, mkNodeWithParent, JSONB, HasNodeError(..))
    import Gargantext.Database.Schema.NodeNode (nodesToFavorite, nodesToTrash)
    import Gargantext.Database.Schema.NodeNode (nodeNodesCategory)
    import Gargantext.Database.Tree (treeDB)
    import Gargantext.Database.Types.Node
    import Gargantext.Database.Utils -- (Cmd, CmdM)
    ......@@ -132,8 +132,7 @@ type NodeAPI a = Get '[JSON] (Node a)
    :<|> "ngrams" :> TableNgramsApi
    :<|> "pairing" :> PairingApi
    :<|> "favorites" :> FavApi
    :<|> "documents" :> DocsApi
    :<|> "category" :> CatApi
    :<|> "search" :> SearchDocsAPI
    -- VIZ
    ......@@ -176,9 +175,10 @@ nodeAPI p uId id
    :<|> getPairing id
    -- :<|> getTableNgramsDoc id
    :<|> favApi id
    :<|> delDocs id
    :<|> catApi id
    :<|> searchDocs id
    :<|> getScatter id
    :<|> getChart id
    :<|> getPie id
    ......@@ -194,8 +194,6 @@ nodeAPI p uId id
    -- Annuaire
    -- :<|> query
    ------------------------------------------------------------------------
    data RenameNode = RenameNode { r_name :: Text }
    deriving (Generic)
    ......@@ -217,43 +215,25 @@ instance Arbitrary PostNode where
    arbitrary = elements [PostNode "Node test" NodeCorpus]
    ------------------------------------------------------------------------
    type DocsApi = Summary "Docs : Move to trash"
    :> ReqBody '[JSON] Documents
    :> Delete '[JSON] [Int]
    data Documents = Documents { documents :: [NodeId]}
    deriving (Generic)
    instance FromJSON Documents
    instance ToJSON Documents
    instance ToSchema Documents
    delDocs :: CorpusId -> Documents -> Cmd err [Int]
    delDocs cId ds = nodesToTrash $ map (\n -> (cId, n, True)) $ documents ds
    ------------------------------------------------------------------------
    type FavApi = Summary " Favorites label"
    :> ReqBody '[JSON] Favorites
    type CatApi = Summary " To Categorize NodeNodes"
    :> ReqBody '[JSON] NodesToCategory
    :> Put '[JSON] [Int]
    :<|> Summary " Favorites unlabel"
    :> ReqBody '[JSON] Favorites
    :> Delete '[JSON] [Int]
    data Favorites = Favorites { favorites :: [NodeId]}
    data NodesToCategory = NodesToCategory { ntc_nodesId :: [NodeId]
    , ntc_category :: Int
    }
    deriving (Generic)
    instance FromJSON Favorites
    instance ToJSON Favorites
    instance ToSchema Favorites
    putFav :: CorpusId -> Favorites -> Cmd err [Int]
    putFav cId fs = nodesToFavorite $ map (\n -> (cId, n, True)) $ favorites fs
    instance FromJSON NodesToCategory
    instance ToJSON NodesToCategory
    instance ToSchema NodesToCategory
    delFav :: CorpusId -> Favorites -> Cmd err [Int]
    delFav cId fs = nodesToFavorite $ map (\n -> (cId, n, False)) $ favorites fs
    catApi :: CorpusId -> GargServer CatApi
    catApi = putCat
    where
    putCat :: CorpusId -> NodesToCategory -> Cmd err [Int]
    putCat cId cs' = nodeNodesCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
    favApi :: CorpusId -> GargServer FavApi
    favApi cId = putFav cId :<|> delFav cId
    ------------------------------------------------------------------------
    type TableApi = Summary " Table API"
    ......
    src/Gargantext/Database/Facet.hs
    View file @ bb3587d3
    ......@@ -65,7 +65,7 @@ import qualified Opaleye.Internal.Unpackspec()
    --instance FromJSON Facet
    --instance ToJSON Facet
    type Favorite = Bool
    type Favorite = Int
    type Title = Text
    -- TODO remove Title
    ......@@ -146,12 +146,12 @@ instance ToSchema FacetDoc
    -- | Mock and Quickcheck instances
    instance Arbitrary FacetDoc where
    arbitrary = elements [ FacetDoc id' (jour year 01 01) t hp fav ngramCount
    arbitrary = elements [ FacetDoc id' (jour year 01 01) t hp cat ngramCount
    | id' <- [1..10]
    , year <- [1990..2000]
    , t <- ["title", "another title"]
    , hp <- arbitraryHyperdataDocuments
    , fav <- [True, False]
    , cat <- [0..2]
    , ngramCount <- [3..100]
    ]
    ......@@ -164,8 +164,8 @@ type FacetDocRead = Facet (Column PGInt4 )
    (Column PGTimestamptz)
    (Column PGText )
    (Column PGJsonb )
    (Column PGBool)
    (Column PGInt4 )
    (Column PGInt4 ) -- Category
    (Column PGInt4 ) -- Score
    -----------------------------------------------------------------------
    -----------------------------------------------------------------------
    ......@@ -215,7 +215,7 @@ viewAuthorsDoc cId _ nt = proc () -> do
    restrict -< _node_id contact .== (toNullable $ pgNodeId cId)
    restrict -< _node_typename doc .== (pgInt4 $ nodeTypeId nt)
    returnA -< FacetDoc (_node_id doc) (_node_date doc) (_node_name doc) (_node_hyperdata doc) (pgBool True) (pgInt4 1)
    returnA -< FacetDoc (_node_id doc) (_node_date doc) (_node_name doc) (_node_hyperdata doc) (pgInt4 1) (pgInt4 1)
    queryAuthorsDoc :: Query (NodeRead, (NodeNgramReadNull, (NgramsReadNull, (NodeNgramReadNull, NodeReadNull))))
    queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNgramTable queryNgramsTable queryNodeNgramTable queryNodeTable cond12 cond23 cond34 cond45
    ......@@ -250,8 +250,9 @@ viewDocuments cId t ntId = proc () -> do
    restrict -< _node_id n .== nn_node2_id nn
    restrict -< nn_node1_id nn .== (pgNodeId cId)
    restrict -< _node_typename n .== (pgInt4 ntId)
    restrict -< nn_delete nn .== (pgBool t)
    returnA -< FacetDoc (_node_id n) (_node_date n) (_node_name n) (_node_hyperdata n) (nn_favorite nn) (pgInt4 1)
    restrict -< if t then nn_category nn .== (pgInt4 0)
    else nn_category nn .>= (pgInt4 1)
    returnA -< FacetDoc (_node_id n) (_node_date n) (_node_name n) (_node_hyperdata n) (nn_category nn) (pgInt4 1)
    ------------------------------------------------------------------------
    ......
    src/Gargantext/Database/Learn.hs
    View file @ bb3587d3
    ......@@ -27,8 +27,7 @@ import Gargantext.Prelude
    import Gargantext.Text.Learn
    import qualified Data.List as List
    import qualified Data.Text as Text
    import Gargantext.Database.Schema.NodeNode (nodesToFavorite)
    import Gargantext.API.Node (delDocs, Documents(..))
    import Gargantext.Database.Schema.NodeNode (nodeNodesCategory)
    --import Gargantext.Database.Utils (Cmd)
    --import Gargantext.Database.Schema.Node (HasNodeError)
    import Gargantext.API
    ......@@ -54,7 +53,7 @@ getPriors :: FlowCmdM DevEnv GargError m => FavOrTrash -> CorpusId -> m (Events
    getPriors ft cId = do
    docs_trash <- runViewDocuments cId True Nothing Nothing Nothing
    docs_fav <- filter (\(FacetDoc _ _ _ _ f _) -> f == True)
    docs_fav <- filter (\(FacetDoc _ _ _ _ f _) -> f == 2)
    <$> runViewDocuments cId False Nothing Nothing Nothing
    ......@@ -67,7 +66,7 @@ getPriors ft cId = do
    moreLikeWith :: FlowCmdM DevEnv GargError m => Events Bool -> FavOrTrash -> CorpusId -> m [FacetDoc]
    moreLikeWith priors ft cId = do
    docs_test <- filter (\(FacetDoc _ _ _ _ f _) -> f == False)
    docs_test <- filter (\(FacetDoc _ _ _ _ f _) -> f == 0)
    <$> runViewDocuments cId False Nothing Nothing Nothing
    let results = map fst
    ......@@ -91,8 +90,8 @@ text (FacetDoc _ _ _ h _ _) = title <> "" <> Text.take 100 abstr
    apply :: (FlowCmdM DevEnv GargError m) => FavOrTrash -> CorpusId -> [NodeId] -> m [Int]
    apply favTrash cId ns = case favTrash of
    IsFav -> nodesToFavorite $ map (\n -> (cId, n, True)) ns
    IsTrash -> delDocs cId (Documents ns)
    IsFav -> nodeNodesCategory $ map (\n -> (cId, n, 2)) ns
    IsTrash -> nodeNodesCategory $ map (\n -> (cId, n, 0)) ns
    moreLikeAndApply :: FlowCmdM DevEnv GargError m => FavOrTrash -> CorpusId -> m [Int]
    moreLikeAndApply ft cId = do
    ......
    src/Gargantext/Database/Metrics/NgramsByNode.hs
    View file @ bb3587d3
    ......@@ -149,7 +149,7 @@ getNodesByNgramsUser cId nt =
    WHERE nn.node1_id = ? -- CorpusId
    AND n.typename = ? -- NodeTypeId
    AND nng.ngrams_type = ? -- NgramsTypeId
    AND nn.delete = False
    AND nn.category > 0
    GROUP BY nng.node2_id, ng.terms
    ORDER BY (nng.node2_id, ng.terms) DESC
    -- LIMIT ?
    ......@@ -210,7 +210,7 @@ queryNgramsOccurrencesOnlyByNodeUser = [sql|
    WHERE nn.node1_id = ? -- CorpusId
    AND n.typename = ? -- NodeTypeId
    AND nng.ngrams_type = ? -- NgramsTypeId
    AND nn.delete = False
    AND nn.category > 0
    GROUP BY nng.node2_id, ng.terms
    |]
    ......@@ -247,7 +247,7 @@ queryNgramsOnlyByNodeUser = [sql|
    WHERE nn.node1_id = ? -- CorpusId
    AND n.typename = ? -- NodeTypeId
    AND nng.ngrams_type = ? -- NgramsTypeId
    AND nn.delete = False
    AND nn.category > 0
    GROUP BY ng.terms, nng.node2_id
    |]
    ......@@ -330,7 +330,7 @@ SELECT n.id, ng.terms FROM nodes n
    WHERE nn.node1_id = ? -- UserCorpusId
    -- AND n.typename = ? -- NodeTypeId
    AND nng.ngrams_type = ? -- NgramsTypeId
    AND nn.delete = False
    AND nn.category > 0
    AND node_pos(n.id,?) >= ?
    AND node_pos(n.id,?) < ?
    GROUP BY n.id, ng.terms
    ......
    src/Gargantext/Database/Node/Children.hs
    View file @ bb3587d3
    ......@@ -43,7 +43,7 @@ getChildren pId _ maybeNodeType maybeOffset maybeLimit = runOpaQuery
    selectChildren :: ParentId -> Maybe NodeType -> Query NodeRead
    selectChildren parentId maybeNodeType = proc () -> do
    row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
    (NodeNode n1id n2id _ _ _) <- queryNodeNodeTable -< ()
    (NodeNode n1id n2id _ _) <- queryNodeNodeTable -< ()
    let nodeType = maybe 0 nodeTypeId maybeNodeType
    restrict -< typeName .== pgInt4 nodeType
    ......
    src/Gargantext/Database/Node/Document/Add.hs
    View file @ bb3587d3
    ......@@ -40,7 +40,6 @@ import Gargantext.Prelude
    import GHC.Generics (Generic)
    ---------------------------------------------------------------------------
    add :: ParentId -> [NodeId] -> Cmd err [Only Int]
    add pId ns = runPGSQuery queryAdd (Only $ Values fields inputData)
    where
    ......@@ -54,17 +53,16 @@ add_debug pId ns = formatPGSQuery queryAdd (Only $ Values fields inputData)
    inputData = prepare pId ns
    -- | Input Tables: types of the tables
    inputSqlTypes :: [Text]
    inputSqlTypes = ["int4","int4","bool","bool"]
    inputSqlTypes = ["int4","int4"]
    -- | SQL query to add documents
    -- TODO return id of added documents only
    queryAdd :: Query
    queryAdd = [sql|
    WITH input_rows(node1_id,node2_id, favorite, delete) AS (?)
    INSERT INTO nodes_nodes (node1_id, node2_id, favorite, delete)
    WITH input_rows(node1_id,node2_id) AS (?)
    INSERT INTO nodes_nodes (node1_id, node2_id)
    SELECT * FROM input_rows
    ON CONFLICT (node1_id, node2_id) DO NOTHING -- on unique index
    RETURNING 1
    ......@@ -72,7 +70,7 @@ queryAdd = [sql|
    |]
    prepare :: ParentId -> [NodeId] -> [InputData]
    prepare pId ns = map (\nId -> InputData pId nId False False) ns
    prepare pId ns = map (\nId -> InputData pId nId) ns
    ------------------------------------------------------------------------
    -- * Main Types used
    ......@@ -80,14 +78,10 @@ prepare pId ns = map (\nId -> InputData pId nId False False) ns
    data InputData = InputData { inNode1_id :: NodeId
    , inNode2_id :: NodeId
    , inNode_fav :: Bool
    , inNode_del :: Bool
    } deriving (Show, Generic, Typeable)
    instance ToRow InputData where
    toRow inputData = [ toField (inNode1_id inputData)
    , toField (inNode2_id inputData)
    , toField (inNode_fav inputData)
    , toField (inNode_del inputData)
    ]
    src/Gargantext/Database/Schema/NodeNode.hs
    View file @ bb3587d3
    ......@@ -43,33 +43,29 @@ import Opaleye
    import Control.Arrow (returnA)
    import qualified Opaleye as O
    data NodeNodePoly node1_id node2_id score fav del
    data NodeNodePoly node1_id node2_id score cat
    = NodeNode { nn_node1_id :: node1_id
    , nn_node2_id :: node2_id
    , nn_score :: score
    , nn_favorite :: fav
    , nn_delete :: del
    , nn_score :: score
    , nn_category :: cat
    } deriving (Show)
    type NodeNodeWrite = NodeNodePoly (Column (PGInt4))
    (Column (PGInt4))
    (Maybe (Column (PGFloat8)))
    (Maybe (Column (PGBool)))
    (Maybe (Column (PGBool)))
    (Maybe (Column (PGInt4)))
    type NodeNodeRead = NodeNodePoly (Column (PGInt4))
    (Column (PGInt4))
    (Column (PGFloat8))
    (Column (PGBool))
    (Column (PGBool))
    (Column (PGInt4))
    type NodeNodeReadNull = NodeNodePoly (Column (Nullable PGInt4))
    (Column (Nullable PGInt4))
    (Column (Nullable PGFloat8))
    (Column (Nullable PGBool))
    (Column (Nullable PGBool))
    (Column (Nullable PGInt4))
    type NodeNode = NodeNodePoly Int Int (Maybe Double) (Maybe Bool) (Maybe Bool)
    type NodeNode = NodeNodePoly Int Int (Maybe Double) (Maybe Int)
    $(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
    $(makeLensesWith abbreviatedFields ''NodeNodePoly)
    ......@@ -79,8 +75,7 @@ nodeNodeTable = Table "nodes_nodes" (pNodeNode
    NodeNode { nn_node1_id = required "node1_id"
    , nn_node2_id = required "node2_id"
    , nn_score = optional "score"
    , nn_favorite = optional "favorite"
    , nn_delete = optional "delete"
    , nn_category = optional "category"
    }
    )
    ......@@ -98,30 +93,30 @@ instance QueryRunnerColumnDefault (Nullable PGInt4) Int where
    instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    instance QueryRunnerColumnDefault PGBool (Maybe Bool) where
    instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
    queryRunnerColumnDefault = fieldQueryRunnerColumn
    ------------------------------------------------------------------------
    -- | Favorite management
    nodeToFavorite :: CorpusId -> DocId -> Bool -> Cmd err [Int]
    nodeToFavorite cId dId b = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (b,cId,dId)
    nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
    nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
    where
    favQuery :: PGS.Query
    favQuery = [sql|UPDATE nodes_nodes SET favorite = ?
    favQuery = [sql|UPDATE nodes_nodes SET category = ?
    WHERE node1_id = ? AND node2_id = ?
    RETURNING node2_id;
    |]
    nodesToFavorite :: [(CorpusId,DocId,Bool)] -> Cmd err [Int]
    nodesToFavorite inputData = map (\(PGS.Only a) -> a)
    <$> runPGSQuery trashQuery (PGS.Only $ Values fields inputData)
    nodeNodesCategory :: [(CorpusId,DocId,Int)] -> Cmd err [Int]
    nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
    <$> runPGSQuery catQuery (PGS.Only $ Values fields inputData)
    where
    fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","bool"]
    trashQuery :: PGS.Query
    trashQuery = [sql| UPDATE nodes_nodes as old SET
    favorite = new.favorite
    from (?) as new(node1_id,node2_id,favorite)
    fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","category"]
    catQuery :: PGS.Query
    catQuery = [sql| UPDATE nodes_nodes as old SET
    category = new.category
    from (?) as new(node1_id,node2_id,category)
    WHERE old.node1_id = new.node1_id
    AND old.node2_id = new.node2_id
    RETURNING new.node2_id
    ......@@ -144,7 +139,7 @@ queryDocs :: CorpusId -> O.Query (Column PGJsonb)
    queryDocs cId = proc () -> do
    (n, nn) <- joinInCorpus -< ()
    restrict -< ( nn_node1_id nn) .== (toNullable $ pgNodeId cId)
    restrict -< ( nn_delete nn) .== (toNullable $ pgBool False)
    restrict -< ( nn_category nn) .>= (toNullable $ pgInt4 1)
    restrict -< (_node_typename n) .== (pgInt4 $ nodeTypeId NodeDocument)
    returnA -< view (node_hyperdata) n
    ......@@ -156,7 +151,7 @@ queryDocNodes :: CorpusId -> O.Query NodeRead
    queryDocNodes cId = proc () -> do
    (n, nn) <- joinInCorpus -< ()
    restrict -< ( nn_node1_id nn) .== (toNullable $ pgNodeId cId)
    restrict -< ( nn_delete nn) .== (toNullable $ pgBool False)
    restrict -< ( nn_category nn) .>= (toNullable $ pgInt4 1)
    restrict -< (_node_typename n) .== (pgInt4 $ nodeTypeId NodeDocument)
    returnA -< n
    ......
    src/Gargantext/Database/TextSearch.hs
    View file @ bb3587d3
    ......@@ -65,10 +65,10 @@ queryInCorpus :: CorpusId -> Text -> O.Query FacetDocRead
    queryInCorpus cId q = proc () -> do
    (n, nn) <- joinInCorpus -< ()
    restrict -< ( nn_node1_id nn) .== (toNullable $ pgNodeId cId)
    restrict -< ( nn_delete nn) .== (toNullable $ pgBool False)
    restrict -< ( nn_category nn) .>= (toNullable $ pgInt4 1)
    restrict -< (_ns_search n) @@ (pgTSQuery (unpack q))
    restrict -< (_ns_typename n) .== (pgInt4 $ nodeTypeId NodeDocument)
    returnA -< FacetDoc (_ns_id n) (_ns_date n) (_ns_name n) (_ns_hyperdata n) (pgBool True) (pgInt4 1)
    returnA -< FacetDoc (_ns_id n) (_ns_date n) (_ns_name n) (_ns_hyperdata n) (pgInt4 1) (pgInt4 1)
    joinInCorpus :: O.Query (NodeSearchRead, NodeNodeReadNull)
    joinInCorpus = leftJoin queryNodeSearchTable queryNodeNodeTable cond
    ......
    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