[FIX] merge
[gargantext.git] / src / Gargantext / Database / Schema / NodeNgrams.hs
index bca407ac556ee90aa5cf8edcb079064c016ea876..89aa88a53093117a7718ca82cd43470bb3bc3d20 100644 (file)
@@ -9,42 +9,22 @@ 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.Map (Map)
-import qualified Data.Map as Map
-import Data.List.UniqueStrict (sortUniq)
-import qualified Data.List as List
 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.ToField (toField)
-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, fromNgramsTypeId)
+import Gargantext.Database.Schema.Ngrams (NgramsType)
 import Gargantext.Prelude
 
-type NodeNgramsId = Int
 
 data NodeNgramsPoly id
                     node_id'
@@ -55,56 +35,18 @@ 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
+                   = 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)
 
 {-
-instance ( Eq id
-         , Eq node_id'
-         , Eq node_subtype
-         , Eq ngrams_id
-         , Eq ngrams_type
-         , Eq ngrams_field
-         , Eq ngrams_tag
-         , Eq ngrams_class
-         , Eq weight
-         ) => Eq (NodeNgramsPoly id node_id' node_subtype ngrams_id ngrams_type ngrams_field ngrams_tag ngrams_class weight) where
-  (==) (NodeNgrams a b c d e f g h i)
-       (NodeNgrams a' b' c' d' e' f' g' h' i') =
-         all identity [ a == a'
-                       , b == b'
-                       , c == c'
-                       , d == d'
-                       , e == e'
-                       , f == f'
-                       , g == g'
-                       , h == h'
-                       , i == i'
-                       ]
-
-instance ( Ord id
-         , Ord node_id'
-         , Ord node_subtype
-         , Ord ngrams_id
-         , Ord ngrams_type
-         , Ord ngrams_field
-         , Ord ngrams_tag
-         , Ord ngrams_class
-         , Ord weight
-         ) => Ord (NodeNgramsPoly id node_id' node_subtype ngrams_id ngrams_type ngrams_field ngrams_tag ngrams_class weight) where
-  compare (NodeNgrams a _b _c _d _e _f _g _h _i)
-          (NodeNgrams a' _b' _c' _d' _e' _f' _g' _h' _i') =
-            compare a a'
-
-
 type NodeNgramsWrite = NodeNgramsPoly (Maybe (Column (PGInt4)))
                                       (Column (PGInt4))
                                       (Maybe  (Column (PGInt4)))
@@ -136,78 +78,18 @@ type NodeNgramsReadNull = NodeNgramsPoly (Column (Nullable PGInt4))
                                          (Column (Nullable PGInt4))
                                          (Column (Nullable PGFloat8))
 -}
-type NgramsId = Int
-type NgramsField = Int
-type NgramsTag   = Int
-type NgramsClass = Int
-type NgramsText  = Text
+type NodeNgramsId = Int
+type NgramsId     = 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_type :: Maybe NgramsType
-                           , re_terms :: Text 
-                           , re_ngrams_id :: Int
-                           }
-  deriving (Show)
-
-instance FromRow Returning where
-  fromRow = Returning <$> (fromNgramsTypeId <$> field) <*> field <*> field
-
-getCgramsId :: Map NgramsType (Map Text Int) -> NgramsType -> Text -> Maybe Int
-getCgramsId mapId nt t = case Map.lookup nt mapId of
-  Nothing     -> Nothing
-  Just mapId' -> Map.lookup t mapId'
-
-
--- insertDb :: ListId -> Map NgramsType [NgramsElement] -> Cmd err [Result]
-listInsertDb :: Show a => ListId
-             -> (ListId -> a -> [NodeNgramsW])
-             -> a
-             -- -> Cmd err [Returning]
-             -> Cmd err (Map NgramsType (Map Text Int))
-listInsertDb l f ngs = Map.map Map.fromList
-                    <$> Map.fromListWith (<>) 
-                    <$> List.map (\(Returning t tx id) -> (fromJust t, [(tx, id)]))
-                    <$> List.filter (\(Returning t _ _) -> isJust t)
-                    <$> 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)
-                              -> [ toField node_id''
-                                 , toField $ listTypeId node_subtype
-                                 , toField $ ngrams_terms
-                                 , toField $ ngramsTypeId ngrams_type
-                                 , toField $ fromMaybe 0 ngrams_field
-                                 , toField $ fromMaybe 0 ngrams_tag
-                                 , toField $ fromMaybe 0 ngrams_class
-                                 , toField weight
-                                 ]
-                  ) $ sortUniq nns
-
-    query :: PGS.Query
-    query = [sql|
-          WITH input(node_id, node_subtype, ngrams_terms, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight) AS (?),
-          return(id, ngrams_type, ngrams_id) AS (
-            INSERT INTO node_ngrams (node_id, node_subtype, ngrams_id, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight)
-            SELECT i.node_id, i.node_subtype, ng.id, i.ngrams_type, i.ngrams_field, i.ngrams_tag, i.ngrams_class, i.weight FROM input as i
-            INNER JOIN ngrams as ng ON ng.terms = i.ngrams_terms
-            ON CONFLICT(node_id, node_subtype, ngrams_id)
-            DO UPDATE SET node_subtype = excluded.node_subtype, ngrams_type = excluded.ngrams_type, ngrams_field = excluded.ngrams_field, ngrams_tag = excluded.ngrams_tag, ngrams_class = excluded.ngrams_class, weight = excluded.weight
-            RETURNING id, ngrams_type, ngrams_id
-          )
-          SELECT return.ngrams_type, ng.terms, return.id FROM return
-          INNER JOIN ngrams ng ON return.ngrams_id = ng.id;
-  |]