Merge remote-tracking branch 'origin/dev-hackathon-fixes' into dev
[gargantext.git] / src / Gargantext / Database / Query / Table / NodeNode.hs
index 606250581d4e0d27997d27e2c4a80a02a94359e6..b7cfe17d2e71caee2d658884bd7fa1aa4a9d00ca 100644 (file)
@@ -1,5 +1,4 @@
-{-|
-Module      : Gargantext.Database.Query.Table.NodeNode
+{-| Module      : Gargantext.Database.Select.Table.NodeNode
 Description : 
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -20,41 +19,38 @@ commentary with @some markup@.
 
 module Gargantext.Database.Query.Table.NodeNode
   ( module Gargantext.Database.Schema.NodeNode
+  , deleteNodeNode
+  , getNodeNode
+  , insertNodeNode
+  , nodeNodesCategory
+  , nodeNodesScore
   , queryNodeNodeTable
-  , selectDocsDates
   , selectDocNodes
   , selectDocs
-  , nodeNodesCategory
-  , getNodeNode
-  , insertNodeNode
-  , deleteNodeNode
+  , selectDocsDates
   , selectPublicNodes
-  , selectCountDocs
   )
   where
 
 import Control.Arrow (returnA)
-import Control.Lens (view, (^.))
-import Data.Maybe (catMaybes)
+import Control.Lens ((^.), view)
 import Data.Text (Text, splitOn)
+import Data.Maybe (catMaybes)
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
-import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
-import qualified Opaleye as O
-import Opaleye
-
+import Gargantext.Core
 import Gargantext.Core.Types
-import Gargantext.Database.Schema.NodeNode
-import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Hyperdata
-import Gargantext.Database.Admin.Types.Node (CorpusId, DocId, pgNodeId)
 import Gargantext.Database.Prelude
 import Gargantext.Database.Schema.Node
+import Gargantext.Database.Schema.NodeNode
 import Gargantext.Prelude
+import Opaleye
+import qualified Database.PostgreSQL.Simple as PGS
+import qualified Opaleye as O
 
-
-queryNodeNodeTable :: Query NodeNodeRead
-queryNodeNodeTable = queryTable nodeNodeTable
+queryNodeNodeTable :: Select NodeNodeRead
+queryNodeNodeTable = selectTable nodeNodeTable
 
 -- | not optimized (get all ngrams without filters)
 _nodesNodes :: Cmd err [NodeNode]
@@ -65,7 +61,7 @@ _nodesNodes = runOpaQuery queryNodeNodeTable
 getNodeNode :: NodeId -> Cmd err [NodeNode]
 getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
   where
-    selectNodeNode :: Column PGInt4 -> Query NodeNodeRead
+    selectNodeNode :: Column SqlInt4 -> Select NodeNodeRead
     selectNodeNode n' = proc () -> do
       ns <- queryNodeNodeTable -< ()
       restrict -< _nn_node1_id ns .== n'
@@ -81,13 +77,13 @@ getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
 
     selectChildren :: ParentId
                    -> Maybe NodeType
-                   -> Query NodeRead
+                   -> Select NodeRead
     selectChildren parentId maybeNodeType = proc () -> do
         row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
         (NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< ()
 
-        let nodeType = maybe 0 nodeTypeId maybeNodeType
-        restrict -< typeName  .== pgInt4 nodeType
+        let nodeType = maybe 0 toDBid maybeNodeType
+        restrict -< typeName  .== sqlInt4 nodeType
 
         restrict -< (.||) (parent_id .== (pgNodeId parentId))
                           ( (.&&) (n1id .== pgNodeId parentId)
@@ -104,8 +100,8 @@ insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
     ns' = map (\(NodeNode n1 n2 x y)
                 -> NodeNode (pgNodeId n1)
                             (pgNodeId n2)
-                            (pgDouble <$> x)
-                            (pgInt4   <$> y)
+                            (sqlDouble <$> x)
+                            (sqlInt4   <$> y)
               ) ns
 
 
@@ -116,9 +112,13 @@ type Node2_Id = NodeId
 
 deleteNodeNode :: Node1_Id -> Node2_Id -> Cmd err Int
 deleteNodeNode n1 n2 = mkCmd $ \conn ->
-  fromIntegral <$> runDelete conn nodeNodeTable
-                 (\(NodeNode n1_id n2_id _ _) -> n1_id .== pgNodeId n1
-                                             .&& n2_id .== pgNodeId n2 )
+  fromIntegral <$> runDelete_ conn
+                  (Delete nodeNodeTable
+                          (\(NodeNode n1_id n2_id _ _) -> n1_id .== pgNodeId n1
+                                                      .&& n2_id .== pgNodeId n2
+                          )
+                          rCount
+                  )
 
 ------------------------------------------------------------------------
 -- | Favorite management
@@ -131,7 +131,7 @@ _nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery
                RETURNING node2_id;
                |]
 
-nodeNodesCategory :: [(CorpusId,DocId,Int)] -> Cmd err [Int]
+nodeNodesCategory :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
 nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
                             <$> runPGSQuery catQuery (PGS.Only $ Values fields inputData)
   where
@@ -146,69 +146,104 @@ nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
                   |]
 
 ------------------------------------------------------------------------
-selectCountDocs :: CorpusId -> Cmd err Int
-selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
+-- | Score management
+_nodeNodeScore :: CorpusId -> DocId -> Int -> Cmd err [Int]
+_nodeNodeScore cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery scoreQuery (c,cId,dId)
+  where
+    scoreQuery :: PGS.Query
+    scoreQuery = [sql|UPDATE nodes_nodes SET score = ?
+                  WHERE node1_id = ? AND node2_id = ?
+                  RETURNING node2_id;
+                  |]
+
+nodeNodesScore :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
+nodeNodesScore inputData = map (\(PGS.Only a) -> a)
+                            <$> runPGSQuery catScore (PGS.Only $ Values fields inputData)
+  where
+    fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
+    catScore :: PGS.Query
+    catScore = [sql| UPDATE nodes_nodes as nn0
+                      SET score = nn1.score
+                       FROM (?) as nn1(node1_id, node2_id, score)
+                       WHERE nn0.node1_id = nn1.node1_id
+                       AND   nn0.node2_id = nn1.node2_id
+                       RETURNING nn1.node2_id
+                  |]
+
+------------------------------------------------------------------------
+_selectCountDocs :: HasDBid NodeType => CorpusId -> Cmd err Int
+_selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
   where
     queryCountDocs 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)
+      restrict -< nn^.nn_category  .>= (toNullable $ sqlInt4 1)
+      restrict -< n^.node_typename .== (sqlInt4 $ toDBid NodeDocument)
       returnA -< n
 
 
 
 
 -- | TODO use UTCTime fast
-selectDocsDates :: CorpusId -> Cmd err [Text]
+selectDocsDates :: HasDBid NodeType => CorpusId -> Cmd err [Text]
 selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
                    <$> catMaybes
                    <$> map (view hd_publication_date)
                    <$> selectDocs cId
 
-selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
+selectDocs :: HasDBid NodeType => CorpusId -> Cmd err [HyperdataDocument]
 selectDocs cId = runOpaQuery (queryDocs cId)
 
-queryDocs :: CorpusId -> O.Query (Column PGJsonb)
+queryDocs :: HasDBid NodeType => CorpusId -> O.Select (Column SqlJsonb)
 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)
+  restrict -< nn^.nn_category  .>= (toNullable $ sqlInt4 1)
+  restrict -< n^.node_typename .== (sqlInt4 $ toDBid NodeDocument)
   returnA -< view (node_hyperdata) n
 
-selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument]
+selectDocNodes :: HasDBid NodeType =>CorpusId -> Cmd err [Node HyperdataDocument]
 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 
-queryDocNodes :: CorpusId -> O.Query NodeRead
+queryDocNodes :: HasDBid NodeType =>CorpusId -> O.Select 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)
+  restrict -< nn^.nn_category  .>= (toNullable $ sqlInt4 1)
+  restrict -< n^.node_typename .== (sqlInt4 $ toDBid NodeDocument)
   returnA -<  n
 
-joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
+joinInCorpus :: O.Select (NodeRead, NodeNodeReadNull)
 joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
   where
-    cond :: (NodeRead, NodeNodeRead) -> Column PGBool
+    cond :: (NodeRead, NodeNodeRead) -> Column SqlBool
     cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
 
-joinOn1 :: O.Query (NodeRead, NodeNodeReadNull)
-joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond
+_joinOn1 :: O.Select (NodeRead, NodeNodeReadNull)
+_joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond
   where
-    cond :: (NodeRead, NodeNodeRead) -> Column PGBool
+    cond :: (NodeRead, NodeNodeRead) -> Column SqlBool
     cond (n, nn) = nn^.nn_node1_id .== n^.node_id
 
 
 ------------------------------------------------------------------------
-selectPublicNodes :: (Hyperdata a, QueryRunnerColumnDefault PGJsonb a)
+selectPublicNodes :: HasDBid NodeType => (Hyperdata a, DefaultFromField SqlJsonb a)
                   => Cmd err [(Node a, Maybe Int)]
 selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
 
-queryWithType :: NodeType -> O.Query (NodeRead, Column (Nullable PGInt4))
+queryWithType :: HasDBid NodeType
+              => NodeType
+              -> O.Select (NodeRead, Column (Nullable SqlInt4))
 queryWithType nt = proc () -> do
-  (n, nn) <- joinOn1 -< ()
-  restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId nt)
+  (n, nn) <- node_NodeNode -< ()
+  restrict -< n^.node_typename .== (sqlInt4 $ toDBid nt)
   returnA  -<  (n, nn^.nn_node2_id)
 
+node_NodeNode :: O.Select (NodeRead, NodeNodeReadNull)
+node_NodeNode = leftJoin queryNodeTable queryNodeNodeTable cond
+  where
+    cond :: (NodeRead, NodeNodeRead) -> Column SqlBool
+    cond (n, nn) = nn^.nn_node1_id .== n^.node_id
+
+
+