ElEve: alternative split
[gargantext.git] / src / Gargantext / Database / Schema / NodeNgram.hs
index c27aa34c192d20324827fb075c739c16051bda32..315201db1c9aeff3bc6ff2fa9fbafc2c01b64747 100644 (file)
@@ -16,93 +16,117 @@ if Node is a List     then it is listing (either Stop, Candidate or Map)
 
 {-# OPTIONS_GHC -fno-warn-orphans   #-}
 
-{-# LANGUAGE Arrows                 #-}
-{-# LANGUAGE FlexibleInstances      #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses  #-}
-{-# LANGUAGE NoImplicitPrelude      #-}
-{-# LANGUAGE OverloadedStrings      #-}
-{-# LANGUAGE QuasiQuotes            #-}
-{-# LANGUAGE RankNTypes             #-}
-{-# LANGUAGE TemplateHaskell        #-}
+{-# LANGUAGE Arrows                     #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE FunctionalDependencies     #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE QuasiQuotes                #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE TemplateHaskell            #-}
 
 
 -- TODO NodeNgrams
 module Gargantext.Database.Schema.NodeNgram where
 
+import Data.ByteString (ByteString)
 import Data.Text (Text)
-import Control.Lens.TH (makeLensesWith, abbreviatedFields)
+import Control.Lens.TH (makeLenses)
+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.Schema.NodeNgramsNgrams
+import Gargantext.Database.Utils (mkCmd, Cmd, execPGSQuery)
+import Gargantext.Core.Types.Main (ListTypeId)
+import Gargantext.Database.Types.Node (NodeId, ListId)
+import Gargantext.Database.Schema.Node (pgNodeId)
+import Gargantext.Database.Schema.Ngrams (NgramsTypeId, pgNgramsTypeId)
 import Gargantext.Prelude
+import Gargantext.Database.Utils (formatPGSQuery)
 import Opaleye
-import qualified Database.PostgreSQL.Simple as PGS (Only(..))
+import qualified Database.PostgreSQL.Simple as DPS
 
 -- | TODO : remove id
-data NodeNgramPoly id node_id ngram_id weight ngrams_type
-   = NodeNgram { nodeNgram_id      :: id
-               , nodeNgram_node_id  :: node_id
-               , nodeNgram_ngrams_id :: ngram_id
-               , nodeNgram_weight  :: weight
-               , nodeNgram_type    :: ngrams_type
+data NodeNgramPoly node_id ngrams_id parent_id ngrams_type list_type weight
+   = NodeNgram { nng_node_id    :: node_id
+               , nng_ngrams_id  :: ngrams_id
+               , nng_parent_id  :: parent_id
+              
+               , nng_ngramsType :: ngrams_type
+               , nng_listType   :: list_type
+               , nng_weight     :: weight
                } deriving (Show)
 
 type NodeNgramWrite =
      NodeNgramPoly
-        (Maybe (Column PGInt4  ))
                (Column PGInt4  )
                (Column PGInt4  )
-               (Column PGFloat8)
+               (Maybe (Column PGInt4))
+               
+               (Column PGInt4  )
                (Column PGInt4  )
+               (Column PGFloat8)
 
 type NodeNgramRead =
      NodeNgramPoly
        (Column PGInt4  )
        (Column PGInt4  )
        (Column PGInt4  )
-       (Column PGFloat8)
+       
+       (Column PGInt4  )
        (Column PGInt4  )
+       (Column PGFloat8)
 
 type NodeNgramReadNull =
      NodeNgramPoly
        (Column (Nullable PGInt4  ))
        (Column (Nullable PGInt4  ))
        (Column (Nullable PGInt4  ))
-       (Column (Nullable PGFloat8))
+       
+       (Column (Nullable PGInt4  ))
        (Column (Nullable PGInt4  ))
+       (Column (Nullable PGFloat8))
 
 type NodeNgram =
-     NodeNgramPoly (Maybe Int) Int Int Double Int
+     NodeNgramPoly NodeId Int (Maybe NgramsParentId) NgramsTypeId Int Double
 
-$(makeAdaptorAndInstance "pNodeNgram" ''NodeNgramPoly)
-$(makeLensesWith abbreviatedFields    ''NodeNgramPoly)
+newtype NgramsParentId = NgramsParentId Int
+  deriving (Show, Eq, Num)
 
+pgNgramsParentId :: NgramsParentId -> Column PGInt4
+pgNgramsParentId (NgramsParentId n) = pgInt4 n
+
+$(makeAdaptorAndInstance "pNodeNgram" ''NodeNgramPoly)
+makeLenses ''NodeNgramPoly
 
 nodeNgramTable :: Table NodeNgramWrite NodeNgramRead
 nodeNgramTable  = Table "nodes_ngrams"
   ( pNodeNgram NodeNgram
-    { nodeNgram_id        = optional "id"
-    , nodeNgram_node_id   = required "node_id"
-    , nodeNgram_ngrams_id = required "ngram_id"
-    , nodeNgram_weight    = required "weight"
-    , nodeNgram_type      = required "ngrams_type"
+    { nng_node_id    = required "node_id"
+    , nng_ngrams_id  = required "ngrams_id"
+    , nng_parent_id  = optional "parent_id"
+    , nng_ngramsType = required "ngrams_type"
+    , nng_listType   = required "list_type"
+    , nng_weight     = required "weight"
     }
   )
 
 queryNodeNgramTable :: Query NodeNgramRead
 queryNodeNgramTable = queryTable nodeNgramTable
 
+--{-
 insertNodeNgrams :: [NodeNgram] -> Cmd err Int
 insertNodeNgrams = insertNodeNgramW
-                 . map (\(NodeNgram _ n g w t) ->
-                          NodeNgram Nothing (pgInt4 n)   (pgInt4 g)
-                                            (pgDouble w) (pgInt4 t)
+                 . map (\(NodeNgram n g p ngt lt w) ->
+                          NodeNgram (pgNodeId n)
+                                    (pgInt4 g)
+                                    (pgNgramsParentId <$> p)
+                                    (pgNgramsTypeId ngt)
+                                    (pgInt4 lt)
+                                    (pgDouble w)
                         )
-
 insertNodeNgramW :: [NodeNgramWrite] -> Cmd err Int
 insertNodeNgramW nns =
   mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing
@@ -112,34 +136,33 @@ insertNodeNgramW nns =
                               , iReturning = rCount
                               , iOnConflict = (Just DoNothing)
                               })
-
+--}
 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 -> [(NgramsTypeId, NgramsText, ListTypeId)] -> Cmd err ()
+updateNodeNgrams' _      []    = pure ()
+updateNodeNgrams' listId input = void $ execPGSQuery updateQuery (DPS.Only $ Values fields input')
+  where
+    fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","text","int4"]
+    input' = map (\(nt,t,lt) -> (listId, nt, t, lt)) input
+
+updateNodeNgrams'_debug :: ListId -> [(NgramsTypeId, NgramsText, ListTypeId)] -> Cmd err ByteString
+updateNodeNgrams'_debug listId input = formatPGSQuery updateQuery (DPS.Only $ Values fields input')
   where
-    fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","text","int4"]
-    updateQuery = [sql| UPDATE nodes_ngrams as old SET
-                 ngrams_type = new.typeList
-                 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 new.ngram_id
-                 |]
-
-data NodeNgramsUpdate = NodeNgramsUpdate
-  { _nnu_lists_update :: [(ListId, NgramsText, ListTypeId)]
-  , _nnu_add_children :: [(ListId, NgramsParent, NgramsChild, Maybe Double)]
-  , _nnu_rem_children :: [(ListId, NgramsParent, NgramsChild, Maybe Double)]
-  }
-
--- TODO wrap these updates in a transaction.
-updateNodeNgrams :: NodeNgramsUpdate -> Cmd err [Int]
-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
+    fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","text","int4"]
+    input' = map (\(nt,t,lt) -> (listId, nt, t, lt)) input
+
+updateQuery :: DPS.Query
+updateQuery = [sql|
+WITH new(node_id,ngrams_type,terms,typeList) as (?)
+
+INSERT into nodes_ngrams (node_id,ngrams_id,ngrams_type,list_type,weight)
+
+SELECT node_id,ngrams.id,ngrams_type,typeList,1 FROM new
+JOIN ngrams ON ngrams.terms = new.terms
+ON CONFLICT (node_id, ngrams_id, ngrams_type) DO
+-- DO NOTHING
+
+UPDATE SET list_type = excluded.list_type
+;
+               |]