[OPTIM] MVar for Graph Clustering.

src/Gargantext/API.hs

@@ -239,11 +239,11 @@ type GargPrivateAPI' =
                            :> NodeAPI HyperdataAny
 
            -- Corpus endpoints
-           :<|> "corpus":> Summary "Corpus endpoint"
+           :<|> "corpus"   :> Summary "Corpus endpoint"
                            :> Capture "corpus_id" CorpusId
                            :> NodeAPI HyperdataCorpus
 
-           :<|> "corpus":> Summary "Corpus endpoint"
+           :<|> "corpus"   :> Summary "Corpus endpoint"
                            :> Capture "node1_id" NodeId
                            :> "document"
                            :> Capture "node2_id" NodeId
@@ -253,27 +253,29 @@ type GargPrivateAPI' =
                            :> Export.API
 
            -- Annuaire endpoint
-           :<|> "annuaire":> Summary "Annuaire endpoint"
+           :<|> "annuaire" :> Summary "Annuaire endpoint"
                            :> Capture "annuaire_id" AnnuaireId
                            :> NodeAPI HyperdataAnnuaire
 
            :<|> "annuaire" :> Summary "Contact endpoint"
                            :> Capture "annuaire_id" NodeId
-                           :> "contact" :> Capture "contact_id" NodeId
+                           :> "contact"
+                           :> Capture "contact_id" NodeId
                            :> NodeNodeAPI HyperdataContact
 
            -- Document endpoint
-           :<|> "document":> Summary "Document endpoint"
+           :<|> "document" :> Summary "Document endpoint"
                            :> Capture "doc_id" DocId
                            :> "ngrams" :> TableNgramsApi
 
         -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
             -- TODO-SECURITY
            :<|> "count"    :> Summary "Count endpoint"
-                        :> ReqBody '[JSON] Query :> CountAPI
+                           :> ReqBody '[JSON] Query
+                           :> CountAPI
 
            -- Corpus endpoint --> TODO rename s/search/filter/g
-           :<|> "search":> Capture "corpus" NodeId
+           :<|> "search"   :> Capture "corpus" NodeId
                            :> SearchPairsAPI
 
            -- TODO move to NodeAPI?
@@ -470,7 +472,7 @@ type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
 swaggerDoc :: Swagger
 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
   & info.title       .~ "Gargantext"
-  & info.version     .~ "4.0.2" -- TODO same version as Gargantext
+  & info.version     .~ "0.0.1.3.1" -- TODO same version as Gargantext
   -- & info.base_url     ?~ (URL "http://gargantext.org/")
   & info.description ?~ "REST API specifications"
   -- & tags             .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]

src/Gargantext/API/Corpus/New.hs

@@ -78,10 +78,15 @@ instance Arbitrary Query where
 instance ToSchema Query where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "query_")
 
-type Api = Summary "New Corpus endpoint"
+------------------------------------------------------------------------
+
+type Api = PostApi
+        :<|> GetApi
+
+type PostApi = Summary "New Corpus endpoint"
              :> ReqBody '[JSON] Query
              :> Post '[JSON] CorpusId
-        :<|> Get '[JSON] ApiInfo
+type GetApi = Get '[JSON] ApiInfo
 
 -- | TODO manage several apis
 -- TODO-ACCESS

src/Gargantext/Viz/Graph/Tools.hs

@@ -15,6 +15,8 @@ Portability : POSIX
 module Gargantext.Viz.Graph.Tools
   where
 
+import Control.Monad.IO.Class (liftIO)
+import Control.Concurrent (newEmptyMVar, takeMVar, putMVar, forkIO)
 import Debug.Trace (trace)
 import Data.Graph.Clustering.Louvain.CplusPlus (LouvainNode(..))
 import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain)
@@ -68,11 +70,14 @@ cooc2graph threshold myCooc = do
           n' = Set.size $ Set.fromList $ as <> bs
       ClustersParams rivers level = {-trace ("nodesApprox: " <> show nodesApprox) $-} clustersParams nodesApprox
 
-
-  partitions <- case Map.size distanceMap > 0 of
+  partitionsV <- liftIO newEmptyMVar
+  partitions' <- case Map.size distanceMap > 0 of
     True  -> trace ("level" <> show level) $ cLouvain level distanceMap
     False -> panic "Text.Flow: DistanceMap is empty"
 
+  _ <- liftIO $ forkIO $ putMVar partitionsV partitions'
+  partitions <- liftIO $ takeMVar partitionsV
+
   let bridgeness' = {-trace ("rivers: " <> show rivers) $-}
                     bridgeness rivers partitions distanceMap