[graph] fixes to the clone endpoint

src/Gargantext/Database/Action/Metrics/NgramsByNode.hs

@@ -24,6 +24,12 @@ import Data.Tuple.Extra (second, swap)
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import Debug.Trace (trace)
+import qualified Data.List as List
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import qualified Data.Text as Text
+import qualified Database.PostgreSQL.Simple as DPS
+
 import Gargantext.Core (Lang(..))
 import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
@@ -32,11 +38,6 @@ import Gargantext.Database.Schema.Ngrams (ngramsTypeId, NgramsType(..))
 import Gargantext.Prelude
 import Gargantext.Text.Metrics.TFICF
 import Gargantext.Text.Terms.Mono.Stem (stem)
-import qualified Data.List as List
-import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
-import qualified Data.Text as Text
-import qualified Database.PostgreSQL.Simple as DPS
 
 -- | TODO: group with 2 terms only can be
 -- discussed. Main purpose of this is offering

src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs

@@ -17,12 +17,13 @@ module Gargantext.Database.Admin.Trigger.NodeNodeNgrams
   where
 
 import Database.PostgreSQL.Simple.SqlQQ (sql)
+import qualified Database.PostgreSQL.Simple as DPS
+
 import Gargantext.Core.Types.Main (listTypeId, ListType(CandidateTerm))
 import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
 import Gargantext.Database.Prelude (Cmd, execPGSQuery)
 import Gargantext.Prelude
-import qualified Database.PostgreSQL.Simple as DPS
 
 triggerCountInsert :: Cmd err Int64
 triggerCountInsert = execPGSQuery query (nodeTypeId NodeDocument, nodeTypeId NodeList)

src/Gargantext/Database/Admin/Trigger/Nodes.hs

@@ -17,11 +17,12 @@ module Gargantext.Database.Admin.Trigger.Nodes
   where
 
 import Database.PostgreSQL.Simple.SqlQQ (sql)
+import qualified Database.PostgreSQL.Simple as DPS
+
 import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
 import Gargantext.Database.Prelude (Cmd, execPGSQuery)
 import Gargantext.Prelude
-import qualified Database.PostgreSQL.Simple as DPS
 
 
 triggerSearchUpdate :: Cmd err Int64

src/Gargantext/Database/Prelude.hs

@@ -84,12 +84,14 @@ mkCmd k = do
   withResource pool (liftBase . k)
 
 runCmd :: (HasConnectionPool env)
-       => env -> Cmd' env err a
+       => env
+       -> Cmd' env err a
        -> IO (Either err a)
 runCmd env m = runExceptT $ runReaderT m env
 
 runOpaQuery :: Default FromFields fields haskells
-            => Select fields -> Cmd err [haskells]
+            => Select fields
+            -> Cmd err [haskells]
 runOpaQuery q = mkCmd $ \c -> runQuery c q
 
 runCountOpaQuery :: Select a -> Cmd err Int

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

@@ -15,6 +15,7 @@ Portability : POSIX
 {-# LANGUAGE Arrows                 #-}
 {-# LANGUAGE ConstraintKinds        #-}
 {-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE QuasiQuotes       #-}
 {-# LANGUAGE TemplateHaskell        #-}
 {-# LANGUAGE TypeFamilies           #-}
 
@@ -26,7 +27,13 @@ import Control.Lens (set, view)
 import Data.Aeson
 import Data.Maybe (Maybe(..), fromMaybe, maybe)
 import Data.Text (Text)
+import qualified Database.PostgreSQL.Simple as DPS
+import Database.PostgreSQL.Simple.SqlQQ (sql)
 import GHC.Int (Int64)
+import Opaleye hiding (FromField)
+import Opaleye.Internal.QueryArr (Query)
+import Prelude hiding (null, id, map, sum)
+
 import Gargantext.Core.Types
 import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Hyperdata
@@ -37,9 +44,6 @@ import Gargantext.Database.Query.Filter (limit', offset')
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude hiding (sum, head)
-import Opaleye hiding (FromField)
-import Opaleye.Internal.QueryArr (Query)
-import Prelude hiding (null, id, map, sum)
 
 
 queryNodeSearchTable :: Query NodeSearchRead
@@ -107,6 +111,31 @@ getNodesWithParentId n = runOpaQuery $ selectNodesWithParentID n'
       Just n'' -> n''
       Nothing  -> 0
 
+
+-- | Given a node id, find it's closest parent of given type
+-- NOTE: This isn't too optimal: can make successive queries depending on how
+-- deeply nested the child is.
+getClosestParentIdByType :: NodeId
+                         -> NodeType
+                         -> Cmd err (Maybe NodeId)
+getClosestParentIdByType nId nType = do
+  result <- runPGSQuery query (nId, 0 :: Int)
+  case result of
+    [DPS.Only parentId, DPS.Only pTypename] -> do
+      if nodeTypeId nType == pTypename then
+        pure $ Just $ NodeId parentId
+      else
+        getClosestParentIdByType (NodeId parentId) nType
+    _ -> pure Nothing
+  where
+    query :: DPS.Query
+    query = [sql|
+      SELECT n2.id, n2.typename
+        FROM nodes n1
+        JOIN nodes n2 ON n1.parent_id = n2.id
+        WHERE n1.id = ? AND 0 = ?;
+    |]
+
 ------------------------------------------------------------------------
 getDocumentsV3WithParentId :: NodeId -> Cmd err [Node HyperdataDocumentV3]
 getDocumentsV3WithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocument)

src/Gargantext/Viz/Graph/API.hs

@@ -36,15 +36,17 @@ import Gargantext.API.Ngrams.Tools
 import Gargantext.API.Prelude
 import Gargantext.Core.Types.Main
 import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
+import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Admin.Config
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Database.Query.Table.Node
+import Gargantext.Database.Query.Table.Node.User (getNodeUser)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.Select
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Ngrams
-import Gargantext.Database.Schema.Node (node_parentId, node_hyperdata)
+import Gargantext.Database.Schema.Node (node_parentId, node_hyperdata, node_name, node_userId)
 import Gargantext.Prelude
 import Gargantext.Viz.Graph
 import Gargantext.Viz.Graph.GEXF ()
@@ -56,6 +58,9 @@ import Gargantext.Viz.Graph.Distances (Distance(..), GraphMetric(..))
 -- as simple Node.
 type GraphAPI   =  Get  '[JSON] Graph
               :<|> "async" :> GraphAsyncAPI
+              :<|> "clone"
+                   :> ReqBody '[JSON] Graph
+                   :> Post '[JSON] NodeId
               :<|> "gexf" :> Get '[XML] (Headers '[Servant.Header "Content-Disposition" Text] Graph)
               :<|> "versions" :> GraphVersionsAPI
 
@@ -71,6 +76,7 @@ instance ToSchema GraphVersions
 graphAPI :: UserId -> NodeId -> GargServer GraphAPI
 graphAPI u n = getGraph         u n
           :<|> graphAsync       u n
+          :<|> graphClone       u n
           :<|> getGraphGexf     u n
           :<|> graphVersionsAPI u n
 
@@ -235,6 +241,29 @@ graphVersions _uId nId = do
 recomputeVersions :: UserId -> NodeId -> GargNoServer Graph
 recomputeVersions uId nId = recomputeGraph uId nId Conditional
 
+------------------------------------------------------------
+graphClone :: UserId
+           -> NodeId
+           -> Graph
+           -> GargNoServer NodeId
+graphClone uId pId graph = do
+  let nodeType = NodeGraph
+  nodeUser <- getNodeUser (NodeId uId)
+  nodeParent <- getNodeWith pId HyperdataGraph
+  let uId' = nodeUser ^. node_userId
+  nIds <- mkNodeWithParent nodeType (Just pId) uId' $ nodeParent ^. node_name
+  case nIds of
+    [] -> pure pId
+    (nId:_) -> do
+      -- TODO possibly slow, use async jobs here
+      --graphP <- getGraph uId pId
+      let graphP = graph
+      let graphP' = set (graph_metadata . _Just . gm_startForceAtlas) False graphP
+
+      _ <- updateHyperdata nId (HyperdataGraph $ Just graphP')
+
+      pure nId
+
 ------------------------------------------------------------
 getGraphGexf :: UserId
              -> NodeId