[NEWTYPE] WIP Error in Servant to fix.

src/Gargantext/API.hs

@@ -83,7 +83,7 @@ import Gargantext.API.Node ( GargServer
                            , HyperdataAnnuaire
                            )
 --import Gargantext.Database.Node.Contact (HyperdataContact)
-import Gargantext.Database.Types.Node ()
+import Gargantext.Database.Types.Node (NodeId, CorpusId, AnnuaireId)
 import Gargantext.API.Count  ( CountAPI, count, Query)
 import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
 import Gargantext.Database.Facet
@@ -222,19 +222,19 @@ type GargAPI' =
            
            -- Node endpoint
            :<|> "node"  :> Summary "Node endpoint"
-                        :> Capture "id" Int      :> NodeAPI HyperdataAny
+                        :> Capture "id" NodeId      :> NodeAPI HyperdataAny
            
            -- Corpus endpoint
            :<|> "corpus":> Summary "Corpus endpoint"
-                        :> Capture "id" Int      :> NodeAPI HyperdataCorpus
+                        :> Capture "id" CorpusId      :> NodeAPI HyperdataCorpus
 
            -- Annuaire endpoint
            :<|> "annuaire":> Summary "Annuaire endpoint"
-                          :> Capture "id" Int      :> NodeAPI HyperdataAnnuaire
+                          :> Capture "id" AnnuaireId      :> NodeAPI HyperdataAnnuaire
 
            -- Corpus endpoint
            :<|> "nodes" :> Summary "Nodes endpoint"
-                        :> ReqBody '[JSON] [Int] :> NodesAPI
+                        :> ReqBody '[JSON] [NodeId] :> NodesAPI
        
         -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
            -- Corpus endpoint
@@ -250,11 +250,11 @@ type GargAPI' =
                         :> SearchAPI
            
            :<|> "graph" :> Summary "Graph endpoint"
-                        :> Capture "id" Int         :> GraphAPI
+                        :> Capture "id" NodeId       :> GraphAPI
            
            -- Tree endpoint
            :<|> "tree" :> Summary "Tree endpoint"
-                       :> Capture "id" Int          :> TreeAPI
+                       :> Capture "id" NodeId        :> TreeAPI
 
 
        --    :<|> "scraper" :> WithCallbacks ScraperAPI

src/Gargantext/API/Auth.hs

@@ -35,7 +35,7 @@ import Data.Text (Text, reverse)
 import GHC.Generics (Generic)
 import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Database.Root (getRoot)
-import Gargantext.Database.Types.Node (NodePoly(_node_id))
+import Gargantext.Database.Types.Node (NodePoly(_node_id), NodeId)
 import Gargantext.Database.Utils (Cmd)
 import Gargantext.Prelude hiding (reverse)
 import Test.QuickCheck (elements, oneof)
@@ -67,7 +67,7 @@ data AuthValid = AuthValid { _authVal_token   :: Token
   deriving (Generic)
 
 type Token  = Text
-type TreeId = Int
+type TreeId = NodeId
 
 -- | Main functions of authorization
 

src/Gargantext/API/Node.hs

@@ -62,7 +62,8 @@ import Gargantext.API.Search ( SearchAPI, searchIn, SearchInQuery)
 import Gargantext.Viz.Graph hiding (Node)-- (Graph(_graph_metadata),LegendField(..), GraphMetadata(..),readGraphFromJson,defaultGraph)
 -- import Gargantext.Core (Lang(..))
 import Gargantext.Core.Types (Offset, Limit)
-import Gargantext.Core.Types.Main (Tree, NodeTree, CorpusId, ContactId)
+import Gargantext.Core.Types.Main (Tree, NodeTree)
+import Gargantext.Database.Types.Node (CorpusId, ContactId)
 -- import Gargantext.Text.Terms (TermType(..))
 
 import Test.QuickCheck (elements)
@@ -117,7 +118,7 @@ type NodeAPI a = Get '[JSON] (Node a)
                         :> QueryParam "order"  OrderBy
                         :> SearchAPI
 
-type RenameApi = Summary " RenameNode Node"
+type RenameApi = Summary " Rename Node"
                :> ReqBody '[JSON] RenameNode
                :> Put     '[JSON] [Int]
 
@@ -176,7 +177,7 @@ instance Arbitrary PostNode where
 ------------------------------------------------------------------------
 type DocsApi = Summary "Docs : Move to trash"
              :> ReqBody '[JSON] Documents
-             :> Delete  '[JSON] [Int]
+             :> Delete  '[JSON] [NodeId]
 
 data Documents = Documents { documents :: [NodeId]}
   deriving (Generic)
@@ -322,7 +323,7 @@ getChart :: NodeId -> Maybe UTCTime -> Maybe UTCTime
                    -> Cmd err [FacetChart]
 getChart _ _ _ = undefined -- TODO
 
-postNode :: NodeId -> PostNode -> Cmd err [Int]
+postNode :: NodeId -> PostNode -> Cmd err [NodeId]
 postNode pId (PostNode name nt) = mk nt (Just pId) name
 
 putNode :: NodeId -> Cmd err Int

src/Gargantext/API/Search.hs

@@ -45,7 +45,7 @@ import Gargantext.Database.Utils (Cmd)
 -- | SearchIn [NodesId] if empty then global search
 -- TODO [Int]
 data SearchQuery = SearchQuery { sq_query :: [Text]
-                               , sq_corpus_id :: Int
+                               , sq_corpus_id :: NodeId
                                } deriving (Generic)
 $(deriveJSON (unPrefix "sq_") ''SearchQuery)
 instance ToSchema SearchQuery where

src/Gargantext/Core/Types/Main.hs

@@ -42,7 +42,7 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 ------------------------------------------------------------------------
 data NodeTree = NodeTree { _nt_name :: Text
                          , _nt_type :: NodeType
-                         , _nt_id   :: Int
+                         , _nt_id   :: NodeId
                          } deriving (Show, Read, Generic)
 
 $(deriveJSON (unPrefix "_nt_") ''NodeTree)
@@ -80,24 +80,9 @@ corpusTree nId t  = TreeN (NodeTree ("Corpus " <> t)  NodeCorpus nId) (  [ leafT
 
 --data Classification = Favorites | MyClassifcation
 
-type UserId   = Int
-type MasterUserId = Int
-
-type RootId   = Int
-type MasterCorpusId = Int
-
 type HashId   = Text
 
-type AnnuaireId = NodeId
-type ContactId  = NodeId
-
-type CorpusId   = NodeId
-type DocumentId = NodeId
-type DocId      = DocumentId -- todo: remove this
-
-type ListId     = NodeId
 type TypeId     = Int
-
 -- TODO multiple ListType declaration, remove it
 data ListType  =  StopList  | CandidateList | GraphList
   deriving (Generic, Eq, Ord, Show, Enum, Bounded)
@@ -152,7 +137,6 @@ type TirankGlobal  = Tficf
 type ErrorMessage = Text
 
 -- Queries
-type ParentId = NodeId
 type Limit    = Int
 type Offset   = Int
 

src/Gargantext/Database/Facet.hs

@@ -219,7 +219,7 @@ viewAuthorsDoc cId _ nt = proc () -> do
   -- restrict -< nodeNode_delete   nn .== (pgBool t)
   -}
 
-  restrict -< _node_id   contact   .== (toNullable $ pgInt4 cId)
+  restrict -< _node_id   contact   .== (toNullable $ pgNodeId cId)
   restrict -< _node_typename doc   .== (pgInt4 $ nodeTypeId nt)
 
   returnA  -< FacetDoc (_node_id doc) (_node_date doc) (_node_name doc) (_node_hyperdata doc) (pgBool True) (pgInt4 1)
@@ -255,7 +255,7 @@ viewDocuments cId t ntId = proc () -> do
   n  <- queryNodeTable     -< ()
   nn <- queryNodeNodeTable -< ()
   restrict -< _node_id          n  .== nodeNode_node2_id nn
-  restrict -< nodeNode_node1_id nn .== (pgInt4 cId)
+  restrict -< nodeNode_node1_id nn .== (pgNodeId cId)
   restrict -< _node_typename    n  .== (pgInt4 ntId)
   restrict -< nodeNode_delete   nn .== (pgBool t)
   returnA  -< FacetDoc (_node_id n) (_node_date n) (_node_name n) (_node_hyperdata n) (nodeNode_favorite nn) (pgInt4 1)

src/Gargantext/Database/Flow.hs

@@ -42,8 +42,7 @@ import Gargantext.Database.Schema.Node (mkRoot, mkCorpus, getOrMkList, mkGraph,
 import Gargantext.Database.Schema.NodeNgram (NodeNgramPoly(..), insertNodeNgrams)
 import Gargantext.Database.Schema.NodeNgramsNgrams (NodeNgramsNgramsPoly(..), insertNodeNgramsNgramsNew)
 import Gargantext.Database.Schema.User (getUser, UserLight(..))
-import Gargantext.Database.Types.Node (HyperdataDocument(..))
-import Gargantext.Database.Types.Node (NodeType(..), NodeId)
+import Gargantext.Database.Types.Node (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
 import Gargantext.Database.Utils (Cmd)
 import Gargantext.Text.Terms (TermType(..))
 import Gargantext.Ext.IMT (toSchoolName)
@@ -53,6 +52,7 @@ import Gargantext.Text.Parsers (parseDocs, FileFormat)
 import System.FilePath (FilePath)
 import qualified Data.Map as DM
 
+
 flowCorpus :: HasNodeError err => FileFormat -> FilePath -> CorpusName -> Cmd err CorpusId
 flowCorpus ff fp cName = do
   hyperdataDocuments' <- map addUniqIdsDoc <$> liftIO (parseDocs ff fp)
@@ -284,7 +284,7 @@ flowList uId cId ngs = do
 
   pure lId
 
-flowListUser :: HasNodeError err => UserId -> CorpusId -> Cmd err Int
+flowListUser :: HasNodeError err => UserId -> CorpusId -> Cmd err NodeId
 flowListUser uId cId = getOrMkList cId uId
 
 ------------------------------------------------------------------------

src/Gargantext/Database/Flow/Pairing.hs

@@ -37,6 +37,7 @@ import Gargantext.Database.Schema.Ngrams -- (NgramsType(..))
 import Gargantext.Database.Node.Contact
 import Gargantext.Database.Flow.Utils
 import Gargantext.Database.Utils (Cmd, runPGSQuery)
+import Gargantext.Database.Types.Node (AnnuaireId, CorpusId, ContactId)
 import Gargantext.Database.Node.Children
 import Gargantext.Core.Types.Main
 import Gargantext.Core.Types (NodeType(..))

src/Gargantext/Database/Node/Children.hs

@@ -26,6 +26,7 @@ import Gargantext.Database.Schema.NodeNode
 import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Queries.Filter
 import Gargantext.Database.Node.Contact (HyperdataContact)
+import Gargantext.Database.Schema.Node (pgNodeId)
 import Control.Arrow (returnA)
 
 -- | TODO: use getChildren with Proxy ?
@@ -47,8 +48,8 @@ selectChildren parentId maybeNodeType = proc () -> do
     let nodeType = maybe 0 nodeTypeId maybeNodeType
     restrict -< typeName  .== pgInt4 nodeType
     
-    restrict -< (.||) (parent_id .== (pgInt4 parentId))
-                      ( (.&&) (n1id .== pgInt4 parentId)
+    restrict -< (.||) (parent_id .== (pgNodeId parentId))
+                      ( (.&&) (n1id .== pgNodeId parentId)
                               (n2id .== nId))
     returnA -< row
 

src/Gargantext/Database/Node/Contact.hs

@@ -28,9 +28,8 @@ import Data.Time (UTCTime)
 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import GHC.Generics (Generic)
 import Gargantext.Core.Utils.Prefix (unPrefix)
-import Gargantext.Core.Types.Main (AnnuaireId, UserId)
 import Gargantext.Database.Schema.Node (NodeWrite, Name, node)
-import Gargantext.Database.Types.Node (Node,Hyperdata,NodeType(..))
+import Gargantext.Database.Types.Node (Node,Hyperdata,NodeType(..), UserId, AnnuaireId)
 import Gargantext.Database.Utils (fromField')
 import Gargantext.Prelude
 import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)

src/Gargantext/Database/Node/Document/Add.hs

@@ -40,7 +40,6 @@ import Gargantext.Prelude
 import GHC.Generics (Generic)
 ---------------------------------------------------------------------------
 
-type ParentId = Int
 
 add :: ParentId -> [NodeId] -> Cmd err [Only Int]
 add pId ns = runPGSQuery queryAdd (Only $ Values fields inputData)

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

@@ -180,7 +180,7 @@ prepare uId pId nodeType = map (\h -> InputData tId uId pId (name h) (toJSON' h)
 -- | When documents are inserted
 -- ReturnType after insertion
 data ReturnId = ReturnId { reInserted :: Bool -- ^ if the document is inserted (True: is new, False: is not new)
-                         , reId       :: Int  -- ^ always return the id of the document (even new or not new)
+                         , reId       :: NodeId  -- ^ always return the id of the document (even new or not new)
                                          --   this is the uniq id in the database
                          , reUniqId   :: Text -- ^ Hash Id with concatenation of hash parameters
                          } deriving (Show, Generic)
@@ -190,9 +190,6 @@ instance FromRow ReturnId where
 
 -- ** Insert Types
 
-type UserId   = Int
-type ParentId = Int
-
 data InputData = InputData { inTypenameId :: NodeTypeId
                            , inUserId     :: UserId
                            , inParentId   :: ParentId

src/Gargantext/Database/Node/Update.hs

@@ -23,14 +23,13 @@ import Database.PostgreSQL.Simple
 
 import Gargantext.Prelude
 import Gargantext.Database.Utils
+import Gargantext.Database.Types.Node (NodeId, ParentId)
+import Gargantext.Database.Schema.Node (Name)
 
 -- import Data.ByteString
 --rename :: NodeId -> Text -> IO ByteString
 --rename nodeId name = formatPGSQuery "UPDATE nodes SET name=? where id=?" (name,nodeId)
 ------------------------------------------------------------------------
-type NodeId = Int
-type Name   = Text
-type ParentId = Int
 
 data Update = Rename NodeId Name
             | Move   NodeId ParentId

src/Gargantext/Database/Schema/Ngrams.hs

@@ -221,8 +221,8 @@ getNgramsTableDb nt ngrt ntp@(NgramsTableParam listIdUser _) limit_ offset_ = do
 
 
 data NgramsTableParam =
-     NgramsTableParam { _nt_listId     :: Int
-                      , _nt_corpusId   :: Int
+     NgramsTableParam { _nt_listId     :: NodeId
+                      , _nt_corpusId   :: NodeId
                       }
 
 type NgramsTableParamUser   = NgramsTableParam
@@ -289,8 +289,8 @@ querySelectTableNgrams = [sql|
 
   |]
 
-type ListIdUser   = Int
-type ListIdMaster = Int
+type ListIdUser   = NodeId
+type ListIdMaster = NodeId
 
 type MapToChildren = Map Text (Set Text)
 type MapToParent   = Map Text Text

src/Gargantext/Database/Schema/Node.hs

@@ -38,7 +38,6 @@ import GHC.Int (Int64)
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Types
 import Gargantext.Core.Types.Individu (Username)
-import Gargantext.Core.Types.Main (UserId)
 import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Queries.Filter (limit', offset')
 import Gargantext.Database.Types.Node (NodeType, defaultCorpus, Hyperdata)
@@ -140,10 +139,15 @@ instance QueryRunnerColumnDefault PGTSVector (Maybe TSVector)
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGInt4 (Maybe NodeParentId)
+instance QueryRunnerColumnDefault PGInt4 (Maybe NodeId)
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
+instance QueryRunnerColumnDefault PGInt4 NodeId
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+
 ------------------------------------------------------------------------
 -- WIP
 -- TODO Classe HasDefault where
@@ -269,7 +273,7 @@ selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
 selectNodesWith' parentId maybeNodeType = proc () -> do
     node <- (proc () -> do
       row@(Node _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
-      restrict -< parentId' .== (pgInt4 parentId)
+      restrict -< parentId' .== (pgNodeId parentId)
 
       let typeId' = maybe 0 nodeTypeId maybeNodeType
 
@@ -280,46 +284,46 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
     returnA -< node
 
 
-deleteNode :: Int -> Cmd err Int
+deleteNode :: NodeId -> Cmd err Int
 deleteNode n = mkCmd $ \conn ->
   fromIntegral <$> runDelete conn nodeTable
-                 (\(Node n_id _ _ _ _ _ _) -> n_id .== pgInt4 n)
+                 (\(Node n_id _ _ _ _ _ _) -> n_id .== pgNodeId n)
 
-deleteNodes :: [Int] -> Cmd err Int
+deleteNodes :: [NodeId] -> Cmd err Int
 deleteNodes ns = mkCmd $ \conn ->
   fromIntegral <$> runDelete conn nodeTable
-                   (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
+                   (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgNodeId ns)) n_id)
 
 -- TODO: NodeType should match with `a'
-getNodesWith :: JSONB a => Int -> proxy a -> Maybe NodeType
+getNodesWith :: JSONB a => NodeId -> proxy a -> Maybe NodeType
              -> Maybe Offset -> Maybe Limit -> Cmd err [Node a]
 getNodesWith parentId _ nodeType maybeOffset maybeLimit =
     runOpaQuery $ selectNodesWith parentId nodeType maybeOffset maybeLimit
 
 -- TODO: Why is the second parameter ignored?
 -- TODO: Why not use getNodesWith?
-getNodesWithParentId :: Int -> Maybe Text -> Cmd err [NodeAny]
+getNodesWithParentId :: NodeId -> Maybe Text -> Cmd err [NodeAny]
 getNodesWithParentId n _ = runOpaQuery $ selectNodesWithParentID n
 
 ------------------------------------------------------------------------
-getDocumentsV3WithParentId :: Int -> Cmd err [Node HyperdataDocumentV3]
+getDocumentsV3WithParentId :: NodeId -> Cmd err [Node HyperdataDocumentV3]
 getDocumentsV3WithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocument)
 
 -- TODO: merge with getDocumentsWithParentId by having a class IsHyperdataDocument
-getDocumentsWithParentId :: Int -> Cmd err [Node HyperdataDocument]
+getDocumentsWithParentId :: NodeId -> Cmd err [Node HyperdataDocument]
 getDocumentsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocument)
 
-getListsWithParentId :: Int -> Cmd err [Node HyperdataList]
+getListsWithParentId :: NodeId -> Cmd err [Node HyperdataList]
 getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)
 
-getCorporaWithParentId :: Int -> Cmd err [Node HyperdataCorpus]
+getCorporaWithParentId :: NodeId -> Cmd err [Node HyperdataCorpus]
 getCorporaWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeCorpus)
 
 ------------------------------------------------------------------------
-selectNodesWithParentID :: Int -> Query NodeRead
+selectNodesWithParentID :: NodeId -> Query NodeRead
 selectNodesWithParentID n = proc () -> do
     row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
-    restrict -< parent_id .== (pgInt4 n)
+    restrict -< parent_id .== (pgNodeId n)
     returnA -< row
 
 selectNodesWithType :: Column PGInt4 -> Query NodeRead
@@ -330,9 +334,9 @@ selectNodesWithType type_id = proc () -> do
 
 type JSONB = QueryRunnerColumnDefault PGJsonb
 
-getNode :: JSONB a => Int -> proxy a -> Cmd err (Node a)
-getNode id _ = do
-    fromMaybe (error $ "Node does node exist: " <> show id) . headMay <$> runOpaQuery (limit 1 $ selectNode (pgInt4 id))
+getNode :: JSONB a => NodeId -> proxy a -> Cmd err (Node a)
+getNode nId _ = do
+    fromMaybe (error $ "Node does node exist: " <> show nId) . headMay <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
 
 getNodesWithType :: Column PGInt4 -> Cmd err [Node HyperdataDocument]
 getNodesWithType = runOpaQuery . selectNodesWithType
@@ -415,7 +419,7 @@ nodeDashboardW maybeName maybeDashboard pId = node NodeDashboard name dashboard
 
 ------------------------------------------------------------------------
 node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite
-node nodeType name hyperData parentId userId = Node Nothing (pgInt4 typeId) (pgInt4 userId) (pgInt4 <$> parentId) (pgStrictText name) Nothing (pgJSONB $ cs $ encode hyperData)
+node nodeType name hyperData parentId userId = Node Nothing (pgInt4 typeId) (pgInt4 userId) (pgNodeId <$> parentId) (pgStrictText name) Nothing (pgJSONB $ cs $ encode hyperData)
   where
     typeId = nodeTypeId nodeType
 
@@ -423,15 +427,15 @@ node nodeType name hyperData parentId userId = Node Nothing (pgInt4 typeId) (pgI
 insertNodes :: [NodeWrite] -> Cmd err Int64
 insertNodes ns = mkCmd $ \conn -> runInsertMany conn nodeTable ns
 
-insertNodesR :: [NodeWrite] -> Cmd err [Int]
+insertNodesR :: [NodeWrite] -> Cmd err [NodeId]
 insertNodesR ns = mkCmd $ \conn ->
   runInsert_ conn (Insert nodeTable ns (rReturning (\(Node i _ _ _ _ _ _) -> i)) Nothing)
 
 insertNodesWithParent :: Maybe ParentId -> [NodeWrite] -> Cmd err Int64
-insertNodesWithParent pid ns = insertNodes (set node_parentId (pgInt4 <$> pid) <$> ns)
+insertNodesWithParent pid ns = insertNodes (set node_parentId (pgNodeId <$> pid) <$> ns)
 
-insertNodesWithParentR :: Maybe ParentId -> [NodeWrite] -> Cmd err [Int]
-insertNodesWithParentR pid ns = insertNodesR (set node_parentId (pgInt4 <$> pid) <$> ns)
+insertNodesWithParentR :: Maybe ParentId -> [NodeWrite] -> Cmd err [NodeId]
+insertNodesWithParentR pid ns = insertNodesR (set node_parentId (pgNodeId <$> pid) <$> ns)
 ------------------------------------------------------------------------
 -- TODO Hierachy of Nodes
 -- post and get same types Node' and update if changes
@@ -447,10 +451,10 @@ post c uid pid [ Node' NodeCorpus "name" "{}" []
 ------------------------------------------------------------------------
 
 -- TODO
--- currently this function remove the child relation
+-- currently this function removes the child relation
 -- needs a Temporary type between Node' and NodeWriteT
 node2table :: UserId -> Maybe ParentId -> Node' -> NodeWrite
-node2table uid pid (Node' nt txt v []) = Node Nothing (pgInt4$ nodeTypeId nt) (pgInt4 uid) (fmap pgInt4 pid) (pgStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v)
+node2table uid pid (Node' nt txt v []) = Node Nothing (pgInt4 $ nodeTypeId 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"
 
 
@@ -463,20 +467,19 @@ data Node' = Node' { _n_type :: NodeType
 mkNode :: [NodeWrite] -> Cmd err Int64
 mkNode ns = mkCmd $ \conn -> runInsertMany conn nodeTable ns
 
-mkNodeR :: [NodeWrite] -> Cmd err [Int]
+mkNodeR :: [NodeWrite] -> Cmd err [NodeId]
 mkNodeR ns = mkCmd $ \conn -> runInsertManyReturning conn nodeTable ns (_node_id)
 
 ------------------------------------------------------------------------
 
-data NewNode = NewNode { _newNodeId :: Int
-                       , _newNodeChildren :: [Int] }
+data NewNode = NewNode { _newNodeId :: NodeId
+                       , _newNodeChildren :: [NodeId] }
 
--- | postNode
 postNode :: HasNodeError err => UserId -> Maybe ParentId -> Node' -> Cmd err NewNode
 postNode uid pid (Node' nt txt v []) = do
   pids <- mkNodeR [node2table uid pid (Node' nt txt v [])]
   case pids of
-    [pid] -> pure $ NewNode pid []
+    [pid'] -> pure $ NewNode pid' []
     _ -> nodeError ManyParents
 
 postNode uid pid (Node' NodeCorpus txt v ns) = do
@@ -497,33 +500,34 @@ childWith uId pId (Node' NodeContact  txt v []) = node2table uId (Just pId) (Nod
 childWith _   _   (Node' _        _   _ _) = panic "This NodeType can not be a child"
 
 
-mk :: NodeType -> Maybe ParentId -> Text -> Cmd err [Int]
+-- | TODO Use right userId
+mk :: NodeType -> Maybe ParentId -> Text -> Cmd err [NodeId]
 mk nt pId name  = mk' nt userId pId name
   where
     userId = 1
 
-mk' :: NodeType -> UserId -> Maybe ParentId -> Text -> Cmd err [Int]
-mk' nt uId pId name  = map fromIntegral <$> insertNodesWithParentR pId [node nt name hd pId uId]
+mk' :: NodeType -> UserId -> Maybe ParentId -> Text -> Cmd err [NodeId]
+mk' nt uId pId name  = insertNodesWithParentR pId [node nt name hd pId uId]
   where
     hd = HyperdataUser . Just . pack $ show EN
 
 type Name = Text
 
-mk'' :: HasNodeError err => NodeType -> Maybe ParentId -> UserId -> Name -> Cmd err [Int]
+mk'' :: HasNodeError err => NodeType -> Maybe ParentId -> UserId -> Name -> Cmd err [NodeId]
 mk'' NodeUser Nothing uId name  = mk' NodeUser uId Nothing name
 mk'' NodeUser _       _   _     = nodeError UserNoParent
 mk'' _        Nothing _   _     = nodeError HasParent
 mk'' nt       pId     uId name  = mk' nt uId pId name
 
-mkRoot :: HasNodeError err => Username -> UserId -> Cmd err [Int]
+mkRoot :: HasNodeError err => Username -> UserId -> Cmd err [RootId]
 mkRoot uname uId = case uId > 0 of
                False -> nodeError NegativeId
                True  -> mk'' NodeUser Nothing uId uname
 
-mkCorpus :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> Cmd err [Int]
+mkCorpus :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> Cmd err [CorpusId]
 mkCorpus n h p u = insertNodesR [nodeCorpusW n h p u]
 
-getOrMkList :: HasNodeError err => ParentId -> UserId -> Cmd err Int
+getOrMkList :: HasNodeError err => ParentId -> UserId -> Cmd err NodeId
 getOrMkList pId uId =
   maybe (mkList' pId uId) (pure . view node_id) . headMay =<< getListsWithParentId pId
     where
@@ -534,17 +538,19 @@ defaultList :: HasNodeError err => CorpusId -> Cmd err ListId
 defaultList cId =
   maybe (nodeError NoListFound) (pure . view node_id) . headMay =<< getListsWithParentId cId
 
-mkList :: HasNodeError err => ParentId -> UserId -> Cmd err [Int]
+mkList :: HasNodeError err => ParentId -> UserId -> Cmd err [NodeId]
 mkList p u = insertNodesR [nodeListW Nothing Nothing p u]
 
-mkGraph :: ParentId -> UserId -> Cmd err [Int]
+mkGraph :: ParentId -> UserId -> Cmd err [GraphId]
 mkGraph p u = insertNodesR [nodeGraphW Nothing Nothing p u]
 
-mkDashboard :: ParentId -> UserId -> Cmd err [Int]
+mkDashboard :: ParentId -> UserId -> Cmd err [NodeId]
 mkDashboard p u = insertNodesR [nodeDashboardW Nothing Nothing p u]
 
-mkAnnuaire :: ParentId -> UserId -> Cmd err [Int]
+mkAnnuaire :: ParentId -> UserId -> Cmd err [NodeId]
 mkAnnuaire p u = insertNodesR [nodeAnnuaireW Nothing Nothing p u]
 
 -- | Default CorpusId Master and ListId Master
 
+pgNodeId :: NodeId -> Column PGInt4
+pgNodeId = pgInt4 . id2int

src/Gargantext/Database/Schema/NodeNgram.hs

@@ -35,8 +35,10 @@ import Control.Lens.TH (makeLensesWith, abbreviatedFields)
 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.Core.Types.Main (ListTypeId)
 import Gargantext.Database.Utils (mkCmd, Cmd, runPGSQuery)
+import Gargantext.Database.Types.Node (NodeId, ListId)
+import Gargantext.Database.Schema.Node (pgNodeId)
 import Gargantext.Prelude
 import Opaleye
 import qualified Database.PostgreSQL.Simple as PGS (Only(..))
@@ -75,7 +77,7 @@ type NodeNgramReadNull =
        (Column (Nullable PGInt4  ))
 
 type NodeNgram =
-     NodeNgramPoly (Maybe Int) Int Int Double Int
+     NodeNgramPoly (Maybe NodeId) NodeId Int Double Int
 
 $(makeAdaptorAndInstance "pNodeNgram" ''NodeNgramPoly)
 $(makeLensesWith abbreviatedFields    ''NodeNgramPoly)
@@ -98,7 +100,7 @@ queryNodeNgramTable = queryTable nodeNgramTable
 insertNodeNgrams :: [NodeNgram] -> Cmd err Int
 insertNodeNgrams = insertNodeNgramW
                  . map (\(NodeNgram _ n g w t) ->
-                          NodeNgram Nothing (pgInt4 n)   (pgInt4 g)
+                          NodeNgram Nothing (pgNodeId n)   (pgInt4 g)
                                             (pgDouble w) (pgInt4 t)
                         )
 

src/Gargantext/Database/Schema/NodeNgramsNgrams.hs

@@ -41,6 +41,8 @@ import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import Gargantext.Database.Utils (Cmd, runOpaQuery, runPGSQuery, connection)
+import Gargantext.Database.Types.Node (ListId)
+import Gargantext.Database.Schema.Node (pgNodeId)
 import Gargantext.Prelude
 import Opaleye
 import qualified Database.PostgreSQL.Simple as PGS
@@ -66,7 +68,7 @@ type NodeNgramsNgramsRead  =
                      (Column PGFloat8)
 
 type NodeNgramsNgrams =
-  NodeNgramsNgramsPoly Int
+  NodeNgramsNgramsPoly ListId
                      Int
                      Int
                     (Maybe Double)
@@ -107,7 +109,7 @@ instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
 insertNodeNgramsNgramsNew :: [NodeNgramsNgrams] -> Cmd err Int
 insertNodeNgramsNgramsNew = insertNodeNgramsNgramsW
                  . map (\(NodeNgramsNgrams n ng1 ng2 maybeWeight) ->
-                          NodeNgramsNgrams (pgInt4 n  )
+                          NodeNgramsNgrams (pgNodeId n  )
                                            (pgInt4 ng1)
                                            (pgInt4 ng2)
                                            (pgDouble <$> maybeWeight)

src/Gargantext/Database/Schema/NodeNode.hs

@@ -32,7 +32,7 @@ import Control.Lens.TH (makeLensesWith, abbreviatedFields)
 import Data.Maybe (Maybe)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Gargantext.Database.Utils
-import Gargantext.Core.Types.Main (CorpusId, DocId)
+import Gargantext.Database.Types.Node (CorpusId, DocId)
 import Gargantext.Prelude
 import Opaleye
 

src/Gargantext/Database/TextSearch.hs

@@ -64,7 +64,7 @@ searchInCorpus cId q o l order = runOpaQuery (filterWith o l order $ queryInCorp
 queryInCorpus :: CorpusId -> Text -> O.Query FacetDocRead
 queryInCorpus cId q = proc () -> do
   (n, nn) <- joinInCorpus -< ()
-  restrict -< ( nodeNode_node1_id nn) .== (toNullable $ pgInt4 cId)
+  restrict -< ( nodeNode_node1_id nn) .== (toNullable $ pgNodeId cId)
   restrict -< (_ns_search n)           @@ (pgTSQuery (unpack q))
   restrict -< (_ns_typename n)        .== (pgInt4 $ nodeTypeId NodeDocument)
   returnA  -< FacetDoc (_ns_id n) (_ns_date n) (_ns_name n) (_ns_hyperdata n) (pgBool True) (pgInt4 1)
@@ -103,7 +103,7 @@ queryInCorpusWithContacts cId q _ _ _ = proc () -> do
   (docs, (corpusDoc, (docNgrams, (ngrams', (_, contacts))))) <- joinInCorpusWithContacts -< ()
   restrict -< (_ns_search docs)              @@ (pgTSQuery  $ unpack q  )
   restrict -< (_ns_typename docs)           .== (pgInt4 $ nodeTypeId NodeDocument)
-  restrict -< (nodeNode_node1_id corpusDoc) .== (toNullable $ pgInt4 cId)
+  restrict -< (nodeNode_node1_id corpusDoc) .== (toNullable $ pgNodeId cId)
   restrict -< (nodeNgram_type docNgrams)    .== (toNullable $ pgInt4 $ ngramsTypeId Authors)
   restrict -< (_node_typename contacts)     .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
   -- let contact_id    = ifThenElse (isNull $ _node_id contacts) (toNullable $ pgInt4 0) (_node_id contacts)

src/Gargantext/Database/Tree.hs

@@ -27,6 +27,7 @@ import Database.PostgreSQL.Simple.SqlQQ
 
 import Gargantext.Prelude
 import Gargantext.Core.Types.Main (NodeTree(..), Tree(..))
+import Gargantext.Database.Types.Node (NodeId)
 import Gargantext.Database.Config (fromNodeTypeId)
 import Gargantext.Database.Utils (Cmd, runPGSQuery)
 ------------------------------------------------------------------------
@@ -48,8 +49,8 @@ treeError te = throwError $ _TreeError # te
 treeDB :: HasTreeError err => RootId -> Cmd err (Tree NodeTree)
 treeDB r = toTree =<< (toTreeParent <$> dbTree r)
 
-type RootId = Int
-type ParentId = Int
+type RootId = NodeId
+type ParentId = NodeId
 ------------------------------------------------------------------------
 toTree :: (MonadError e m, HasTreeError e)
        => Map (Maybe ParentId) [DbTreeNode] -> m (Tree NodeTree)
@@ -74,9 +75,9 @@ toNodeTree (DbTreeNode nId tId _ n) = NodeTree n nodeType nId
 toTreeParent :: [DbTreeNode] -> Map (Maybe ParentId) [DbTreeNode]
 toTreeParent = fromListWith (<>) . map (\n -> (dt_parentId n, [n]))
 ------------------------------------------------------------------------
-data DbTreeNode = DbTreeNode { dt_nodeId :: Int
+data DbTreeNode = DbTreeNode { dt_nodeId :: NodeId
                              , dt_typeId :: Int
-                             , dt_parentId :: Maybe Int
+                             , dt_parentId :: Maybe NodeId
                              , dt_name     :: Text
                              } deriving (Show)
 

src/Gargantext/Database/Types/Node.hs

@@ -18,6 +18,7 @@ Portability : POSIX
 {-# LANGUAGE NoImplicitPrelude          #-}
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 -- {-# LANGUAGE DuplicateRecordFields #-}
 
 module Gargantext.Database.Types.Node
@@ -48,6 +49,7 @@ import           Text.Read (read)
 import           Text.Show (Show())
 
 import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField)
+import Database.PostgreSQL.Simple.FromField (FromField)
 import           Servant
 
 import           Test.QuickCheck.Arbitrary
@@ -56,7 +58,36 @@ import           Test.QuickCheck (elements)
 import           Gargantext.Prelude
 import           Gargantext.Core.Utils.Prefix (unPrefix)
 ------------------------------------------------------------------------
-type NodeId = Int
+newtype NodeId = NodeId Int
+  deriving (Show, Read, Generic, Num, Eq, Ord, Enum)
+
+instance ToField NodeId
+instance FromField NodeId
+instance ToJSON NodeId
+instance FromJSON NodeId
+instance ToSchema NodeId
+
+instance FromHttpApiData NodeId
+instance ToParamSchema NodeId
+instance Arbitrary NodeId
+
+type ParentId = NodeId
+type GraphId  = NodeId
+type CorpusId = NodeId
+type ListId   = NodeId
+type DocumentId = NodeId
+type DocId      = DocumentId -- todo: remove this
+type RootId   = NodeId
+type MasterCorpusId = NodeId
+type AnnuaireId = NodeId
+type ContactId  = NodeId
+
+type UserId   = Int
+type MasterUserId = UserId
+
+id2int :: NodeId -> Int
+id2int (NodeId n) = n
+
 
 type UTCTime' = UTCTime
 
@@ -328,12 +359,10 @@ instance Hyperdata HyperdataNotebook
 
 
 -- | NodePoly indicates that Node has a Polymorphism Type
-type Node json   = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json
+type Node json   = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
 
 -- type Node json   = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
 type NodeTypeId   = Int
-type NodeParentId = Int
-type NodeUserId   = Int
 type NodeName     = Text
 type TSVector     = Text
 
@@ -416,16 +445,16 @@ data NodePolySearch id        typename userId
 $(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
 $(makeLenses ''NodePolySearch)
 
-type NodeSearch json   = NodePolySearch NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json (Maybe TSVector)
+type NodeSearch json   = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json (Maybe TSVector)
 ------------------------------------------------------------------------
 
 
 instance (Arbitrary hyperdata
          ,Arbitrary nodeId
          ,Arbitrary nodeTypeId
-         ,Arbitrary nodeUserId
+         ,Arbitrary userId
          ,Arbitrary nodeParentId
-         ) => Arbitrary (NodePoly nodeId nodeTypeId nodeUserId nodeParentId
+         ) => Arbitrary (NodePoly nodeId nodeTypeId 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
@@ -435,9 +464,9 @@ instance (Arbitrary hyperdata
 instance (Arbitrary hyperdata
          ,Arbitrary nodeId
          ,Arbitrary nodeTypeId
-         ,Arbitrary nodeUserId
+         ,Arbitrary userId
          ,Arbitrary nodeParentId
-         ) => Arbitrary (NodePolySearch nodeId nodeTypeId nodeUserId nodeParentId
+         ) => Arbitrary (NodePolySearch nodeId nodeTypeId 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
@@ -484,30 +513,30 @@ instance ToSchema HyperdataAny where
 
 instance ToSchema hyperdata =>
          ToSchema (NodePoly NodeId NodeTypeId
-                            (Maybe NodeUserId)
-                            NodeParentId NodeName
+                            (Maybe UserId)
+                            ParentId NodeName
                             UTCTime hyperdata
                   )
 
 instance ToSchema hyperdata =>
          ToSchema (NodePoly NodeId NodeTypeId
-                            NodeUserId
-                            (Maybe NodeParentId) NodeName
+                            UserId
+                            (Maybe ParentId) NodeName
                             UTCTime hyperdata
                   )
 
 
 instance ToSchema hyperdata =>
          ToSchema (NodePolySearch NodeId NodeTypeId
-                            (Maybe NodeUserId)
-                            NodeParentId NodeName
+                            (Maybe UserId)
+                            ParentId NodeName
                             UTCTime hyperdata (Maybe TSVector)
                   )
 
 instance ToSchema hyperdata =>
          ToSchema (NodePolySearch NodeId NodeTypeId
-                            NodeUserId
-                            (Maybe NodeParentId) NodeName
+                            UserId
+                            (Maybe ParentId) NodeName
                             UTCTime hyperdata (Maybe TSVector)
                   )
 

src/Gargantext/Database/Utils.hs

@@ -36,7 +36,7 @@ import Database.PostgreSQL.Simple (Connection, connect)
 import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(ConversionFailed), fromField, returnError)
 import Database.PostgreSQL.Simple.Internal  (Field)
 import Gargantext.Prelude
-import Opaleye (Query, Unpackspec, showSqlForPostgres, FromFields, Select, runQuery)
+import Opaleye (Query, Unpackspec, showSqlForPostgres, FromFields, Select, runQuery, Column)
 import Servant (ServantErr)
 import System.IO (FilePath)
 import Text.Read (read)
@@ -126,4 +126,3 @@ fromField' field mb = do
 printSqlOpa :: Default Unpackspec a a => Query a -> IO ()
 printSqlOpa = putStrLn . maybe "Empty query" identity . showSqlForPostgres
 
-

src/Gargantext/Viz/Graph.hs

@@ -38,6 +38,7 @@ import Data.Swagger
 import Gargantext.Prelude
 import Gargantext.Core.Types (Label)
 import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Database.Types.Node (NodeId)
 
 import Data.Graph.Clustering.Louvain.CplusPlus (LouvainNode(..))
 
@@ -98,7 +99,7 @@ instance ToSchema LegendField where
 makeLenses ''LegendField
 --
 data GraphMetadata = GraphMetadata { _gm_title    :: Text   -- title of the graph
-                                   , _gm_corpusId :: [Int]  -- we can map with different corpus
+                                   , _gm_corpusId :: [NodeId]  -- we can map with different corpus
                                    , _gm_legend :: [LegendField] -- legend of the Graph
                                    }
   deriving (Show, Generic)
@@ -154,8 +155,7 @@ data EdgeV3 = EdgeV3 { eo_s :: Int
   deriving (Show, Generic)
 $(deriveJSON (unPrefix "eo_") ''EdgeV3)
 
-data GraphV3 = GraphV3 { 
-                           go_links :: [EdgeV3]
+data GraphV3 = GraphV3 { go_links :: [EdgeV3]
                        , go_nodes :: [NodeV3]
                        }
   deriving (Show, Generic)