[REFACT] FlowList integration to Terms with instances
[gargantext.git] / src / Gargantext / API / Node / Update.hs
index 0fad7b9c9d6dd22493fef761c8f6a1be33c0012e..1d5f5aabc5043826cbcc518a8facce7c7ef30e8e 100644 (file)
@@ -17,40 +17,41 @@ module Gargantext.API.Node.Update
       where
 
 import Data.Aeson
+import Data.Maybe (Maybe(..))
 import Data.Swagger
 import GHC.Generics (Generic)
-import Gargantext.API.Admin.Orchestrator.Types (ScraperStatus(..))
-import Gargantext.API.Node.Corpus.New (AsyncJobs)
-import Gargantext.API.Prelude (GargServer{-, simuLogs-})
-import Gargantext.Database.Action.Flow.Types (FlowCmdM)
-import Gargantext.Database.Admin.Types.Node
-import Gargantext.Prelude (Ord, Eq, (<$>), ($), liftBase, (.), Int, (-), pure, (*), (^), printDebug)
 import Prelude (Enum, Bounded, minBound, maxBound)
 import Servant
 import Servant.Job.Async (JobFunction(..), serveJobsAPI)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 
-import Data.Maybe (Maybe(..))
-import Control.Concurrent (threadDelay)
-
+import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
+import Gargantext.API.Admin.Types (HasSettings)
+import Gargantext.API.Prelude (GargServer, simuLogs)
+import Gargantext.Core.Viz.Graph.API (recomputeGraph)
+import Gargantext.Core.Methods.Distances (GraphMetric(..), Distance(..))
+import Gargantext.Database.Action.Flow.Pairing (pairing)
+import Gargantext.Database.Action.Flow.Types (FlowCmdM)
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Prelude (Ord, Eq, (<$>), ($), liftBase, (.), printDebug, pure, show, cs, (<>), panic)
 
+------------------------------------------------------------------------
+type API = Summary " Update node according to NodeType params"
+         :> AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog
 
 ------------------------------------------------------------------------
-data UpdateNodeParams = UpdateNodeParamsList  { methodList  :: Method      }
-                      | UpdateNodeParamsGraph { methodGraph :: GraphMetric }
-                      | UpdateNodeParamsTexts { methodTexts :: Granularity }
-                      | UpdateNodeParamsBoard { methodBoard :: Charts      }
+data UpdateNodeParams = UpdateNodeParamsList  { methodList  :: !Method      }
+                      | UpdateNodeParamsGraph { methodGraph :: !GraphMetric }
+                      | UpdateNodeParamsTexts { methodTexts :: !Granularity }
+                      | UpdateNodeParamsBoard { methodBoard :: !Charts      }
+                      | LinkNodeReq { nodeType :: !NodeType, id :: !NodeId }
     deriving (Generic)
 
 ----------------------------------------------------------------------
 data Method = Basic | Advanced | WithModel
     deriving (Generic, Eq, Ord, Enum, Bounded)
 
-----------------------------------------------------------------------
-data GraphMetric = Order1 | Order2
-    deriving (Generic, Eq, Ord, Enum, Bounded)
-
 ----------------------------------------------------------------------
 data Granularity = NewNgrams | NewTexts | Both
     deriving (Generic, Eq, Ord, Enum, Bounded)
@@ -59,10 +60,72 @@ data Granularity = NewNgrams | NewTexts | Both
 data Charts = Sources | Authors | Institutes | Ngrams | All
     deriving (Generic, Eq, Ord, Enum, Bounded)
 
+------------------------------------------------------------------------
+api :: UserId -> NodeId -> GargServer API
+api uId nId =
+  serveJobsAPI $
+    JobFunction (\p log'' ->
+      let
+        log' x = do
+          printDebug "updateNode" x
+          liftBase $ log'' x
+      in updateNode uId nId p (liftBase . log')
+      )
+
+updateNode :: (HasSettings env, FlowCmdM env err m)
+    => UserId
+    -> NodeId
+    -> UpdateNodeParams
+    -> (JobLog -> m ())
+    -> m JobLog
+updateNode uId nId (UpdateNodeParamsGraph metric) logStatus = do
+
+  logStatus JobLog { _scst_succeeded = Just 1
+                   , _scst_failed    = Just 0
+                   , _scst_remaining = Just 1
+                   , _scst_events    = Just []
+                   }
+
+  _ <- case metric of
+    Order1 -> recomputeGraph uId nId Conditional
+    Order2 -> recomputeGraph uId nId Distributional
+
+  pure  JobLog { _scst_succeeded = Just 2
+               , _scst_failed    = Just 0
+               , _scst_remaining = Just 0
+               , _scst_events    = Just []
+               }
+
+updateNode _uId nid1 (LinkNodeReq nt nid2) logStatus = do
+  logStatus JobLog { _scst_succeeded = Just 1
+                   , _scst_failed    = Just 0
+                   , _scst_remaining = Just 1
+                   , _scst_events    = Just []
+                   }
+  _ <- case nt of
+    NodeAnnuaire -> pairing nid2 nid1 Nothing -- defaultList
+    NodeCorpus   -> pairing nid1 nid2 Nothing -- defaultList
+    _            -> panic $ "[G.API.N.Update.updateNode] NodeType not implemented"
+                           <> cs (show nt)
+
+  pure  JobLog { _scst_succeeded = Just 2
+               , _scst_failed    = Just 0
+               , _scst_remaining = Just 0
+               , _scst_events    = Just []
+               }
+
+
+updateNode _uId _nId _p logStatus = do
+  simuLogs logStatus 10
+
 ------------------------------------------------------------------------
 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
-instance FromJSON  UpdateNodeParams
-instance ToJSON    UpdateNodeParams
+instance FromJSON  UpdateNodeParams where
+  parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+
+instance ToJSON    UpdateNodeParams where
+  toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+  
 instance ToSchema  UpdateNodeParams
 instance Arbitrary UpdateNodeParams where
   arbitrary = do
@@ -78,12 +141,6 @@ instance ToSchema  Method
 instance Arbitrary Method where
   arbitrary = elements [ minBound .. maxBound ]
 
-instance FromJSON  GraphMetric
-instance ToJSON    GraphMetric
-instance ToSchema  GraphMetric
-instance Arbitrary GraphMetric where
-  arbitrary = elements [ minBound .. maxBound ]
-
 instance FromJSON  Granularity
 instance ToJSON    Granularity
 instance ToSchema  Granularity
@@ -97,57 +154,3 @@ instance Arbitrary Charts where
   arbitrary = elements [ minBound .. maxBound ]
 
 ------------------------------------------------------------------------
-api :: UserId -> NodeId -> GargServer API
-api uId nId =
-  serveJobsAPI $ 
-    JobFunction (\p logs -> updateNode uId nId p (liftBase . logs))
-
-
-updateNode :: FlowCmdM env err m
-    => UserId
-    -> NodeId
-    -> UpdateNodeParams
-    -> (ScraperStatus -> m ())
-    -> m ScraperStatus
-updateNode _uId _nId _ logStatus = do
-
--- Why this does not work ?
---  simuLogs logStatus 100
-
-  logStatus $ ScraperStatus { _scst_succeeded = Just 1
-                             , _scst_failed    = Just 0
-                             , _scst_remaining = Just 10
-                             , _scst_events    = Just []
-                             }
-
-  let
-    m = (10 :: Int) ^ (6 :: Int)
-    status t n = do
-      _ <- liftBase $ threadDelay ( m * 100)
-      let s = ScraperStatus { _scst_succeeded = Just n
-                             , _scst_failed    = Just 0
-                             , _scst_remaining = Just (t - n)
-                             , _scst_events    = Just []
-                             }
-      printDebug "status " s
-      pure s
-
-  s1 <- status 10 2
-  logStatus s1
-
-  s2 <- status 10 5
-  logStatus s2
-
-  s3 <- status 10 7
-  logStatus s3
-
-  status 10 10
-
-
-
-
-
-
-------------------------------------------------------------------------
-type API = Summary " Share Node with username"
-         :> AsyncJobs ScraperStatus '[JSON] UpdateNodeParams ScraperStatus