Made command to copy subtree

src/Gargantext/Database/Admin/Types/Node.hs

@@ -37,6 +37,7 @@ import Data.TreeDiff
 import Database.PostgreSQL.Simple.FromField (FromField, fromField, fromJSONField)
 import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField)
 import Database.PostgreSQL.Simple.ToRow (ToRow, toRow)
+import Database.PostgreSQL.Simple.FromRow (FromRow, fromRow, field)
 import Fmt ( Buildable(..) )
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
 import Gargantext.Database.Schema.Context
@@ -267,10 +268,13 @@ instance ToField NodeId where
   toField (UnsafeMkNodeId n) = toField n
 instance ToRow NodeId where
   toRow (UnsafeMkNodeId i) = [toField i]
+instance FromRow NodeId where
+  fromRow = UnsafeMkNodeId <$> field
+
 
 instance FromField NodeId where
-  fromField field mdata = do
-    n <- UnsafeMkNodeId <$> fromField field mdata
+  fromField fld mdata = do
+    n <- UnsafeMkNodeId <$> fromField fld mdata
     if isPositive n
        then pure n
        else mzero

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

@@ -433,10 +433,64 @@ getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)
 
 ------------------------------------------------------------------------
 
-copyNode :: (HasNodeError err) => NodeId -> DBCmd err Int64
-copyNode nodeIdToCopy = do
-  nodeToCopy <- getNode nodeIdToCopy
-  _
+-- INSERT INTO public.nodes (hash_id, typename, user_id, parent_id, name, date, hyperdata)
+-- SELECT 'tutu', typename, user_id, 97, name, date, hyperdata FROM public.nodes WHERE id = 165;
+
+copyNodeSingle :: NodeId -> NodeId -> DBCmd err NodeId
+copyNodeSingle idToCopy newParentId = do
+  newNodes <- runPGSQuery
+    [sql|
+      INSERT INTO public.nodes (typename, user_id, parent_id, name, date, hyperdata)
+      SELECT typename, user_id, ?, name, date, hyperdata FROM public.nodes WHERE id = ?
+      RETURNING id;
+    |] (newParentId, idToCopy)
+  case newNodes of
+    [newNode] -> return newNode
+    _ -> panicTrace "Error" -- TODO specify error
+
+-- TODO Enforce a maximal depth level?
+-- TODO Use SQL builtin recursivity?
+copyNodeRecursive :: NodeId -> NodeId -> DBCmd err NodeId
+copyNodeRecursive idToCopy newParentId = do
+  copiedNode <- copyNodeSingle idToCopy newParentId
+  children   <- getChildren' idToCopy
+  for_ children $ \child -> copyNodeRecursive child copiedNode
+  return copiedNode
+
+-- TODO delete this and replace calls to it by calls to getChildren
+getChildren' :: NodeId -> DBCmd err [NodeId]
+getChildren' nodeId = runPGSQuery
+  [sql|
+    SELECT id FROM public.nodes WHERE parent_id = ?;
+  |]
+  nodeId
+
+
+-- INSERT INTO public.nodes (typename, user_id, parent_id, name, date, hyperdata)
+-- SELECT typename, user_id, 137, name, date, hyperdata FROM public.nodes WHERE id = 165
+-- RETURNING id;
+-- 
+-- SELECT id FROM public.nodes WHERE parent_id = 137;
+
+-- digest(CONCAT(?, NEW.typename, NEW.name, NEW.id, NEW.hyperdata), 'sha256')
+
+-- copyNode :: (HasNodeError err) => NodeId -> DBCmd err Int64
+-- copyNode nodeIdToCopy = mkCmd $ \connection -> proc
+--   runSelect
+
+-- TODO
+-- [ ] Performer la substitution
+-- [ ] Gérer le hash_id
+
+  -- nodeToCopy <- getNode nodeIdToCopy constant
+  -- _ -- return nodeToCopy
+  -- where
+  --   valueToHyperdata v = case fromJSON v of
+  --      Success a  -> pure a
+  --      Error _err -> returnError ConversionFailed field
+  --                  $ DL.unwords [ "cannot parse hyperdata for JSON: "
+  --                               , show v
+  --                               ]
 
 -- nodeExists :: (HasNodeError err) => NodeId -> DBCmd err Bool
 -- nodeExists nId = (== [PGS.Only True])