Merge remote-tracking branch 'origin/dev-ngrams-table' into dev

src/Gargantext/API/Ngrams.hs

@@ -44,7 +44,7 @@ import qualified Data.Set as Set
 import Data.Map.Strict (Map)
 --import qualified Data.Set as Set
 import Control.Lens (makeLenses, Prism', prism', (^..), (.~), (#), to, withIndex, folded, ifolded)
-import Control.Monad (guard, void)
+import Control.Monad (guard)
 import Control.Monad.Error.Class (MonadError, throwError)
 import Data.Aeson
 import Data.Aeson.TH (deriveJSON)
@@ -297,7 +297,7 @@ tableNgramsPatch :: (HasNgramError err, HasNodeError err)
 tableNgramsPatch corpusId maybeList (Versioned version patch) = do
   when (version /= 1) $ ngramError UnsupportedVersion
   listId <- maybe (defaultList corpusId) pure maybeList
-  void $ updateNodeNgrams $ NodeNgramsUpdate
+  updateNodeNgrams $ NodeNgramsUpdate
     { _nnu_lists_update = mkListsUpdate listId patch
     , _nnu_rem_children = mkChildrenGroups listId _rem patch
     , _nnu_add_children = mkChildrenGroups listId _add patch

src/Gargantext/Database/Schema/NodeNgram.hs

@@ -32,11 +32,12 @@ module Gargantext.Database.Schema.NodeNgram where
 
 import Data.Text (Text)
 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
+import Control.Monad (void)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Gargantext.Core.Types.Main (ListId, ListTypeId)
-import Gargantext.Database.Utils (mkCmd, Cmd, runPGSQuery)
+import Gargantext.Database.Utils (mkCmd, Cmd, execPGSQuery)
 import Gargantext.Database.Schema.NodeNgramsNgrams
 import Gargantext.Prelude
 import Opaleye
@@ -115,10 +116,9 @@ insertNodeNgramW nns =
 
 type NgramsText = Text
 
-updateNodeNgrams' :: [(ListId, NgramsText, ListTypeId)] -> Cmd err [Int]
-updateNodeNgrams' [] = pure []
-updateNodeNgrams' input = map (\(PGS.Only a) -> a) <$>
-                          runPGSQuery updateQuery (PGS.Only $ Values fields $ input)
+updateNodeNgrams' :: [(ListId, NgramsText, ListTypeId)] -> Cmd err ()
+updateNodeNgrams' [] = pure ()
+updateNodeNgrams' input = void $ execPGSQuery updateQuery (PGS.Only $ Values fields input)
   where
     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","text","int4"]
     updateQuery = [sql| UPDATE nodes_ngrams as old SET
@@ -126,8 +126,7 @@ updateNodeNgrams' input = map (\(PGS.Only a) -> a) <$>
                  from (?) as new(node_id,terms,typeList)
                  JOIN ngrams ON ngrams.terms = new.terms
                  WHERE old.node_id = new.node_id
-                 AND   old.ngram_id = ngrams.id
-                 RETURNING old.ngram_id;
+                 AND   old.ngram_id = ngrams.id;
                  |]
 
 data NodeNgramsUpdate = NodeNgramsUpdate
@@ -137,9 +136,8 @@ data NodeNgramsUpdate = NodeNgramsUpdate
   }
 
 -- TODO wrap these updates in a transaction.
-updateNodeNgrams :: NodeNgramsUpdate -> Cmd err [Int]
+updateNodeNgrams :: NodeNgramsUpdate -> Cmd err ()
 updateNodeNgrams nnu = do
-  xs <- updateNodeNgrams' $ _nnu_lists_update nnu
-  ys <- ngramsGroup Del   $ _nnu_rem_children nnu
-  zs <- ngramsGroup Add   $ _nnu_add_children nnu
-  pure $ xs <> ys <> zs
+  updateNodeNgrams' $ _nnu_lists_update nnu
+  ngramsGroup Del   $ _nnu_rem_children nnu
+  ngramsGroup Add   $ _nnu_add_children nnu

src/Gargantext/Database/Schema/NodeNgramsNgrams.hs

@@ -34,13 +34,14 @@ module Gargantext.Database.Schema.NodeNgramsNgrams
 
 import Control.Lens (view)
 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
+import Control.Monad (void)
 import Control.Monad.IO.Class (liftIO)
 import Data.Text (Text)
 import Data.Maybe (Maybe)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
-import Gargantext.Database.Utils (Cmd, runOpaQuery, runPGSQuery, connection)
+import Gargantext.Database.Utils (Cmd, runOpaQuery, execPGSQuery, connection)
 import Gargantext.Core.Types.Main (ListId)
 import Gargantext.Prelude
 import Opaleye
@@ -126,8 +127,8 @@ type NgramsChild  = Text
 
 
 ngramsGroup :: Action -> [(ListId, NgramsParent, NgramsChild, Maybe Double)]
-             -> Cmd err [Int]
-ngramsGroup _ [] = pure []
+             -> Cmd err ()
+ngramsGroup _ [] = pure ()
 ngramsGroup action ngs = runNodeNgramsNgrams q ngs
   where
     q = case action of
@@ -135,12 +136,12 @@ ngramsGroup action ngs = runNodeNgramsNgrams q ngs
           Add -> queryInsertNodeNgramsNgrams
 
 
-runNodeNgramsNgrams :: PGS.Query -> [(ListId, NgramsParent, NgramsChild, Maybe Double)] -> Cmd err [Int]
-runNodeNgramsNgrams q ngs = map (\(PGS.Only a) -> a) <$> runPGSQuery q (PGS.Only $ Values fields ngs' )
+runNodeNgramsNgrams :: PGS.Query -> [(ListId, NgramsParent, NgramsChild, Maybe Double)] -> Cmd err ()
+runNodeNgramsNgrams q ngs = void $ execPGSQuery q (PGS.Only $ Values fields ngs')
   where
     ngs'   = map (\(n,ng1,ng2,w) -> (n,ng1,ng2,maybe 0 identity w)) ngs
     fields = map (\t -> QualifiedIdentifier Nothing t)
-                 ["int4","text","text","real"]
+                 ["int4","text","text","float8"]
 
 --------------------------------------------------------------------
 -- TODO: on conflict update weight

src/Gargantext/Database/Utils.hs

@@ -91,6 +91,9 @@ formatPGSQuery q a = mkCmd $ \conn -> PGS.formatQuery conn q a
 runPGSQuery :: (PGS.ToRow a, PGS.FromRow b) => PGS.Query -> a -> Cmd err [b]
 runPGSQuery q a = mkCmd $ \conn -> PGS.query conn q a
 
+execPGSQuery :: PGS.ToRow a => PGS.Query -> a -> Cmd err Int64
+execPGSQuery q a = mkCmd $ \conn -> PGS.execute conn q a
+
 ------------------------------------------------------------------------
 
 databaseParameters :: FilePath -> IO PGS.ConnectInfo