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
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"
+ }
+ )