[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.

devops/postgres/schema.sql

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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