[DB/REFACT] intermediary step

src/Gargantext/API/Ngrams.hs

@@ -126,7 +126,7 @@ import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, Limit, Offset
 import Gargantext.Core.Types (TODO)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Action.Metrics.NgramsByNode (getOccByNgramsOnlyFast')
-import Gargantext.Database.Action.Query.Ngrams
+import Gargantext.Database.Query.Table.Ngrams
 import Gargantext.Database.Action.Query.Node.Select
 import Gargantext.Database.Admin.Config (userMaster)
 import Gargantext.Database.Admin.Types.Errors (HasNodeError)

src/Gargantext/Database/Action/Flow.hs

@@ -76,7 +76,7 @@ import Gargantext.Database.Admin.Types.Errors (HasNodeError(..))
 import Gargantext.Database.Admin.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
 import Gargantext.Database.Admin.Utils (Cmd)
 import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams,  NgramsType(..), text2ngrams, ngramsTypeId)
-import Gargantext.Database.Schema.NodeNgrams (listInsertDb , getCgramsId)
+import Gargantext.Database.Query.Table.NodeNgrams (listInsertDb , getCgramsId)
 import Gargantext.Database.Schema.NodeNodeNgrams2 -- (NodeNodeNgrams2, insertNodeNodeNgrams2)
 import Gargantext.Ext.IMT (toSchoolName)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)

src/Gargantext/Database/Action/Flow/List.hs

@@ -40,7 +40,7 @@ import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
 import Gargantext.Database.Admin.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
 import Gargantext.Database.Admin.Utils (Cmd)
 import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams,  NgramsType(..), text2ngrams, ngramsTypeId)
-import Gargantext.Database.Schema.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb, getCgramsId)
+import Gargantext.Database.Query.Table.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb, getCgramsId)
 import Gargantext.Database.Schema.Node_NodeNgramsNodeNgrams -- (insert_Node_NodeNgrams_NodeNgrams, Node_NodeNgrams_NodeNgrams(..))
 import Gargantext.Prelude
 import Gargantext.Text.List

src/Gargantext/Database/Action/Query/Ngrams.hs → src/Gargantext/Database/Query/Table/Ngrams.hs

 {-|
-Module      : Gargantext.Database.Ngrams
+Module      : Gargantext.Database.Query.Table.Ngrams
 Description : Deal with in Gargantext Database.
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -14,7 +14,7 @@ Portability : POSIX
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE RankNTypes        #-}
 
-module Gargantext.Database.Action.Query.Ngrams
+module Gargantext.Database.Query.Table.Ngrams
     where
 
 import Control.Arrow (returnA)

src/Gargantext/Database/Query/Table/NodeNgrams.hs

+{-|
+Module      : Gargantext.Database.Query.Table.NodeNgrams
+Description : 
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+NodeNgrams register Context of Ngrams (named Cgrams then)
+
+-}
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-# LANGUAGE Arrows                 #-}
+{-# LANGUAGE FlexibleContexts       #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE QuasiQuotes            #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE NoImplicitPrelude      #-}
+{-# LANGUAGE OverloadedStrings      #-}
+{-# LANGUAGE RankNTypes             #-}
+{-# LANGUAGE TemplateHaskell        #-}
+
+module Gargantext.Database.Query.Table.NodeNgrams 
+  ( getCgramsId
+  , listInsertDb
+  , module Gargantext.Database.Schema.NodeNgrams
+  )
+  where
+
+import Data.List.Extra (nubOrd)
+import Data.Map (Map)
+import Data.Maybe (Maybe, fromMaybe)
+import Data.Text (Text)
+import Database.PostgreSQL.Simple (FromRow)
+import Database.PostgreSQL.Simple.FromRow (fromRow, field)
+import Database.PostgreSQL.Simple.SqlQQ (sql)
+import Database.PostgreSQL.Simple.ToField (toField)
+import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
+import Gargantext.Core.Types
+import Gargantext.Database.Admin.Utils
+import Gargantext.Database.Schema.Ngrams (NgramsType, ngramsTypeId, fromNgramsTypeId)
+import Gargantext.Database.Schema.NodeNgrams
+import Gargantext.Prelude
+import qualified Data.List as List
+import qualified Data.Map as Map
+import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
+
+
+-- | Type for query return
+data Returning = Returning { re_type      :: !(Maybe NgramsType)
+                           , re_terms     :: !Text
+                           , re_ngrams_id :: !Int
+                           }
+  deriving (Show)
+
+instance FromRow Returning where
+  fromRow = Returning <$> (fromNgramsTypeId <$> field) <*> field <*> field
+
+getCgramsId :: Map NgramsType (Map Text Int) -> NgramsType -> Text -> Maybe Int
+getCgramsId mapId nt t = case Map.lookup nt mapId of
+  Nothing     -> Nothing
+  Just mapId' -> Map.lookup t mapId'
+
+
+-- insertDb :: ListId -> Map NgramsType [NgramsElement] -> Cmd err [Result]
+listInsertDb :: Show a => ListId
+             -> (ListId -> a -> [NodeNgramsW])
+             -> a
+             -- -> Cmd err [Returning]
+             -> Cmd err (Map NgramsType (Map Text Int))
+listInsertDb l f ngs = Map.map Map.fromList
+                    <$> Map.fromListWith (<>)
+                    <$> List.map (\(Returning t tx id) -> (fromJust t, [(tx, id)]))
+                    <$> List.filter (\(Returning t _ _) -> isJust t)
+                    <$> insertNodeNgrams (f l ngs)
+
+-- TODO optimize with size of ngrams
+insertNodeNgrams :: [NodeNgramsW] -> Cmd err [Returning]
+insertNodeNgrams nns = runPGSQuery query (PGS.Only $ Values fields nns')
+  where
+    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' = map (\(NodeNgrams _id (NodeId node_id'') node_subtype ngrams_terms ngrams_type ngrams_field ngrams_tag 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
+                                 ]
+                  ) $ nubOrd nns
+
+    query :: PGS.Query
+    query = [sql|
+          WITH input(node_id, node_subtype, ngrams_terms, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight) AS (?),
+          return(id, ngrams_type, 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 NOTHING
+            -- 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_type, ngrams_id
+          )
+          SELECT return.ngrams_type, ng.terms, return.id FROM return
+          INNER JOIN ngrams ng ON return.ngrams_id = ng.id;
+  |]

src/Gargantext/Database/Query/Table/NodeNode.hs

+{-|
+Module      : Gargantext.Database.Query.Table.NodeNode
+Description : 
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Here is a longer description of this module, containing some
+commentary with @some markup@.
+-}
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-# LANGUAGE Arrows                 #-}
+{-# LANGUAGE FlexibleContexts       #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE QuasiQuotes            #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE NoImplicitPrelude      #-}
+{-# LANGUAGE OverloadedStrings      #-}
+{-# LANGUAGE RankNTypes             #-}
+{-# LANGUAGE TemplateHaskell        #-}
+
+module Gargantext.Database.Query.Table.NodeNode where
+
+import Control.Arrow (returnA)
+import Control.Lens (view, (^.))
+import Control.Lens.TH (makeLenses)
+import Data.Maybe (Maybe, catMaybes)
+import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
+import Data.Text (Text, splitOn)
+import Database.PostgreSQL.Simple.SqlQQ (sql)
+import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
+import Gargantext.Core.Types
+import Gargantext.Database.Schema.NodeNode
+import Gargantext.Database.Admin.Types.Node (pgNodeId)
+import Gargantext.Database.Admin.Config (nodeTypeId)
+import Gargantext.Database.Admin.Types.Node (CorpusId, DocId)
+import Gargantext.Database.Admin.Utils
+import Gargantext.Database.Schema.Node
+import Gargantext.Prelude
+import Opaleye
+import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
+import qualified Opaleye as O
+
+------------------------------------------------------------------------
+-- | Basic NodeNode tools
+getNodeNode :: NodeId -> Cmd err [NodeNode]
+getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
+  where
+    selectNodeNode :: Column PGInt4 -> Query NodeNodeRead
+    selectNodeNode n' = proc () -> do
+      ns <- queryNodeNodeTable -< ()
+      restrict -< _nn_node1_id ns .== n'
+      returnA -< ns
+
+-------------------------
+insertNodeNode :: [NodeNode] -> Cmd err Int64
+insertNodeNode ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeNodeTable ns' rCount Nothing
+  where
+    ns' :: [NodeNodeWrite]
+    ns' = map (\(NodeNode n1 n2 x y)
+                -> NodeNode (pgNodeId n1)
+                            (pgNodeId n2)
+                            (pgDouble <$> x)
+                            (pgInt4   <$> y)
+              ) ns
+
+
+-- | Favorite management
+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 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 catQuery (PGS.Only $ Values fields inputData)
+  where
+    fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
+    catQuery :: PGS.Query
+    catQuery = [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
+                  |]
+
+------------------------------------------------------------------------
+-- | TODO use UTCTime fast 
+selectDocsDates :: CorpusId -> Cmd err [Text]
+selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
+                   <$> catMaybes
+                   <$> map (view hyperdataDocument_publication_date)
+                   <$> selectDocs cId
+
+selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
+selectDocs cId = runOpaQuery (queryDocs cId)
+
+queryDocs :: CorpusId -> O.Query (Column PGJsonb)
+queryDocs cId = proc () -> do
+  (n, nn) <- joinInCorpus -< ()
+  restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
+  restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
+  restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
+  returnA -< view (node_hyperdata) n
+
+selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument]
+selectDocNodes cId = runOpaQuery (queryDocNodes cId)
+
+queryDocNodes :: CorpusId -> O.Query NodeRead
+queryDocNodes cId = proc () -> do
+  (n, nn) <- joinInCorpus -< ()
+  restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
+  restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
+  restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
+  returnA -<  n
+
+joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
+joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
+  where
+    cond :: (NodeRead, NodeNodeRead) -> Column PGBool
+    cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
+
+------------------------------------------------------------------------
+-- | Trash management
+nodeToTrash :: CorpusId -> DocId -> Bool -> Cmd err [PGS.Only Int]
+nodeToTrash cId dId b = runPGSQuery trashQuery (b,cId,dId)
+  where
+    trashQuery :: PGS.Query
+    trashQuery = [sql|UPDATE nodes_nodes SET delete = ?
+                  WHERE node1_id = ? AND node2_id = ?
+                  RETURNING node2_id
+                  |]
+
+-- | Trash Massive
+nodesToTrash :: [(CorpusId,DocId,Bool)] -> Cmd err [Int]
+nodesToTrash input = map (\(PGS.Only a) -> a)
+                        <$> runPGSQuery trashQuery (PGS.Only $ Values fields input)
+  where
+    fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","bool"]
+    trashQuery :: PGS.Query
+    trashQuery = [sql| UPDATE nodes_nodes as nn0 SET
+                 delete = nn1.delete
+                 from (?) as nn1(node1_id,node2_id,delete)
+                 WHERE nn0.node1_id = nn1.node1_id
+                 AND   nn0.node2_id = nn1.node2_id
+                 RETURNING nn1.node2_id
+                  |]
+
+-- | /!\ Really remove nodes in the Corpus or Annuaire
+emptyTrash :: CorpusId -> Cmd err [PGS.Only Int]
+emptyTrash cId = runPGSQuery delQuery (PGS.Only cId)
+  where
+    delQuery :: PGS.Query
+    delQuery = [sql|DELETE from nodes_nodes n
+                    WHERE n.node1_id = ?
+                      AND n.delete = true
+                    RETURNING n.node2_id
+                |]
+------------------------------------------------------------------------

src/Gargantext/Database/Schema/NodeNgrams.hs

@@ -9,7 +9,6 @@ Portability : POSIX
 
 NodeNgrams register Context of Ngrams (named Cgrams then)
 
-
 -}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -44,7 +43,6 @@ import qualified Data.List as List
 import qualified Data.Map as Map
 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
 
-type NodeNgramsId = Int
 
 data NodeNgramsPoly id
                     node_id'
@@ -98,78 +96,18 @@ type NodeNgramsReadNull = NodeNgramsPoly (Column (Nullable PGInt4))
                                          (Column (Nullable PGInt4))
                                          (Column (Nullable PGFloat8))
 -}
-type NgramsId = Int
-type NgramsField = Int
-type NgramsTag   = Int
-type NgramsClass = Int
-type NgramsText  = Text
+type NodeNgramsId = Int
+type NgramsId     = Int
+type NgramsField  = Int
+type NgramsTag    = Int
+type NgramsClass  = Int
+type NgramsText   = Text
 
 -- Example of list Ngrams
 -- type ListNgrams = NodeNgramsPoly (Maybe Int) ListType Text 
 
 type NodeNgramsW =
-  NodeNgramsPoly (Maybe Int) NodeId ListType NgramsText
+  NodeNgramsPoly (Maybe NodeNgramsId) NodeId ListType NgramsText
                   NgramsType (Maybe NgramsField) (Maybe NgramsTag) (Maybe NgramsClass)
                   Double
 
-data Returning = Returning { re_type      :: !(Maybe NgramsType)
-                           , re_terms     :: !Text
-                           , re_ngrams_id :: !Int
-                           }
-  deriving (Show)
-
-instance FromRow Returning where
-  fromRow = Returning <$> (fromNgramsTypeId <$> field) <*> field <*> field
-
-getCgramsId :: Map NgramsType (Map Text Int) -> NgramsType -> Text -> Maybe Int
-getCgramsId mapId nt t = case Map.lookup nt mapId of
-  Nothing     -> Nothing
-  Just mapId' -> Map.lookup t mapId'
-
-
--- insertDb :: ListId -> Map NgramsType [NgramsElement] -> Cmd err [Result]
-listInsertDb :: Show a => ListId
-             -> (ListId -> a -> [NodeNgramsW])
-             -> a
-             -- -> Cmd err [Returning]
-             -> Cmd err (Map NgramsType (Map Text Int))
-listInsertDb l f ngs = Map.map Map.fromList
-                    <$> Map.fromListWith (<>)
-                    <$> List.map (\(Returning t tx id) -> (fromJust t, [(tx, id)]))
-                    <$> List.filter (\(Returning t _ _) -> isJust t)
-                    <$> insertNodeNgrams (f l ngs)
-
--- TODO optimize with size of ngrams
-insertNodeNgrams :: [NodeNgramsW] -> Cmd err [Returning]
-insertNodeNgrams nns = runPGSQuery query (PGS.Only $ Values fields nns')
-  where
-    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' = map (\(NodeNgrams _id (NodeId node_id'') node_subtype ngrams_terms ngrams_type ngrams_field ngrams_tag 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
-                                 ]
-                  ) $ nubOrd nns
-
-    query :: PGS.Query
-    query = [sql|
-          WITH input(node_id, node_subtype, ngrams_terms, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight) AS (?),
-          return(id, ngrams_type, 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 NOTHING
-            -- 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_type, ngrams_id
-          )
-          SELECT return.ngrams_type, ng.terms, return.id FROM return
-          INNER JOIN ngrams ng ON return.ngrams_id = ng.id;
-  |]