Merge remote-tracking branch 'origin/flexible-job-queue' into dev
[gargantext.git] / src / Gargantext / Database / Schema / NodeNgrams.hs
index be387c657cbafab1ea1a895300a2ae0f210d7935..62f1c64bad4ac0f2a38744b07b709984146eb517 100644 (file)
@@ -9,36 +9,24 @@ Portability : POSIX
 
 NodeNgrams register Context of Ngrams (named Cgrams then)
 
-
 -}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 {-# LANGUAGE Arrows                 #-}
-{-# LANGUAGE FlexibleInstances      #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE QuasiQuotes            #-}
-{-# LANGUAGE MultiParamTypeClasses  #-}
-{-# LANGUAGE NoImplicitPrelude      #-}
-{-# LANGUAGE OverloadedStrings      #-}
-{-# LANGUAGE RankNTypes             #-}
 {-# LANGUAGE TemplateHaskell        #-}
 
 module Gargantext.Database.Schema.NodeNgrams where
 
 import Data.Text (Text)
-import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
-import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
-import Database.PostgreSQL.Simple.FromRow (fromRow, field)
-import Database.PostgreSQL.Simple (FromRow)
-import Database.PostgreSQL.Simple.SqlQQ (sql)
--- import Control.Lens.TH (makeLenses)
-import Data.Maybe (Maybe, fromMaybe)
 import Gargantext.Core.Types
-import Gargantext.Database.Utils
-import Gargantext.Database.Schema.Ngrams (NgramsType, NgramsTypeId, ngramsTypeId)
+import Gargantext.Database.Schema.Ngrams (NgramsType)
+import Gargantext.Database.Schema.Prelude
 import Gargantext.Prelude
 
+
 data NodeNgramsPoly id
                     node_id'
                     node_subtype
@@ -48,105 +36,78 @@ data NodeNgramsPoly id
                     ngrams_tag
                     ngrams_class
                     weight
-                   = NodeNgrams { _nng_id        :: id
-                                , _nng_node_id   :: node_id'
-                                , _nng_node_subtype :: node_subtype
-                                , _nng_ngrams_id :: ngrams_id
-                                , _nng_ngrams_type :: ngrams_type
-                                , _nng_ngrams_field :: ngrams_field
-                                , _nng_ngrams_tag :: ngrams_tag
-                                , _nng_ngrams_class :: ngrams_class
-                                , _nng_ngrams_weight :: weight
-                              } deriving (Show)
-
-{-
-type NodeNgramsWrite = NodeNgramsPoly (Maybe (Column (PGInt4)))
-                                      (Column (PGInt4))
-                                      (Maybe  (Column (PGInt4)))
-                                      (Column (PGInt4))
-                                      (Maybe  (Column (PGInt4)))
-                                      (Maybe  (Column (PGInt4)))
-                                      (Maybe  (Column (PGInt4)))
-                                      (Maybe  (Column (PGInt4)))
-                                      (Maybe  (Column (PGFloat8)))
-
-type NodeNodeRead    = NodeNgramsPoly (Column PGInt4)
-                                      (Column PGInt4)
-                                      (Column PGInt4)
-                                      (Column PGInt4)
-                                      (Column PGInt4)
-                                      (Column PGInt4)
-                                      (Column PGInt4)
-                                      (Column PGInt4)
-                                      (Column PGFloat8)
-
-type NodeNgramsReadNull = NodeNgramsPoly (Column (Nullable PGInt4))
-                                         (Column (Nullable PGInt4))
-                                         (Column (Nullable PGInt4))
-                                         (Column (Nullable PGInt4))
-
-                                         (Column (Nullable PGInt4))
-                                         (Column (Nullable PGInt4))
-                                         (Column (Nullable PGInt4))
-                                         (Column (Nullable PGInt4))
-                                         (Column (Nullable PGFloat8))
--}
-type NgramsId = Int
-type NgramsField = Int
-type NgramsTag   = Int
-type NgramsClass = Int
-type NgramsText  = Text
+                   = NodeNgrams { _nng_id            :: !id
+                                , _nng_node_id       :: !node_id'
+                                , _nng_node_subtype  :: !node_subtype
+                                , _nng_ngrams_id     :: !ngrams_id
+                                , _nng_ngrams_type   :: !ngrams_type
+                                , _nng_ngrams_field  :: !ngrams_field
+                                , _nng_ngrams_tag    :: !ngrams_tag
+                                , _nng_ngrams_class  :: !ngrams_class
+                                , _nng_ngrams_weight :: !weight
+                              } deriving (Show, Eq, Ord)
+
+
+type NodeNgramsWrite = NodeNgramsPoly (Maybe (Column (SqlInt4)))
+                                      (Column (SqlInt4))
+                                      (Maybe  (Column (SqlInt4)))
+                                      (Column (SqlInt4))
+                                      (Maybe  (Column (SqlInt4)))
+                                      (Maybe  (Column (SqlInt4)))
+                                      (Maybe  (Column (SqlInt4)))
+                                      (Maybe  (Column (SqlInt4)))
+                                      (Maybe  (Column (SqlFloat8)))
+
+type NodeNgramsRead    = NodeNgramsPoly (Column SqlInt4)
+                                      (Column SqlInt4)
+                                      (Column SqlInt4)
+                                      (Column SqlInt4)
+                                      (Column SqlInt4)
+                                      (Column SqlInt4)
+                                      (Column SqlInt4)
+                                      (Column SqlInt4)
+                                      (Column SqlFloat8)
+
+
+type NodeNgramsReadNull = NodeNgramsPoly (Column (Nullable SqlInt4))
+                                         (Column (Nullable SqlInt4))
+                                         (Column (Nullable SqlInt4))
+                                         (Column (Nullable SqlInt4))
+
+                                         (Column (Nullable SqlInt4))
+                                         (Column (Nullable SqlInt4))
+                                         (Column (Nullable SqlInt4))
+                                         (Column (Nullable SqlInt4))
+                                         (Column (Nullable SqlFloat8))
+type NodeNgramsId = Int
+type NgramsField  = Int
+type NgramsTag    = Int
+type NgramsClass  = Int
+type NgramsText   = Text
 
 -- Example of list Ngrams
 -- type ListNgrams = NodeNgramsPoly (Maybe Int) ListType Text 
 
 type NodeNgramsW =
-  NodeNgramsPoly (Maybe Int) NodeId ListType NgramsText
+  NodeNgramsPoly (Maybe NodeNgramsId) NodeId ListType NgramsText
                   NgramsType (Maybe NgramsField) (Maybe NgramsTag) (Maybe NgramsClass)
                   Double
 
-data Returning = Returning { re_terms :: Text 
-                           , re_ngrams_id :: Int
-                           }
-  deriving (Show)
-
-instance FromRow Returning where
-  fromRow = Returning <$> field <*> field
-
--- insertDb :: ListId -> Map NgramsType [NgramsElemet] -> Cmd err [Result]
-listInsertDb :: ListId
-             -> (ListId -> a -> [NodeNgramsW])
-             -> a
-             -> Cmd err [Returning]
-listInsertDb l f ngs = insertNodeNgrams (f l ngs)
-
--- TODO optimize with size of ngrams
-insertNodeNgrams :: [NodeNgramsW] -> Cmd err [Returning]
-insertNodeNgrams nns = runPGSQuery query (PGS.Only $ Values fields nns')
-  where
-    fields = map (\t-> QualifiedIdentifier Nothing t) [ "int4","int4","text","int4"
-                                                      ,"int4","int4","int4","int4"
-                                                      ,"float8"]
-    nns' :: [(Int, ListTypeId, NgramsText, NgramsTypeId ,NgramsField, NgramsTag, NgramsClass, Double)]
-    nns' = map (\(NodeNgrams _id (NodeId node_id'') node_subtype ngrams_terms ngrams_type ngrams_field ngrams_tag ngrams_class weight)
-                              -> ( node_id''
-                                 , listTypeId node_subtype
-                                 , ngrams_terms
-                                 , ngramsTypeId ngrams_type
-                                 , fromMaybe 0 ngrams_field
-                                 , fromMaybe 0 ngrams_tag
-                                 , fromMaybe 0 ngrams_class
-                                 , weight
-                                 )
-                  ) nns
-
-    query :: PGS.Query
-    query = [sql|
-          INSERT INTO node_ngrams_ngrams nnn VALUES (node_id, node_type, ngrams_id, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight)
-          SELECT n.node_id, n.node_type, ng.ngrams_id, n.ngrams_type, n.ngrams_field, n.ngrams_tag, n.ngrams_class, n.weight FROM (?)
-              AS n(node_id, node_type, ngrams_terms, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight)
-          INNER JOIN ngrams as ng ON ng.terms = n.ngrams_terms
-          ON CONFLICT(node_id, ngrams_id)
-          DO UPDATE SET node_type = excluded.node_type, ngrams_type = excluded.ngrams_type, ngrams_field = excluded.ngrams_field, ngrams_tag = excluded.ngrams_tag, ngrams_class = excluded.ngrams_class, weight = excluded.weight
-          RETURNING nnn.id, n.ngrams_terms
-  |]
+$(makeAdaptorAndInstance "pNodeNgrams" ''NodeNgramsPoly)
+makeLenses ''NodeNgramsPoly
+
+nodeNgramsTable :: Table NodeNgramsWrite NodeNgramsRead
+nodeNgramsTable  =
+  Table "node_ngrams"
+         ( pNodeNgrams
+           NodeNgrams { _nng_id            = optionalTableField "id"
+                      , _nng_node_id       = requiredTableField "node_id"
+                      , _nng_node_subtype  = optionalTableField "node_subtype"
+                      , _nng_ngrams_id     = requiredTableField "ngrams_id"
+                      , _nng_ngrams_type   = optionalTableField "ngrams_type"
+                      , _nng_ngrams_field  = optionalTableField "ngrams_field"
+                      , _nng_ngrams_tag    = optionalTableField "ngrams_tag"
+                      , _nng_ngrams_class  = optionalTableField "ngrams_class"
+                      , _nng_ngrams_weight = optionalTableField "weight"
+                      }
+                  )