[FIX] Order 1 and Order 2, node size ok.
[gargantext.git] / src / Gargantext / Database / Query / Table / Node.hs
index 62b86607b2c38f2776c2e3d556bc1d9349c0fe50..c26a66999eb7351195960e4b9ac10cd70c3da0a9 100644 (file)
@@ -44,7 +44,7 @@ import Gargantext.Prelude hiding (sum, head)
 
 
 queryNodeSearchTable :: Query NodeSearchRead
-queryNodeSearchTable = queryTable nodeTableSearch
+queryNodeSearchTable = selectTable nodeTableSearch
 
 selectNode :: Column PGInt4 -> Query NodeRead
 selectNode id' = proc () -> do
@@ -78,20 +78,26 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
       let typeId' = maybe 0 toDBid maybeNodeType
 
       restrict -< if typeId' > 0
-                     then typeId   .== (pgInt4 (typeId' :: Int))
+                     then typeId   .== (sqlInt4 (typeId' :: Int))
                      else (pgBool True)
       returnA  -< row ) -< ()
     returnA -< node'
 
 deleteNode :: NodeId -> Cmd err Int
 deleteNode n = mkCmd $ \conn ->
-  fromIntegral <$> runDelete conn nodeTable
-                 (\(Node n_id _ _ _ _ _ _ _) -> n_id .== pgNodeId n)
+  fromIntegral <$> runDelete_ conn
+                 (Delete nodeTable
+                         (\(Node n_id _ _ _ _ _ _ _) -> n_id .== pgNodeId n)
+                         rCount
+                 )
 
 deleteNodes :: [NodeId] -> Cmd err Int
 deleteNodes ns = mkCmd $ \conn ->
-  fromIntegral <$> runDelete conn nodeTable
-                   (\(Node n_id _ _ _ _ _ _ _) -> in_ ((map pgNodeId ns)) n_id)
+  fromIntegral <$> runDelete_ conn
+                   (Delete nodeTable
+                           (\(Node n_id _ _ _ _ _ _ _) -> in_ ((map pgNodeId ns)) n_id)
+                           rCount
+                   )
 
 -- TODO: NodeType should match with `a'
 getNodesWith :: (JSONB a, HasDBid NodeType) => NodeId -> proxy a -> Maybe NodeType
@@ -121,7 +127,7 @@ getClosestParentIdByType :: HasDBid NodeType
 getClosestParentIdByType nId nType = do
   result <- runPGSQuery query (nId, 0 :: Int)
   case result of
-    [DPS.Only parentId, DPS.Only pTypename] -> do
+    [(NodeId parentId, pTypename)] -> do
       if toDBid nType == pTypename then
         pure $ Just $ NodeId parentId
       else
@@ -131,11 +137,52 @@ getClosestParentIdByType nId nType = do
     query :: DPS.Query
     query = [sql|
       SELECT n2.id, n2.typename
-        FROM nodes n1
+      FROM nodes n1
         JOIN nodes n2 ON n1.parent_id = n2.id
         WHERE n1.id = ? AND 0 = ?;
     |]
 
+-- | Similar to `getClosestParentIdByType` but includes current node
+-- in search too
+getClosestParentIdByType' :: HasDBid NodeType
+                          => NodeId
+                          -> NodeType
+                          -> Cmd err (Maybe NodeId)
+getClosestParentIdByType' nId nType = do
+  result <- runPGSQuery query (nId, 0 :: Int)
+  case result of
+    [(NodeId id, pTypename)] -> do
+      if toDBid nType == pTypename then
+        pure $ Just $ NodeId id
+      else
+        getClosestParentIdByType nId nType
+    _ -> pure Nothing
+  where
+    query :: DPS.Query
+    query = [sql|
+      SELECT n.id, n.typename
+      FROM nodes n
+      WHERE n.id = ? AND 0 = ?;
+    |]
+
+-- | Given a node id, find all it's children (no matter how deep) of
+-- given node type.
+getChildrenByType :: HasDBid NodeType
+                  => NodeId
+                  -> NodeType
+                  -> Cmd err [NodeId]
+getChildrenByType nId nType = do
+  result <- runPGSQuery query (nId, 0 :: Int)
+  children_lst <- mapM (\(id, _) -> getChildrenByType id nType) result
+  pure $ concat $ [fst <$> filter (\(_, pTypename) -> pTypename == toDBid nType) result] ++ children_lst
+  where
+    query :: DPS.Query
+    query = [sql|
+      SELECT n.id, n.typename
+      FROM nodes n
+        WHERE n.parent_id = ? AND 0 = ?;
+    |]
+
 ------------------------------------------------------------------------
 getDocumentsV3WithParentId :: HasDBid NodeType => NodeId -> Cmd err [Node HyperdataDocumentV3]
 getDocumentsV3WithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocument)
@@ -168,7 +215,7 @@ getNodesWithType nt _ = runOpaQuery $ selectNodesWithType nt
                          => NodeType -> Query NodeRead
     selectNodesWithType nt' = proc () -> do
         row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
-        restrict -< tn .== (pgInt4 $ toDBid nt')
+        restrict -< tn .== (sqlInt4 $ toDBid nt')
         returnA -< row
 
 getNodesIdWithType :: (HasNodeError err, HasDBid NodeType) => NodeType -> Cmd err [NodeId]
@@ -180,7 +227,7 @@ selectNodesIdWithType :: HasDBid NodeType
                       => NodeType -> Query (Column PGInt4)
 selectNodesIdWithType nt = proc () -> do
     row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
-    restrict -< tn .== (pgInt4 $ toDBid nt)
+    restrict -< tn .== (sqlInt4 $ toDBid nt)
     returnA -< _node_id row
 
 ------------------------------------------------------------------------
@@ -229,10 +276,10 @@ node :: (ToJSON a, Hyperdata a, HasDBid NodeType)
      -> NodeWrite
 node nodeType name hyperData parentId userId =
   Node Nothing Nothing
-       (pgInt4 typeId)
-       (pgInt4 userId)
+       (sqlInt4 typeId)
+       (sqlInt4 userId)
        (pgNodeId <$> parentId)
-       (pgStrictText name)
+       (sqlStrictText name)
        Nothing
        (pgJSONB $ cs $ encode hyperData)
     where
@@ -250,10 +297,10 @@ insertNodes' ns = mkCmd $ \conn -> runInsert_ conn
     ns' :: [NodeWrite]
     ns' = map (\(Node i t u p n d h)
                 -> Node (pgNodeId          <$> i)
-                        (pgInt4 $ toDBid      t)
-                        (pgInt4                u)
+                        (sqlInt4 $ toDBid      t)
+                        (sqlInt4                u)
                         (pgNodeId          <$> p)
-                        (pgStrictText          n)
+                        (sqlStrictText          n)
                         (pgUTCTime         <$> d)
                         (pgJSONB $ cs $ encode h)
               ) ns
@@ -264,10 +311,10 @@ insertNodesR ns = mkCmd $ \conn ->
   runInsert_ conn (Insert nodeTable ns (rReturning (\(Node i _ _ _ _ _ _ _) -> i)) Nothing)
 
 insertNodesWithParent :: Maybe ParentId -> [NodeWrite] -> Cmd err Int64
-insertNodesWithParent pid ns = insertNodes (set node_parentId (pgNodeId <$> pid) <$> ns)
+insertNodesWithParent pid ns = insertNodes (set node_parent_id (pgNodeId <$> pid) <$> ns)
 
 insertNodesWithParentR :: Maybe ParentId -> [NodeWrite] -> Cmd err [NodeId]
-insertNodesWithParentR pid ns = insertNodesR (set node_parentId (pgNodeId <$> pid) <$> ns)
+insertNodesWithParentR pid ns = insertNodesR (set node_parent_id (pgNodeId <$> pid) <$> ns)
 ------------------------------------------------------------------------
 -- TODO
 -- currently this function removes the child relation
@@ -275,7 +322,7 @@ insertNodesWithParentR pid ns = insertNodesR (set node_parentId (pgNodeId <$> pi
 
 node2table :: HasDBid NodeType
            => UserId -> Maybe ParentId -> Node' -> NodeWrite
-node2table uid pid (Node' nt txt v []) = Node Nothing Nothing (pgInt4 $ toDBid nt) (pgInt4 uid) (fmap pgNodeId pid) (pgStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v)
+node2table uid pid (Node' nt txt v []) = Node Nothing Nothing (sqlInt4 $ toDBid nt) (sqlInt4 uid) (fmap pgNodeId pid) (sqlStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v)
 node2table _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet"
 
 
@@ -336,6 +383,8 @@ defaultList :: (HasNodeError err, HasDBid NodeType) => CorpusId -> Cmd err ListI
 defaultList cId =
   maybe (nodeError NoListFound) (pure . view node_id) . headMay =<< getListsWithParentId cId
 
+defaultListMaybe :: (HasNodeError err, HasDBid NodeType) => CorpusId -> Cmd err (Maybe NodeId)
+defaultListMaybe cId = headMay <$> map (view node_id ) <$> getListsWithParentId cId
 
 getListsWithParentId :: HasDBid NodeType => NodeId -> Cmd err [Node HyperdataList]
 getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)