[REFACT] HasDBid

src/Gargantext/Core.hs

@@ -18,6 +18,7 @@ import Data.Aeson
 import Data.Either(Either(Left))
 import Data.Swagger
 import Servant.API
+
 ------------------------------------------------------------------------
 -- | Language of a Text
 -- For simplicity, we suppose text has an homogenous language
@@ -42,9 +43,34 @@ instance FromJSON Lang
 instance ToSchema Lang
 instance FromHttpApiData Lang
   where
-    parseUrlPiece "EN" = pure EN
-    parseUrlPiece "FR" = pure FR
+    parseUrlPiece "EN"  = pure EN
+    parseUrlPiece "FR"  = pure FR
     parseUrlPiece "All" = pure All
-    parseUrlPiece _            = Left "Unexpected value of OrderBy"
+    parseUrlPiece _     = Left "Unexpected value of OrderBy"
 allLangs :: [Lang]
 allLangs = [minBound ..]
+
+class HasDBid a where
+  hasDBid  :: a   -> Int
+  fromDBid :: Int -> a
+
+instance HasDBid Lang where
+  hasDBid All = 0
+  hasDBid FR  = 1
+  hasDBid EN  = 2
+
+  fromDBid 0 = All
+  fromDBid 1 = FR
+  fromDBid 2 = EN
+  fromDBid _ = panic "HasDBid lang, not implemented"
+
+
+------------------------------------------------------------------------
+data PostTagAlgo = CoreNLP
+  deriving (Show, Read)
+
+instance HasDBid PostTagAlgo where
+  hasDBid CoreNLP = 1
+  fromDBid 1 = CoreNLP
+  fromDBid _ = panic "HasDBid posTagAlgo : Not implemented"
+

src/Gargantext/Core/Text/Terms.hs

@@ -63,7 +63,7 @@ data TermType lang
   = Mono      { _tt_lang :: !lang }
   | Multi     { _tt_lang :: !lang }
   | MonoMulti { _tt_lang :: !lang }
-  | Unsupervised { _tt_lang  :: !lang
+  | Unsupervised { _tt_lang       :: !lang
                  , _tt_windowSize :: !Int
                  , _tt_ngramsSize :: !Int
                  , _tt_model      :: !(Maybe (Tries Token ()))
@@ -140,6 +140,8 @@ terms (Unsupervised lang n s m) txt = termsUnsupervised (Unsupervised lang n s (
   where
     m' = maybe (newTries n txt) identity m
 -- terms (WithList  list) txt = pure . concat $ extractTermsWithList list txt
+
+
 ------------------------------------------------------------------------
 
 text2term :: Lang -> [Text] -> Terms

src/Gargantext/Core/Text/Terms/Multi.hs

@@ -28,12 +28,17 @@ import qualified Gargantext.Core.Text.Terms.Multi.Lang.Fr as Fr
 
 import Gargantext.Core.Text.Terms.Multi.RAKE (multiterms_rake)
 
+-------------------------------------------------------------------
+-- To be removed
 multiterms :: Lang -> Text -> IO [Terms]
-multiterms lang txt = concat
-                   <$> map (map tokenTag2terms)
+multiterms = multiterms' tokenTag2terms
+ 
+multiterms' :: (TokenTag -> a) -> Lang -> Text -> IO [a]
+multiterms' f lang txt = concat
+                   <$> map (map f)
                    <$> map (filter (\t -> _my_token_pos t == Just NP)) 
                    <$> tokenTags lang txt
-
+-------------------------------------------------------------------
 tokenTag2terms :: TokenTag -> Terms
 tokenTag2terms (TokenTag ws t _ _) =  Terms ws t
 

src/Gargantext/Database/Action/Delete.hs

@@ -24,7 +24,8 @@ import Servant
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Action.User (getUserId)
 import Gargantext.Database.Action.Share (delFolderTeam)
-import Gargantext.Database.Admin.Config (nodeTypeId)
+import Gargantext.Core
+import Gargantext.Database.Admin.Config
 import Gargantext.Database.Admin.Types.Hyperdata.File
 import Gargantext.Database.Admin.Types.Node -- (NodeType(..))
 import Gargantext.Database.Prelude (Cmd', HasConfig, HasConnectionPool)
@@ -44,13 +45,13 @@ deleteNode :: (HasConfig env, HasConnectionPool env, HasNodeError err)
 deleteNode u nodeId = do
   node' <- N.getNode nodeId
   case (view node_typename node') of
-    nt | nt == nodeTypeId NodeUser -> panic "Not allowed to delete NodeUser (yet)"
-    nt | nt == nodeTypeId NodeTeam -> do
+    nt | nt == hasDBid NodeUser -> panic "Not allowed to delete NodeUser (yet)"
+    nt | nt == hasDBid NodeTeam -> do
       uId   <- getUserId u
       if _node_userId node' == uId
         then N.deleteNode    nodeId
         else delFolderTeam u nodeId
-    nt | nt == nodeTypeId NodeFile -> do
+    nt | nt == hasDBid NodeFile -> do
       node <- getNodeWith nodeId (Proxy :: Proxy HyperdataFile)
       let (HyperdataFile { _hff_path = path }) = node ^. node_hyperdata
       GPU.removeFile $ unpack path

src/Gargantext/Database/Action/Flow.hs

@@ -258,8 +258,7 @@ insertMasterDocs c lang hs  =  do
   -- this will enable global database monitoring
 
   -- maps :: IO Map Ngrams (Map NgramsType (Map NodeId Int))
-  mapNgramsDocs <- mapNodeIdNgrams
-       <$> documentIdWithNgrams (extractNgramsT $ withLang lang documentsWithId) documentsWithId
+  mapNgramsDocs <- mapNodeIdNgrams <$> documentIdWithNgrams (extractNgramsT $ withLang lang documentsWithId) documentsWithId
 
   terms2id <- insertNgrams $ Map.keys mapNgramsDocs
   -- to be removed

src/Gargantext/Database/Action/Flow/Pairing.hs

@@ -24,6 +24,7 @@ import Data.Set (Set)
 import Gargantext.API.Ngrams.Tools
 import Gargantext.API.Ngrams.Types (NgramsTerm(..))
 import Gargantext.API.Prelude (GargNoServer)
+import Gargantext.Core
 import Gargantext.Core.Types (TableResult(..))
 import Gargantext.Core.Types.Main
 import Gargantext.Database
@@ -54,7 +55,7 @@ isPairedWith nId nt = runOpaQuery (selectQuery nt nId)
     selectQuery :: NodeType -> NodeId -> Query (Column PGInt4)
     selectQuery nt' nId' = proc () -> do
       (node, node_node) <- queryJoin -< ()
-      restrict -< (node^.node_typename)    .== (pgInt4 $ nodeTypeId nt')
+      restrict -< (node^.node_typename)    .== (pgInt4 $ hasDBid nt')
       restrict -< (node_node^.nn_node1_id) .== (toNullable $ pgNodeId nId')
       returnA  -<  node^.node_id
 

src/Gargantext/Database/Action/Metrics/NgramsByNode.hs

@@ -25,9 +25,9 @@ import Data.Tuple.Extra (first, second, swap)
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import Debug.Trace (trace)
+import Gargantext.Core
 import Gargantext.API.Ngrams.Types (NgramsTerm(..))
 import Gargantext.Data.HashMap.Strict.Utils as HM
-import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
 import Gargantext.Database.Prelude (Cmd, runPGSQuery)
 import Gargantext.Database.Schema.Ngrams (ngramsTypeId, NgramsType(..))
@@ -57,7 +57,8 @@ groupNodesByNgramsWith f m =
                        $ HM.toList m
 
 ------------------------------------------------------------------------
-getNodesByNgramsUser :: CorpusId
+getNodesByNgramsUser ::  HasDBid NodeType
+                     => CorpusId
                      -> NgramsType
                      -> Cmd err (HashMap NgramsTerm (Set NodeId))
 getNodesByNgramsUser cId nt =
@@ -65,13 +66,14 @@ getNodesByNgramsUser cId nt =
                     <$> selectNgramsByNodeUser cId nt
     where
 
-      selectNgramsByNodeUser :: CorpusId
+      selectNgramsByNodeUser :: HasDBid NodeType
+                             => CorpusId
                              -> NgramsType
                              -> Cmd err [(NodeId, Text)]
       selectNgramsByNodeUser cId' nt' =
         runPGSQuery queryNgramsByNodeUser
                     ( cId'
-                    , nodeTypeId NodeDocument
+                    , hasDBid NodeDocument
                     , ngramsTypeId nt'
            --         , 100 :: Int -- limit
            --         , 0   :: Int -- offset
@@ -84,7 +86,7 @@ getNodesByNgramsUser cId nt =
           JOIN nodes_nodes nn ON nn.node2_id   = nng.node2_id
           JOIN nodes  n       ON nn.node2_id   = n.id
           WHERE nn.node1_id = ?     -- CorpusId
-            AND n.typename  = ?     -- NodeTypeId
+            AND n.typename  = ?     -- hasDBid
             AND nng.ngrams_type = ? -- NgramsTypeId
             AND nn.category > 0
             GROUP BY nng.node2_id, ng.terms
@@ -94,7 +96,8 @@ getNodesByNgramsUser cId nt =
         |]
 ------------------------------------------------------------------------
 -- TODO add groups
-getOccByNgramsOnlyFast :: CorpusId
+getOccByNgramsOnlyFast :: HasDBid NodeType
+                       => CorpusId
                        -> NgramsType
                        -> [NgramsTerm]
                        -> Cmd err (HashMap NgramsTerm Int)
@@ -140,7 +143,8 @@ getOccByNgramsOnlyFast' cId lId nt tms = trace (show (cId, lId)) $
 
 
 -- just slower than getOccByNgramsOnlyFast
-getOccByNgramsOnlySlow :: NodeType
+getOccByNgramsOnlySlow :: HasDBid NodeType
+                       => NodeType
                        -> CorpusId
                        -> [ListId]
                        -> NgramsType
@@ -153,7 +157,8 @@ getOccByNgramsOnlySlow t cId ls nt ngs =
       getScore' NodeDocument = getNgramsByDocOnlyUser
       getScore' _            = getNodesByNgramsOnlyUser
 
-getOccByNgramsOnlySafe :: CorpusId
+getOccByNgramsOnlySafe :: HasDBid NodeType
+                       => CorpusId
                        -> [ListId]
                        -> NgramsType
                        -> [NgramsTerm]
@@ -169,7 +174,8 @@ getOccByNgramsOnlySafe cId ls nt ngs = do
   pure slow
 
 
-selectNgramsOccurrencesOnlyByNodeUser :: CorpusId
+selectNgramsOccurrencesOnlyByNodeUser :: HasDBid NodeType
+                                      => CorpusId
                                       -> NgramsType
                                       -> [NgramsTerm]
                                       -> Cmd err [(NgramsTerm, Int)]
@@ -178,7 +184,7 @@ selectNgramsOccurrencesOnlyByNodeUser cId nt tms =
   runPGSQuery queryNgramsOccurrencesOnlyByNodeUser
                 ( Values fields ((DPS.Only . unNgramsTerm) <$> tms)
                 , cId
-                , nodeTypeId NodeDocument
+                , hasDBid NodeDocument
                 , ngramsTypeId nt
                 )
     where
@@ -196,7 +202,7 @@ queryNgramsOccurrencesOnlyByNodeUser = [sql|
     JOIN nodes_nodes nn ON nn.node2_id   = nng.node2_id
     JOIN nodes  n       ON nn.node2_id   = n.id
     WHERE nn.node1_id     = ? -- CorpusId
-      AND n.typename      = ? -- NodeTypeId
+      AND n.typename      = ? -- hasDBid
       AND nng.ngrams_type = ? -- NgramsTypeId
       AND nn.category     > 0
       GROUP BY nng.node2_id, ng.terms
@@ -211,14 +217,15 @@ queryNgramsOccurrencesOnlyByNodeUser' = [sql|
     JOIN nodes_nodes nn ON nn.node2_id   = nng.node2_id
     JOIN nodes  n       ON nn.node2_id   = n.id
     WHERE nn.node1_id     = ? -- CorpusId
-      AND n.typename      = ? -- NodeTypeId
+      AND n.typename      = ? -- hasDBid
       AND nng.ngrams_type = ? -- NgramsTypeId
       AND nn.category     > 0
       GROUP BY nng.node2_id, ng.terms
   |]
 
 ------------------------------------------------------------------------
-getNodesByNgramsOnlyUser :: CorpusId
+getNodesByNgramsOnlyUser :: HasDBid NodeType
+                         => CorpusId
                          -> [ListId]
                          -> NgramsType
                          -> [NgramsTerm]
@@ -231,7 +238,8 @@ getNodesByNgramsOnlyUser cId ls nt ngs =
            (splitEvery 1000 ngs)
 
 
-getNgramsByNodeOnlyUser :: NodeId
+getNgramsByNodeOnlyUser :: HasDBid NodeType
+                        => NodeId
                         -> [ListId]
                         -> NgramsType
                         -> [NgramsTerm]
@@ -246,7 +254,8 @@ getNgramsByNodeOnlyUser cId ls nt ngs =
            (splitEvery 1000 ngs)
 
 ------------------------------------------------------------------------
-selectNgramsOnlyByNodeUser :: CorpusId
+selectNgramsOnlyByNodeUser :: HasDBid NodeType
+                           => CorpusId
                            -> [ListId]
                            -> NgramsType
                            -> [NgramsTerm]
@@ -258,7 +267,7 @@ selectNgramsOnlyByNodeUser cId ls nt tms =
                 , Values [QualifiedIdentifier Nothing "int4"] 
                          (DPS.Only <$> (map (\(NodeId n) -> n) ls))
                 , cId
-                , nodeTypeId NodeDocument
+                , hasDBid NodeDocument
                 , ngramsTypeId nt
                 )
     where
@@ -275,14 +284,15 @@ queryNgramsOnlyByNodeUser = [sql|
     JOIN nodes_nodes nn ON nn.node2_id   = nng.node2_id
     JOIN nodes  n       ON nn.node2_id   = n.id
     WHERE nn.node1_id     = ? -- CorpusId
-      AND n.typename      = ? -- NodeTypeId
+      AND n.typename      = ? -- hasDBid
       AND nng.ngrams_type = ? -- NgramsTypeId
       AND nn.category     > 0
       GROUP BY ng.terms, nng.node2_id
   |]
 
 
-selectNgramsOnlyByNodeUser' :: CorpusId
+selectNgramsOnlyByNodeUser' :: HasDBid NodeType
+                            => CorpusId
                             -> [ListId]
                             -> NgramsType
                             -> [Text]
@@ -293,7 +303,7 @@ selectNgramsOnlyByNodeUser' cId ls nt tms =
                 , Values [QualifiedIdentifier Nothing "int4"]
                          (DPS.Only <$> (map (\(NodeId n) -> n) ls))
                 , cId
-                , nodeTypeId NodeDocument
+                , hasDBid NodeDocument
                 , ngramsTypeId nt
                 )
     where
@@ -358,14 +368,16 @@ queryNgramsOnlyByDocUser = [sql|
 
 ------------------------------------------------------------------------
 -- | TODO filter by language, database, any social field
-getNodesByNgramsMaster :: UserCorpusId -> MasterCorpusId -> Cmd err (HashMap Text (Set NodeId))
+getNodesByNgramsMaster :: HasDBid NodeType
+                       =>  UserCorpusId -> MasterCorpusId -> Cmd err (HashMap Text (Set NodeId))
 getNodesByNgramsMaster ucId mcId = unionsWith (<>)
                                  . map (HM.fromListWith (<>) . map (\(n,t) -> (t, Set.singleton n)))
                                  -- . takeWhile (not . List.null)
                                  -- . takeWhile (\l -> List.length l > 3)
                                 <$> mapM (selectNgramsByNodeMaster 1000 ucId mcId) [0,500..10000]
 
-selectNgramsByNodeMaster :: Int
+selectNgramsByNodeMaster :: HasDBid NodeType
+                         => Int
                          -> UserCorpusId
                          -> MasterCorpusId
                          -> Int
@@ -374,13 +386,13 @@ selectNgramsByNodeMaster n ucId mcId p = runPGSQuery
                                queryNgramsByNodeMaster'
                                  ( ucId
                                  , ngramsTypeId NgramsTerms
-                                 , nodeTypeId   NodeDocument
+                                 , hasDBid   NodeDocument
                                  , p
-                                 , nodeTypeId   NodeDocument
+                                 , hasDBid   NodeDocument
                                  , p
                                  , n
                                  , mcId
-                                 , nodeTypeId   NodeDocument
+                                 , hasDBid   NodeDocument
                                  , ngramsTypeId NgramsTerms
                                  )
 
@@ -394,7 +406,7 @@ queryNgramsByNodeMaster' = [sql|
     JOIN node_node_ngrams nng ON nng.node2_id   = n.id
     JOIN ngrams       ng  ON nng.ngrams_id = ng.id
     WHERE nn.node1_id     = ?   -- UserCorpusId
-      -- AND n.typename   = ?  -- NodeTypeId
+      -- AND n.typename   = ?  -- hasDBid
       AND nng.ngrams_type = ? -- NgramsTypeId
       AND nn.category > 0
       AND node_pos(n.id,?) >= ?
@@ -409,8 +421,8 @@ queryNgramsByNodeMaster' = [sql|
     JOIN node_node_ngrams nng  ON n.id  = nng.node2_id
     JOIN ngrams       ng   ON ng.id = nng.ngrams_id
 
-    WHERE n.parent_id  = ?     -- Master Corpus NodeTypeId
-      AND n.typename   = ?     -- NodeTypeId
+    WHERE n.parent_id  = ?     -- Master Corpus hasDBid
+      AND n.typename   = ?     -- hasDBid
       AND nng.ngrams_type = ? -- NgramsTypeId
     GROUP BY n.id, ng.terms
     )

src/Gargantext/Database/Action/Metrics/TFICF.hs

@@ -19,6 +19,7 @@ module Gargantext.Database.Action.Metrics.TFICF
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HM
 import Data.Maybe (fromMaybe)
+import Gargantext.Core
 import Gargantext.Core.Text.Metrics.TFICF
 import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsUser, getOccByNgramsOnlyFast)
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
@@ -29,7 +30,8 @@ import Gargantext.API.Ngrams.Types
 import Gargantext.Prelude
 import qualified Data.Set as Set
 
-getTficf :: UserCorpusId
+getTficf :: HasDBid NodeType 
+         => UserCorpusId
          -> MasterCorpusId
          -> NgramsType
          -> Cmd err (HashMap NgramsTerm Double)

src/Gargantext/Database/Action/Search.hs

@@ -22,8 +22,9 @@ import Data.Text (Text, words, unpack, intercalate)
 import Data.Time (UTCTime)
 import Database.PostgreSQL.Simple (Query)
 import Database.PostgreSQL.Simple.ToField
+import Gargantext.Core
 import Gargantext.Core.Types
-import Gargantext.Database.Admin.Config (nodeTypeId)
+import Gargantext.Database.Admin.Config
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..), HyperdataContact(..))
 import Gargantext.Database.Prelude (Cmd, runPGSQuery, runOpaQuery, runCountOpaQuery)
 import Gargantext.Database.Query.Facet
@@ -49,7 +50,7 @@ searchDocInDatabase p t = runOpaQuery (queryDocInDatabase p t)
     queryDocInDatabase _ q = proc () -> do
         row <- queryNodeSearchTable -< ()
         restrict -< (_ns_search row)    @@ (pgTSQuery (unpack q))
-        restrict -< (_ns_typename row) .== (pgInt4 $ nodeTypeId NodeDocument)
+        restrict -< (_ns_typename row) .== (pgInt4 $ hasDBid NodeDocument)
         returnA  -< (_ns_id row, _ns_hyperdata row)
 
 ------------------------------------------------------------------------
@@ -87,7 +88,7 @@ queryInCorpus cId t q = proc () -> do
                  then (nn^.nn_category) .== (toNullable $ pgInt4 0)
                  else (nn^.nn_category) .>= (toNullable $ pgInt4 1)
   restrict -< (n ^. ns_search)           @@ (pgTSQuery (unpack q))
-  restrict -< (n ^. ns_typename )       .== (pgInt4 $ nodeTypeId NodeDocument)
+  restrict -< (n ^. ns_typename )       .== (pgInt4 $ hasDBid NodeDocument)
   returnA  -< FacetDoc (n^.ns_id        )
                        (n^.ns_date      )
                        (n^.ns_name      )
@@ -132,10 +133,10 @@ selectContactViaDoc
 selectContactViaDoc cId aId q = proc () -> do
   (doc, (corpus_doc, (_contact_doc, (annuaire_contact, contact)))) <- queryContactViaDoc -< ()
   restrict -< (doc^.ns_search)           @@ (pgTSQuery  $ unpack q  )
-  restrict -< (doc^.ns_typename)        .== (pgInt4 $ nodeTypeId NodeDocument)
+  restrict -< (doc^.ns_typename)        .== (pgInt4 $ hasDBid NodeDocument)
   restrict -< (corpus_doc^.nn_node1_id)  .== (toNullable $ pgNodeId cId)
   restrict -< (annuaire_contact^.nn_node1_id) .== (toNullable $ pgNodeId aId)
-  restrict -< (contact^.node_typename)        .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
+  restrict -< (contact^.node_typename)        .== (toNullable $ pgInt4 $ hasDBid NodeContact)
   returnA  -< ( contact^.node_id
               , contact^.node_date
               , contact^.node_hyperdata
@@ -265,6 +266,6 @@ textSearch :: TSQuery -> ParentId
            -> Cmd err [(Int,Value,Value,Value, Value, Maybe Int)]
 textSearch q p l o ord = runPGSQuery textSearchQuery (q,p,p,typeId,ord,o,l)
   where
-    typeId = nodeTypeId NodeDocument
+    typeId = hasDBid NodeDocument
 
 

src/Gargantext/Database/Admin/Config.hs

@@ -14,6 +14,8 @@ TODO: configure nodes table in Haskell (Config typenames etc.)
 -}
 
 
+{-# OPTIONS_GHC -fno-warn-orphans        #-}
+
 module Gargantext.Database.Admin.Config
     where
 
@@ -22,6 +24,7 @@ import Data.List        (lookup)
 import Data.Maybe       (fromMaybe)
 import Data.Text        (Text,pack)
 import Data.Tuple.Extra (swap)
+import Gargantext.Core (HasDBid(..))
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude
@@ -36,6 +39,11 @@ userMaster = "gargantua"
 userArbitrary :: Text
 userArbitrary = "user1"
 
+instance HasDBid NodeType where
+  hasDBid  = nodeTypeId
+  fromDBid = fromNodeTypeId
+
+
 nodeTypeId :: NodeType -> NodeTypeId
 nodeTypeId n =
   case n of
@@ -88,10 +96,10 @@ nodeTypeId n =
 --  NodeFavorites    -> 15
 
 hasNodeType :: forall a. Node a -> NodeType -> Bool
-hasNodeType n nt = (view node_typename n) == (nodeTypeId nt)
+hasNodeType n nt = (view node_typename n) == (hasDBid nt)
 
 isInNodeTypes :: forall a. Node a -> [NodeType] -> Bool
-isInNodeTypes n ts = elem (view node_typename n) (map nodeTypeId ts)
+isInNodeTypes n ts = elem (view node_typename n) (map hasDBid ts)
 
 -- | Nodes are typed in the database according to a specific ID
 --
@@ -99,7 +107,7 @@ nodeTypeInv :: [(NodeTypeId, NodeType)]
 nodeTypeInv = map swap nodeTypes
 
 nodeTypes :: [(NodeType, NodeTypeId)]
-nodeTypes = [ (n, nodeTypeId n) | n <- allNodeTypes ]
+nodeTypes = [ (n, hasDBid n) | n <- allNodeTypes ]
 
 fromNodeTypeId :: NodeTypeId -> NodeType
 fromNodeTypeId tId = fromMaybe (panic $ pack $ "Type Id " <> show tId <> " does not exist")

src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs

@@ -17,16 +17,15 @@ module Gargantext.Database.Admin.Trigger.NodeNodeNgrams
   where
 
 import Database.PostgreSQL.Simple.SqlQQ (sql)
-import qualified Database.PostgreSQL.Simple as DPS
-
+import Gargantext.Core
 import Gargantext.Core.Types.Main (listTypeId, ListType(CandidateTerm))
-import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
 import Gargantext.Database.Prelude (Cmd, execPGSQuery)
 import Gargantext.Prelude
+import qualified Database.PostgreSQL.Simple as DPS
 
-triggerCountInsert :: Cmd err Int64
-triggerCountInsert = execPGSQuery query (nodeTypeId NodeDocument, nodeTypeId NodeList)
+triggerCountInsert :: HasDBid NodeType => Cmd err Int64
+triggerCountInsert = execPGSQuery query (hasDBid NodeDocument, hasDBid NodeList)
   where
     query :: DPS.Query
     query = [sql|
@@ -61,10 +60,10 @@ triggerCountInsert = execPGSQuery query (nodeTypeId NodeDocument, nodeTypeId Nod
           EXECUTE PROCEDURE set_ngrams_global_count();
    |]
 
-triggerCountInsert2 :: Cmd err Int64
-triggerCountInsert2 = execPGSQuery query ( nodeTypeId NodeCorpus
-                                         , nodeTypeId NodeDocument
-                                         , nodeTypeId NodeList
+triggerCountInsert2 :: HasDBid NodeType => Cmd err Int64
+triggerCountInsert2 = execPGSQuery query ( hasDBid NodeCorpus
+                                         , hasDBid NodeDocument
+                                         , hasDBid NodeList
                                          )
   where
     query :: DPS.Query
@@ -105,10 +104,10 @@ triggerCountInsert2 = execPGSQuery query ( nodeTypeId NodeCorpus
    |]
 
 -- TODO add the groups
-triggerCoocInsert :: Cmd err Int64
-triggerCoocInsert = execPGSQuery query ( nodeTypeId NodeCorpus
-                                       , nodeTypeId NodeDocument
-                                       , nodeTypeId NodeList
+triggerCoocInsert :: HasDBid NodeType => Cmd err Int64
+triggerCoocInsert = execPGSQuery query ( hasDBid NodeCorpus
+                                       , hasDBid NodeDocument
+                                       , hasDBid NodeList
                                        , listTypeId CandidateTerm
                                        , listTypeId CandidateTerm
                                        )

src/Gargantext/Database/Admin/Trigger/Nodes.hs

@@ -18,18 +18,17 @@ module Gargantext.Database.Admin.Trigger.Nodes
 
 import Data.Text (Text)
 import Database.PostgreSQL.Simple.SqlQQ (sql)
-import qualified Database.PostgreSQL.Simple as DPS
-
-import Gargantext.Database.Admin.Config (nodeTypeId)
+import Gargantext.Core (HasDBid(..))
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
 import Gargantext.Database.Prelude (Cmd, execPGSQuery)
 import Gargantext.Prelude
+import qualified Database.PostgreSQL.Simple as DPS
 
 
-triggerSearchUpdate :: Cmd err Int64
-triggerSearchUpdate = execPGSQuery query ( nodeTypeId NodeDocument
-                                         , nodeTypeId NodeDocument
-                                         , nodeTypeId NodeContact
+triggerSearchUpdate :: HasDBid NodeType => Cmd err Int64
+triggerSearchUpdate = execPGSQuery query ( hasDBid NodeDocument
+                                         , hasDBid NodeDocument
+                                         , hasDBid NodeContact
                                          )
   where
     query :: DPS.Query
@@ -70,13 +69,13 @@ triggerSearchUpdate = execPGSQuery query ( nodeTypeId NodeDocument
 
 type Secret = Text
 
-triggerUpdateHash :: Secret -> Cmd err Int64
-triggerUpdateHash secret = execPGSQuery query ( nodeTypeId NodeDocument
-                                              , nodeTypeId NodeContact
+triggerUpdateHash :: HasDBid NodeType => Secret -> Cmd err Int64
+triggerUpdateHash secret = execPGSQuery query ( hasDBid NodeDocument
+                                              , hasDBid NodeContact
                                               , secret
                                               , secret
-                                              , nodeTypeId NodeDocument
-                                              , nodeTypeId NodeContact
+                                              , hasDBid NodeDocument
+                                              , hasDBid NodeContact
                                               , secret
                                               , secret
                                               )

src/Gargantext/Database/Admin/Trigger/NodesNodes.hs

@@ -18,7 +18,8 @@ module Gargantext.Database.Admin.Trigger.NodesNodes
 
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 -- import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
-import Gargantext.Database.Admin.Config (nodeTypeId)
+import Gargantext.Core
+import Gargantext.Database.Admin.Config
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
 import Gargantext.Core.Types.Main (listTypeId, ListType(CandidateTerm))
 import Gargantext.Database.Prelude (Cmd, execPGSQuery)
@@ -28,7 +29,7 @@ import qualified Database.PostgreSQL.Simple as DPS
 type MasterListId = ListId
 
 triggerDeleteCount :: MasterListId -> Cmd err Int64
-triggerDeleteCount lId = execPGSQuery query (lId, nodeTypeId NodeList)
+triggerDeleteCount lId = execPGSQuery query (lId, hasDBid NodeList)
   where
     query :: DPS.Query
     query = [sql|

src/Gargantext/Database/Admin/Types/Node.hs

@@ -99,11 +99,11 @@ instance (Typeable hyperdata, ToSchema hyperdata) =>
 
 instance (Arbitrary nodeId
          ,Arbitrary hashId
-         ,Arbitrary nodeTypeId
+         ,Arbitrary hasDBid
          ,Arbitrary userId
          ,Arbitrary nodeParentId
          , Arbitrary hyperdata
-         ) => Arbitrary (NodePoly nodeId hashId nodeTypeId userId nodeParentId
+         ) => Arbitrary (NodePoly nodeId hashId hasDBid userId nodeParentId
                                   NodeName UTCTime hyperdata) where
     --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
     arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
@@ -112,10 +112,10 @@ instance (Arbitrary nodeId
 
 instance (Arbitrary hyperdata
          ,Arbitrary nodeId
-         ,Arbitrary nodeTypeId
+         ,Arbitrary hasDBid
          ,Arbitrary userId
          ,Arbitrary nodeParentId
-         ) => Arbitrary (NodePolySearch nodeId nodeTypeId userId nodeParentId
+         ) => Arbitrary (NodePolySearch nodeId hasDBid userId nodeParentId
                                   NodeName UTCTime hyperdata (Maybe TSVector)) where
     --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
     arbitrary = NodeSearch <$> arbitrary <*> arbitrary <*> arbitrary

src/Gargantext/Database/Query/Facet.hs

@@ -52,9 +52,9 @@ import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 import qualified Opaleye.Internal.Unpackspec()
 
+import Gargantext.Core
 import Gargantext.Core.Types
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
-import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Query.Filter
 import Gargantext.Database.Query.Join (leftJoin5)
@@ -232,13 +232,13 @@ instance Arbitrary OrderBy
 -- TODO-SECURITY check
 
 --{-
-runViewAuthorsDoc :: ContactId -> IsTrash -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err [FacetDoc]
+runViewAuthorsDoc :: HasDBid NodeType => ContactId -> IsTrash -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err [FacetDoc]
 runViewAuthorsDoc cId t o l order = runOpaQuery $ filterWith o l order $ viewAuthorsDoc cId t ntId
   where
     ntId = NodeDocument
 
 -- TODO add delete ?
-viewAuthorsDoc :: ContactId -> IsTrash -> NodeType -> Query FacetDocRead
+viewAuthorsDoc :: HasDBid NodeType => ContactId -> IsTrash -> NodeType -> Query FacetDocRead
 viewAuthorsDoc cId _ nt = proc () -> do
   (doc,(_,(_,(_,contact')))) <- queryAuthorsDoc      -< ()
 
@@ -248,7 +248,7 @@ viewAuthorsDoc cId _ nt = proc () -> do
   -}
 
   restrict -< _node_id   contact'  .== (toNullable $ pgNodeId cId)
-  restrict -< _node_typename doc   .== (pgInt4 $ nodeTypeId nt)
+  restrict -< _node_typename doc   .== (pgInt4 $ hasDBid nt)
 
   returnA  -< FacetDoc (_node_id        doc)
                        (_node_date      doc)
@@ -279,7 +279,8 @@ queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNodeNgramsTable queryNgramsT
 ------------------------------------------------------------------------
 
 -- TODO-SECURITY check
-runViewDocuments :: CorpusId
+runViewDocuments :: HasDBid NodeType
+                 => CorpusId
                  -> IsTrash
                  -> Maybe Offset
                  -> Maybe Limit
@@ -289,14 +290,14 @@ runViewDocuments :: CorpusId
 runViewDocuments cId t o l order query = do
     runOpaQuery $ filterWith o l order sqlQuery
   where
-    ntId = nodeTypeId NodeDocument
+    ntId = hasDBid NodeDocument
     sqlQuery = viewDocuments cId t ntId query
 
-runCountDocuments :: CorpusId -> IsTrash -> Maybe Text -> Cmd err Int
+runCountDocuments :: HasDBid NodeType => CorpusId -> IsTrash -> Maybe Text -> Cmd err Int
 runCountDocuments cId t mQuery = do
   runCountOpaQuery sqlQuery
   where
-    sqlQuery = viewDocuments cId t (nodeTypeId NodeDocument) mQuery
+    sqlQuery = viewDocuments cId t (hasDBid NodeDocument) mQuery
 
 
 viewDocuments :: CorpusId

src/Gargantext/Database/Query/Table/NgramsPostag.hs

@@ -25,6 +25,8 @@ import Gargantext.Prelude
 import qualified Database.PostgreSQL.Simple as PGS
 
 
+
+
 type NgramsPostagInsert = ( Int
                           , Int
                           , Text
@@ -34,6 +36,7 @@ type NgramsPostagInsert = ( Int
                           , Int
                           )
 
+
 insertNgramsPostag :: [NgramsPostagInsert] -> Cmd err [NgramIds]
 insertNgramsPostag ns = runPGSQuery queryInsertNgramsPostag (PGS.Only $ Values fields ns)
   where

src/Gargantext/Database/Query/Table/Node.hs

@@ -32,8 +32,8 @@ import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Opaleye hiding (FromField)
 import Prelude hiding (null, id, map, sum)
 
+import Gargantext.Core
 import Gargantext.Core.Types
-import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Hyperdata.Default
 import Gargantext.Database.Prelude
@@ -73,7 +73,7 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
       row@(Node _ _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
       restrict -< parentId' .== (pgNodeId parentId)
 
-      let typeId' = maybe 0 nodeTypeId maybeNodeType
+      let typeId' = maybe 0 hasDBid maybeNodeType
 
       restrict -< if typeId' > 0
                      then typeId   .== (pgInt4 (typeId' :: Int))
@@ -119,7 +119,7 @@ getClosestParentIdByType nId nType = do
   result <- runPGSQuery query (nId, 0 :: Int)
   case result of
     [DPS.Only parentId, DPS.Only pTypename] -> do
-      if nodeTypeId nType == pTypename then
+      if hasDBid nType == pTypename then
         pure $ Just $ NodeId parentId
       else
         getClosestParentIdByType (NodeId parentId) nType
@@ -164,7 +164,7 @@ getNodesWithType nt _ = runOpaQuery $ selectNodesWithType nt
     selectNodesWithType :: NodeType -> Query NodeRead
     selectNodesWithType nt' = proc () -> do
         row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
-        restrict -< tn .== (pgInt4 $ nodeTypeId nt')
+        restrict -< tn .== (pgInt4 $ hasDBid nt')
         returnA -< row
 
 getNodesIdWithType :: HasNodeError err => NodeType -> Cmd err [NodeId]
@@ -175,7 +175,7 @@ getNodesIdWithType nt = do
 selectNodesIdWithType :: NodeType -> Query (Column PGInt4)
 selectNodesIdWithType nt = proc () -> do
     row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
-    restrict -< tn .== (pgInt4 $ nodeTypeId nt)
+    restrict -< tn .== (pgInt4 $ hasDBid nt)
     returnA -< _node_id row
 
 ------------------------------------------------------------------------
@@ -228,7 +228,7 @@ node nodeType name hyperData parentId userId =
        Nothing
        (pgJSONB $ cs $ encode hyperData)
     where
-      typeId = nodeTypeId nodeType
+      typeId = hasDBid nodeType
 
                   -------------------------------
 insertNodes :: [NodeWrite] -> Cmd err Int64
@@ -242,7 +242,7 @@ insertNodes' ns = mkCmd $ \conn -> runInsert_ conn
     ns' :: [NodeWrite]
     ns' = map (\(Node i t u p n d h)
                 -> Node (pgNodeId          <$> i)
-                        (pgInt4 $ nodeTypeId   t)
+                        (pgInt4 $ hasDBid      t)
                         (pgInt4                u)
                         (pgNodeId          <$> p)
                         (pgStrictText          n)
@@ -266,7 +266,7 @@ insertNodesWithParentR pid ns = insertNodesR (set node_parentId (pgNodeId <$> pi
 -- needs a Temporary type between Node' and NodeWriteT
 
 node2table :: UserId -> Maybe ParentId -> Node' -> NodeWrite
-node2table uid pid (Node' nt txt v []) = Node Nothing Nothing (pgInt4 $ nodeTypeId nt) (pgInt4 uid) (fmap pgNodeId pid) (pgStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v)
+node2table uid pid (Node' nt txt v []) = Node Nothing Nothing (pgInt4 $ hasDBid nt) (pgInt4 uid) (fmap pgNodeId pid) (pgStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v)
 node2table _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet"
 
 

src/Gargantext/Database/Query/Table/Node/Children.hs

@@ -18,8 +18,8 @@ module Gargantext.Database.Query.Table.Node.Children
 
 import Control.Arrow (returnA)
 import Data.Proxy
+import Gargantext.Core
 import Gargantext.Core.Types
-import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument, HyperdataContact)
 import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Filter
@@ -30,23 +30,23 @@ import Protolude
 
 
 -- TODO getAllTableDocuments
-getAllDocuments :: ParentId -> Cmd err (TableResult (Node HyperdataDocument))
+getAllDocuments :: HasDBid NodeType => ParentId -> Cmd err (TableResult (Node HyperdataDocument))
 getAllDocuments pId = getAllChildren pId (Proxy :: Proxy HyperdataDocument)
                                          (Just NodeDocument)
 
 -- TODO getAllTableContacts
-getAllContacts :: ParentId -> Cmd err (TableResult (Node HyperdataContact))
+getAllContacts :: HasDBid NodeType => ParentId -> Cmd err (TableResult (Node HyperdataContact))
 getAllContacts pId = getAllChildren pId (Proxy :: Proxy HyperdataContact)
                                         (Just NodeContact)
 
-getAllChildren :: JSONB a
+getAllChildren :: (JSONB a, HasDBid NodeType)
                => ParentId
                -> proxy a
                -> Maybe NodeType
                -> Cmd err (NodeTableResult a)
 getAllChildren pId p maybeNodeType = getChildren pId p maybeNodeType Nothing Nothing
 
-getChildren :: JSONB a
+getChildren :: (JSONB a, HasDBid NodeType)
             => ParentId
             -> proxy a
             -> Maybe NodeType
@@ -66,14 +66,15 @@ getChildren pId _ maybeNodeType maybeOffset maybeLimit = do
   where
     query = selectChildren pId maybeNodeType
 
-selectChildren :: ParentId
+selectChildren :: HasDBid NodeType
+               => ParentId
                -> Maybe NodeType
                -> Query NodeRead
 selectChildren parentId maybeNodeType = proc () -> do
     row@(Node nId _ typeName _ parent_id _ _ _) <- queryNodeTable -< ()
     (NodeNode n1id n2id _ _) <- queryNodeNodeTable -< ()
 
-    let nodeType = maybe 0 nodeTypeId maybeNodeType
+    let nodeType = maybe 0 hasDBid maybeNodeType
     restrict -< typeName  .== pgInt4 nodeType
 
     restrict -< (.||) (parent_id .== (pgNodeId parentId))

src/Gargantext/Database/Query/Table/Node/Document/Insert.hs

@@ -69,7 +69,7 @@ import Database.PostgreSQL.Simple.SqlQQ
 import Database.PostgreSQL.Simple.ToField (toField, Action{-, ToField-})
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import GHC.Generics (Generic)
-import Gargantext.Database.Admin.Config (nodeTypeId)
+import Gargantext.Core (HasDBid(hasDBid))
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (Cmd, runPGSQuery{-, formatPGSQuery-})
@@ -91,20 +91,20 @@ import Database.PostgreSQL.Simple (formatQuery)
 -- ParentId : folder ID which is parent of the inserted documents
 -- Administrator of the database has to create a uniq index as following SQL command:
 -- `create unique index on nodes (typename, parent_id, (hyperdata ->> 'uniqId'));`
-insertDb :: InsertDb a => UserId -> ParentId -> [a] -> Cmd err [ReturnId]
+insertDb :: (InsertDb a, HasDBid NodeType) => UserId -> ParentId -> [a] -> Cmd err [ReturnId]
 insertDb u p = runPGSQuery queryInsert . Only . Values fields . map (insertDb' u p)
       where
         fields    = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
 
 class InsertDb a
   where
-    insertDb' :: UserId -> ParentId -> a -> [Action]
+    insertDb' :: HasDBid NodeType => UserId -> ParentId -> a -> [Action]
 
 
 instance InsertDb HyperdataDocument
   where
     insertDb' u p h = [ toField ("" :: Text)
-                      , toField $ nodeTypeId NodeDocument
+                      , toField $ hasDBid NodeDocument
                       , toField u
                       , toField p
                       , toField $ maybe "No Title" (DT.take 255)  (_hd_title h)
@@ -115,7 +115,7 @@ instance InsertDb HyperdataDocument
 instance InsertDb HyperdataContact
   where
     insertDb' u p h = [ toField ("" :: Text)
-                      , toField $ nodeTypeId NodeContact
+                      , toField $ hasDBid NodeContact
                       , toField u
                       , toField p
                       , toField $ maybe "Contact" (DT.take 255) (Just "Name") -- (_hc_name h)
@@ -217,13 +217,13 @@ secret :: Text
 secret = "Database secret to change"
 
 
-instance (AddUniqId a, ToJSON a) => AddUniqId (Node a)
+instance (AddUniqId a, ToJSON a, HasDBid NodeType) => AddUniqId (Node a)
   where
     addUniqId (Node nid _ t u p n d h) = Node nid hashId t u p n d h
                               where
                                 hashId = Just $ "\\x" <> (hash $ DT.concat params)
                                 params = [ secret
-                                         , cs $ show $ nodeTypeId NodeDocument
+                                         , cs $ show $ hasDBid NodeDocument
                                          , n
                                          , cs $ show p
                                          , cs $ encode h
@@ -235,7 +235,7 @@ instance (AddUniqId a, ToJSON a) => AddUniqId (Node a)
                               where
                                 hashId = "\\x" <> (hash $ DT.concat params)
                                 params = [ secret
-                                         , cs $ show $ nodeTypeId NodeDocument
+                                         , cs $ show $ hasDBid NodeDocument
                                          , n
                                          , cs $ show p
                                          , cs $ encode h
@@ -272,10 +272,10 @@ maybeText = maybe (DT.pack "") identity
 class ToNode a
   where
     -- TODO Maybe NodeId
-    toNode :: UserId -> ParentId -> a -> Node a
+    toNode :: HasDBid NodeType => UserId -> ParentId -> a -> Node a
 
 instance ToNode HyperdataDocument where
-  toNode u p h = Node 0 Nothing (nodeTypeId NodeDocument) u (Just p) n date h
+  toNode u p h = Node 0 Nothing (hasDBid NodeDocument) u (Just p) n date h
     where
       n    = maybe "No Title" (DT.take 255) (_hd_title h)
       date  = jour y m d
@@ -285,7 +285,7 @@ instance ToNode HyperdataDocument where
 
 -- TODO better Node
 instance ToNode HyperdataContact where
-  toNode u p h = Node 0 Nothing (nodeTypeId NodeContact) u (Just p) "Contact" date h
+  toNode u p h = Node 0 Nothing (hasDBid NodeContact) u (Just p) "Contact" date h
     where
       date  = jour 2020 01 01
 

src/Gargantext/Database/Query/Table/Node/Select.hs

@@ -18,21 +18,21 @@ import Control.Arrow (returnA)
 import Opaleye
 import Protolude
 
+import Gargantext.Core
 import Gargantext.Core.Types
 import Gargantext.Core.Types.Individu (Username)
-import Gargantext.Database.Admin.Config
 import Gargantext.Database.Prelude
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.User
 import Gargantext.Database.Query.Table.User
 
-selectNodesWithUsername :: NodeType -> Username -> Cmd err [NodeId]
+selectNodesWithUsername :: HasDBid NodeType => NodeType -> Username -> Cmd err [NodeId]
 selectNodesWithUsername nt u = runOpaQuery (q u)
   where
     q u' = proc () -> do
       (n,usrs) <- join' -< ()
       restrict -< user_username usrs .== (toNullable $ pgStrictText u')
-      restrict -< _node_typename n .== (pgInt4 $ nodeTypeId nt)
+      restrict -< _node_typename n .== (pgInt4 $ hasDBid nt)
       returnA  -< _node_id n
 
     join' :: Query (NodeRead, UserReadNull)

src/Gargantext/Database/Query/Table/NodeNode.hs

@@ -43,9 +43,9 @@ import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
 import qualified Opaleye as O
 import Opaleye
 
+import Gargantext.Core
 import Gargantext.Core.Types
 import Gargantext.Database.Schema.NodeNode
-import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Prelude
 import Gargantext.Database.Schema.Node
@@ -85,7 +85,7 @@ getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
         row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
         (NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< ()
 
-        let nodeType = maybe 0 nodeTypeId maybeNodeType
+        let nodeType = maybe 0 hasDBid maybeNodeType
         restrict -< typeName  .== pgInt4 nodeType
 
         restrict -< (.||) (parent_id .== (pgNodeId parentId))
@@ -145,46 +145,46 @@ nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
                   |]
 
 ------------------------------------------------------------------------
-selectCountDocs :: CorpusId -> Cmd err Int
+selectCountDocs :: HasDBid NodeType => CorpusId -> Cmd err Int
 selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
   where
     queryCountDocs cId' = proc () -> do
       (n, nn) <- joinInCorpus -< ()
       restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId')
       restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
-      restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
+      restrict -< n^.node_typename .== (pgInt4 $ hasDBid NodeDocument)
       returnA -< n
 
 
 
 
 -- | TODO use UTCTime fast
-selectDocsDates :: CorpusId -> Cmd err [Text]
+selectDocsDates :: HasDBid NodeType => CorpusId -> Cmd err [Text]
 selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
                    <$> catMaybes
                    <$> map (view hd_publication_date)
                    <$> selectDocs cId
 
-selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
+selectDocs :: HasDBid NodeType => CorpusId -> Cmd err [HyperdataDocument]
 selectDocs cId = runOpaQuery (queryDocs cId)
 
-queryDocs :: CorpusId -> O.Query (Column PGJsonb)
+queryDocs :: HasDBid NodeType => CorpusId -> O.Query (Column PGJsonb)
 queryDocs cId = proc () -> do
   (n, nn) <- joinInCorpus -< ()
   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
   restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
-  restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
+  restrict -< n^.node_typename .== (pgInt4 $ hasDBid NodeDocument)
   returnA -< view (node_hyperdata) n
 
-selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument]
+selectDocNodes :: HasDBid NodeType =>CorpusId -> Cmd err [Node HyperdataDocument]
 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 
-queryDocNodes :: CorpusId -> O.Query NodeRead
+queryDocNodes :: HasDBid NodeType =>CorpusId -> O.Query NodeRead
 queryDocNodes cId = proc () -> do
   (n, nn) <- joinInCorpus -< ()
   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
   restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
-  restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
+  restrict -< n^.node_typename .== (pgInt4 $ hasDBid NodeDocument)
   returnA -<  n
 
 joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
@@ -201,13 +201,13 @@ joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond
 
 
 ------------------------------------------------------------------------
-selectPublicNodes :: (Hyperdata a, QueryRunnerColumnDefault PGJsonb a)
+selectPublicNodes :: HasDBid NodeType => (Hyperdata a, QueryRunnerColumnDefault PGJsonb a)
                   => Cmd err [(Node a, Maybe Int)]
 selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
 
-queryWithType :: NodeType -> O.Query (NodeRead, Column (Nullable PGInt4))
+queryWithType :: HasDBid NodeType =>NodeType -> O.Query (NodeRead, Column (Nullable PGInt4))
 queryWithType nt = proc () -> do
   (n, nn) <- joinOn1 -< ()
-  restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId nt)
+  restrict -< n^.node_typename .== (pgInt4 $ hasDBid nt)
   returnA  -<  (n, nn^.nn_node2_id)
 

src/Gargantext/Database/Query/Tree.hs

@@ -46,9 +46,9 @@ import Database.PostgreSQL.Simple
 import Database.PostgreSQL.Simple.SqlQQ
 
 import Gargantext.Prelude
-
+import Gargantext.Core
 import Gargantext.Core.Types.Main (NodeTree(..), Tree(..))
-import Gargantext.Database.Admin.Config (fromNodeTypeId, nodeTypeId, fromNodeTypeId)
+import Gargantext.Database.Admin.Config hiding (nodeTypes)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (Cmd, runPGSQuery)
 import Gargantext.Database.Query.Table.NodeNode (getNodeNode)
@@ -153,16 +153,16 @@ updateTree nts fun r = do
 sharedTreeUpdate :: HasTreeError err => UpdateTree err
 sharedTreeUpdate p nt n = dbTree n nt
                <&> map (\n' -> if (view dt_nodeId n') == n
-                                  -- && elem (fromNodeTypeId $ _dt_typeId n') [NodeGraph]
-                                  -- && not (elem (fromNodeTypeId $ _dt_typeId n') [NodeFile])
+                                  -- && elem (fromDBid $ _dt_typeId n') [NodeGraph]
+                                  -- && not (elem (fromDBid $ _dt_typeId n') [NodeFile])
                                   then set dt_parentId (Just p) n'
                                   else n')
 
 publicTreeUpdate :: HasTreeError err => UpdateTree err
 publicTreeUpdate p nt n = dbTree n nt
                <&> map (\n' -> if _dt_nodeId n' == n
-                                  -- && (fromNodeTypeId $ _dt_typeId n') /= NodeGraph
-                                  -- && not (elem (fromNodeTypeId $ _dt_typeId n') [NodeFile])
+                                  -- && (fromDBid $ _dt_typeId n') /= NodeGraph
+                                  -- && not (elem (fromDBid $ _dt_typeId n') [NodeFile])
                                   then set dt_parentId (Just p) n'
                                   else n')
 
@@ -178,7 +178,7 @@ findNodesWithType :: RootId -> [NodeType] -> [NodeType] -> Cmd err [DbTreeNode]
 findNodesWithType root target through =
   filter isInTarget <$> dbTree root through
     where
-      isInTarget n = List.elem (fromNodeTypeId $ view dt_typeId n)
+      isInTarget n = List.elem (fromDBid $ view dt_typeId n)
                    $ List.nub $ target <> through
 
 ------------------------------------------------------------------------

src/Gargantext/Database/Query/Tree/Root.hs

@@ -15,11 +15,12 @@ module Gargantext.Database.Query.Tree.Root
 
 import Control.Arrow (returnA)
 import Data.Either (Either, fromLeft, fromRight)
+import Gargantext.Core
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Types.Main (CorpusName)
 import Gargantext.Database.Action.Node
 import Gargantext.Database.Action.User (getUserId, getUsername)
-import Gargantext.Database.Admin.Config (nodeTypeId, userMaster)
+import Gargantext.Database.Admin.Config
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (Cmd, runOpaQuery)
@@ -118,21 +119,21 @@ selectRoot :: User -> Query NodeRead
 selectRoot (UserName username) = proc () -> do
     row   <- queryNodeTable -< ()
     users <- queryUserTable -< ()
-    restrict -< _node_typename row   .== (pgInt4 $ nodeTypeId NodeUser)
+    restrict -< _node_typename row   .== (pgInt4 $ hasDBid NodeUser)
     restrict -< user_username  users .== (pgStrictText username)
     restrict -< _node_userId   row   .== (user_id users)
     returnA  -< row
 
 selectRoot (UserDBId uid) = proc () -> do
     row   <- queryNodeTable -< ()
-    restrict -< _node_typename row   .== (pgInt4 $ nodeTypeId NodeUser)
+    restrict -< _node_typename row   .== (pgInt4 $ hasDBid NodeUser)
     restrict -< _node_userId   row   .== (pgInt4 uid)
     returnA  -< row
 
 selectRoot (RootId nid) =
  proc () -> do
     row   <- queryNodeTable -< ()
-    restrict -< _node_typename row   .== (pgInt4 $ nodeTypeId NodeUser)
+    restrict -< _node_typename row   .== (pgInt4 $ hasDBid NodeUser)
     restrict -< _node_id   row   .== (pgNodeId nid)
     returnA  -< row
 selectRoot UserPublic = panic {-nodeError $ NodeError-}  "[G.D.Q.T.Root.selectRoot] No root for Public"

src/Gargantext/Database/Schema/NgramsPostag.hs

@@ -22,7 +22,9 @@ module Gargantext.Database.Schema.NgramsPostag
 
 import Control.Lens
 import Data.Text (Text)
+import Gargantext.Core
 import Gargantext.Database.Schema.Prelude
+import Gargantext.API.Ngrams.Types
 import Gargantext.Prelude
 import qualified Database.PostgreSQL.Simple as PGS
 
@@ -33,7 +35,7 @@ data NgramsPostagPoly id
                       ngrams_id
                       lemm_id
                       score
-  = NgramsPostagDB { _ngramsPostag_id        :: !id
+  = NgramsPostagPoly { _ngramsPostag_id        :: !id
                    , _ngramsPostag_lang_id   :: !lang_id
                    , _ngramsPostag_algo_id   :: !algo_id
                    , _ngramsPostag_postag    :: !postag
@@ -43,9 +45,18 @@ data NgramsPostagPoly id
                    } deriving (Show)
 
 ------------------------------------------------------------------------
+data PosTag = PosTag { unPosTag :: Text }
+            | NER    { unNER    :: Text } -- TODO
+
+------------------------------------------------------------------------
+type NgramsPostag   = NgramsPostagPoly (Maybe Int) Lang PostTagAlgo (Maybe PosTag) NgramsTerm NgramsTerm (Maybe Int)
+
 type NgramsPostagDB = NgramsPostagPoly (Maybe Int) Int Int (Maybe Text) Int Int Int
 
 
+
+------------------------------------------------------------------------
+
 type NgramsPosTagWrite = NgramsPostagPoly (Maybe (Column PGInt4))
                                    (Column PGInt4)
                                    (Column PGInt4)
@@ -72,7 +83,7 @@ type NgramsPosTagReadNull =  NgramsPostagPoly (Column (Nullable PGInt4))
 makeLenses ''NgramsPostagPoly
 
 instance PGS.ToRow NgramsPostagDB where
-  toRow (NgramsPostagDB f0 f1 f2 f3 f4 f5 f6) = [ toField f0
+  toRow (NgramsPostagPoly f0 f1 f2 f3 f4 f5 f6) = [ toField f0
                                                   , toField f1
                                                   , toField f2
                                                   , toField f3