[FIX] Instances declations: HasDBid NodeType (more ids for types coming)

src/Gargantext/Database/Action/Delete.hs

@@ -25,7 +25,6 @@ import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Action.User (getUserId)
 import Gargantext.Database.Action.Share (delFolderTeam)
 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)

src/Gargantext/Database/Action/Learn.hs

@@ -17,6 +17,7 @@ module Gargantext.Database.Action.Learn
 
 import Data.Maybe
 import Data.Text (Text)
+import Gargantext.Core
 import Gargantext.Core.Types (Offset, Limit)
 import Gargantext.Database.Query.Facet
 import Gargantext.Database.Admin.Types.Hyperdata
@@ -31,14 +32,15 @@ data FavOrTrash = IsFav | IsTrash
   deriving (Eq)
 
 
-moreLike :: CorpusId   -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
+moreLike :: HasDBid NodeType
+         => CorpusId   -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
          -> FavOrTrash -> Cmd err [FacetDoc]
 moreLike cId o _l order ft = do
   priors <- getPriors ft cId
   moreLikeWith cId o (Just 3) order ft priors
 
 ---------------------------------------------------------------------------
-getPriors :: FavOrTrash -> CorpusId -> Cmd err (Events Bool)
+getPriors :: HasDBid NodeType => FavOrTrash -> CorpusId -> Cmd err (Events Bool)
 getPriors ft cId = do
 
   docs_fav   <- filter (\(FacetDoc _ _ _ _ f _ _) -> f == Just 2)
@@ -54,7 +56,8 @@ getPriors ft cId = do
   pure priors
 
 
-moreLikeWith :: CorpusId   -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
+moreLikeWith :: HasDBid NodeType
+             => CorpusId   -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
              -> FavOrTrash -> Events Bool  -> Cmd err [FacetDoc]
 moreLikeWith cId o l order ft priors = do
 

src/Gargantext/Database/Action/Node.hs

@@ -20,6 +20,7 @@ Portability : POSIX
 module Gargantext.Database.Action.Node
   where
 
+import Gargantext.Core
 import Gargantext.Core.Types (Name)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Hyperdata.Default
@@ -35,7 +36,7 @@ import Gargantext.Prelude.Config (GargConfig(..))
 
 ------------------------------------------------------------------------
 -- | TODO mk all others nodes
-mkNodeWithParent :: (HasNodeError err)
+mkNodeWithParent :: (HasNodeError err, HasDBid NodeType)
                  => NodeType
                  -> Maybe ParentId
                  -> UserId
@@ -66,7 +67,7 @@ mkNodeWithParent nt (Just pId) uId name  = insertNode nt (Just name) Nothing pId
 
 
 -- | Sugar to create a node, get its NodeId and update its Hyperdata after
-mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err)
+mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err, HasDBid NodeType)
                                     => NodeType
                                     -> Maybe ParentId
                                     -> UserId
@@ -85,7 +86,7 @@ mkNodeWithParent_ConfigureHyperdata    _ _ _ _ = nodeError NotImplYet
 
 
 -- | Function not exposed
-mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err)
+mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType)
                                     => NodeType
                                     -> Maybe ParentId
                                     -> UserId

src/Gargantext/Database/Action/Search.hs

@@ -24,7 +24,6 @@ import Database.PostgreSQL.Simple (Query)
 import Database.PostgreSQL.Simple.ToField
 import Gargantext.Core
 import Gargantext.Core.Types
-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
@@ -40,9 +39,10 @@ import Data.Profunctor.Product (p4)
 import qualified Opaleye as O hiding (Order)
 
 ------------------------------------------------------------------------
-searchDocInDatabase :: ParentId
-                 -> Text
-                 -> Cmd err [(NodeId, HyperdataDocument)]
+searchDocInDatabase :: HasDBid NodeType
+                    => ParentId
+                    -> Text
+                    -> Cmd err [(NodeId, HyperdataDocument)]
 searchDocInDatabase p t = runOpaQuery (queryDocInDatabase p t)
   where
     -- | Global search query where ParentId is Master Node Corpus Id 
@@ -55,7 +55,8 @@ searchDocInDatabase p t = runOpaQuery (queryDocInDatabase p t)
 
 ------------------------------------------------------------------------
 -- | todo add limit and offset and order
-searchInCorpus :: CorpusId
+searchInCorpus :: HasDBid NodeType
+               => CorpusId
                -> IsTrash
                -> [Text]
                -> Maybe Offset
@@ -68,7 +69,8 @@ searchInCorpus cId t q o l order = runOpaQuery
                                  $ intercalate " | "
                                  $ map stemIt q
 
-searchCountInCorpus :: CorpusId
+searchCountInCorpus :: HasDBid NodeType
+                    => CorpusId
                     -> IsTrash
                     -> [Text]
                     -> Cmd err Int
@@ -77,7 +79,8 @@ searchCountInCorpus cId t q = runCountOpaQuery
                             $ intercalate " | "
                             $ map stemIt q
 
-queryInCorpus :: CorpusId
+queryInCorpus :: HasDBid NodeType
+              => CorpusId
               -> IsTrash
               -> Text
               -> O.Query FacetDocRead
@@ -105,7 +108,8 @@ joinInCorpus = leftJoin queryNodeSearchTable queryNodeNodeTable cond
 
 ------------------------------------------------------------------------
 searchInCorpusWithContacts
-  :: CorpusId
+  :: HasDBid NodeType
+  => CorpusId
   -> AnnuaireId
   -> [Text]
   -> Maybe Offset
@@ -121,7 +125,8 @@ searchInCorpusWithContacts cId aId q o l _order =
               $ map stemIt q
 
 selectContactViaDoc
-  :: CorpusId
+  :: HasDBid NodeType
+  => CorpusId
   -> AnnuaireId
   -> Text
   -> QueryArr ()
@@ -143,10 +148,11 @@ selectContactViaDoc cId aId q = proc () -> do
               , toNullable $ pgInt4 1
               )
 
-selectGroup :: NodeId
-      -> NodeId
-      -> Text
-     -> Select FacetPairedReadNull
+selectGroup :: HasDBid NodeType
+            => NodeId
+            -> NodeId
+            -> Text
+            -> Select FacetPairedReadNull
 selectGroup cId aId q = proc () -> do
   (a, b, c, d) <- aggregate (p4 (groupBy, groupBy, groupBy, O.sum))
                             (selectContactViaDoc cId aId q) -< ()
@@ -261,7 +267,8 @@ textSearchQuery = "SELECT n.id, n.hyperdata->'publication_year'     \
 -- Example:
 -- textSearchTest :: ParentId -> TSQuery -> Cmd err [(Int, Value, Value, Value, Value, Maybe Int)]
 -- textSearchTest pId q = textSearch q pId 5 0 Asc
-textSearch :: TSQuery -> ParentId
+textSearch :: HasDBid NodeType
+           => TSQuery -> ParentId
            -> Limit -> Offset -> Order
            -> Cmd err [(Int,Value,Value,Value, Value, Maybe Int)]
 textSearch q p l o ord = runPGSQuery textSearchQuery (q,p,p,typeId,ord,o,l)

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

@@ -42,7 +42,7 @@ import Test.QuickCheck.Instances.Time ()
 import Text.Read (read)
 
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
-import Gargantext.Database.Prelude (fromField')
+-- import Gargantext.Database.Prelude (fromField')
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude
 
@@ -324,17 +324,16 @@ instance Arbitrary NodeType where
 ------------------------------------------------------------------------
 -- Instances
 ------------------------------------------------------------------------
-
 instance ToSchema Status where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "status_")
 
 ------------------------------------------------------------------------
-
+{-
 instance FromField (NodeId, Text)
   where
     fromField = fromField'
+-}
 ------------------------------------------------------------------------
-
 instance QueryRunnerColumnDefault PGTSVector (Maybe TSVector)
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn

src/Gargantext/Database/Prelude.hs

@@ -13,12 +13,12 @@ Portability : POSIX
 
 module Gargantext.Database.Prelude where
 
+-- import Control.Monad.Error.Class -- (MonadError(..), Error)
 import Control.Exception
 import Control.Lens (Getter, view)
--- import Control.Monad.Error.Class -- (MonadError(..), Error)
 import Control.Monad.Except
-import Control.Monad.Reader
 import Control.Monad.Random
+import Control.Monad.Reader
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Data.Aeson (Result(Error,Success), fromJSON, FromJSON)
 import Data.ByteString.Char8 (hPutStrLn)
@@ -31,6 +31,8 @@ import Data.Word (Word16)
 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 Gargantext.Prelude.Config (GargConfig())
 import Opaleye (Query, Unpackspec, showSqlForPostgres, FromFields, Select, runQuery, PGJsonb, QueryRunnerColumnDefault)
 import Opaleye.Aggregate (countRows)
 import System.IO (FilePath)
@@ -40,9 +42,6 @@ import qualified Data.ByteString      as DB
 import qualified Data.List as DL
 import qualified Database.PostgreSQL.Simple as PGS
 
-import Gargantext.Prelude
-import Gargantext.Prelude.Config (GargConfig())
-
 -------------------------------------------------------
 class HasConnectionPool env where
   connPool :: Getter env (Pool Connection)

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

@@ -59,7 +59,8 @@ runGetNodes = runOpaQuery
 ------------------------------------------------------------------------
 -- | order by publication date
 -- Favorites (Bool), node_ngrams
-selectNodesWith :: ParentId     -> Maybe NodeType
+selectNodesWith :: HasDBid NodeType
+                => ParentId     -> Maybe NodeType
                 -> Maybe Offset -> Maybe Limit   -> Query NodeRead
 selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
         --offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
@@ -67,7 +68,8 @@ selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
                     $ orderBy (asc _node_id)
                     $ selectNodesWith' parentId maybeNodeType
 
-selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
+selectNodesWith' :: HasDBid NodeType
+                 => ParentId -> Maybe NodeType -> Query NodeRead
 selectNodesWith' parentId maybeNodeType = proc () -> do
     node' <- (proc () -> do
       row@(Node _ _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
@@ -92,7 +94,7 @@ deleteNodes ns = mkCmd $ \conn ->
                    (\(Node n_id _ _ _ _ _ _ _) -> in_ ((map pgNodeId ns)) n_id)
 
 -- TODO: NodeType should match with `a'
-getNodesWith :: JSONB a => NodeId -> proxy a -> Maybe NodeType
+getNodesWith :: (JSONB a, HasDBid NodeType) => NodeId -> proxy a -> Maybe NodeType
              -> Maybe Offset -> Maybe Limit -> Cmd err [Node a]
 getNodesWith parentId _ nodeType maybeOffset maybeLimit =
     runOpaQuery $ selectNodesWith parentId nodeType maybeOffset maybeLimit
@@ -112,7 +114,8 @@ getNodesWithParentId n = runOpaQuery $ selectNodesWithParentID n'
 -- | Given a node id, find it's closest parent of given type
 -- NOTE: This isn't too optimal: can make successive queries depending on how
 -- deeply nested the child is.
-getClosestParentIdByType :: NodeId
+getClosestParentIdByType :: HasDBid NodeType
+                         => NodeId
                          -> NodeType
                          -> Cmd err (Maybe NodeId)
 getClosestParentIdByType nId nType = do
@@ -134,17 +137,17 @@ getClosestParentIdByType nId nType = do
     |]
 
 ------------------------------------------------------------------------
-getDocumentsV3WithParentId :: NodeId -> Cmd err [Node HyperdataDocumentV3]
+getDocumentsV3WithParentId :: HasDBid NodeType => NodeId -> Cmd err [Node HyperdataDocumentV3]
 getDocumentsV3WithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocument)
 
 -- TODO: merge with getDocumentsWithParentId by having a class IsHyperdataDocument
-getDocumentsWithParentId :: NodeId -> Cmd err [Node HyperdataDocument]
+getDocumentsWithParentId :: HasDBid NodeType => NodeId -> Cmd err [Node HyperdataDocument]
 getDocumentsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocument)
 
-getListsModelWithParentId :: NodeId -> Cmd err [Node HyperdataModel]
+getListsModelWithParentId :: HasDBid NodeType => NodeId -> Cmd err [Node HyperdataModel]
 getListsModelWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeModel)
 
-getCorporaWithParentId :: NodeId -> Cmd err [Node HyperdataCorpus]
+getCorporaWithParentId :: HasDBid NodeType => NodeId -> Cmd err [Node HyperdataCorpus]
 getCorporaWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeCorpus)
 
 ------------------------------------------------------------------------
@@ -158,21 +161,23 @@ selectNodesWithParentID n = proc () -> do
 ------------------------------------------------------------------------
 -- | Example of use:
 -- runCmdReplEasy  (getNodesWithType NodeList (Proxy :: Proxy HyperdataList))
-getNodesWithType :: (HasNodeError err, JSONB a) => NodeType -> proxy a -> Cmd err [Node a]
+getNodesWithType :: (HasNodeError err, JSONB a, HasDBid NodeType) => NodeType -> proxy a -> Cmd err [Node a]
 getNodesWithType nt _ = runOpaQuery $ selectNodesWithType nt
   where
-    selectNodesWithType :: NodeType -> Query NodeRead
+    selectNodesWithType ::  HasDBid NodeType
+                         => NodeType -> Query NodeRead
     selectNodesWithType nt' = proc () -> do
         row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
         restrict -< tn .== (pgInt4 $ hasDBid nt')
         returnA -< row
 
-getNodesIdWithType :: HasNodeError err => NodeType -> Cmd err [NodeId]
+getNodesIdWithType :: (HasNodeError err, HasDBid NodeType) => NodeType -> Cmd err [NodeId]
 getNodesIdWithType nt = do
   ns <- runOpaQuery $ selectNodesIdWithType nt
   pure (map NodeId ns)
 
-selectNodesIdWithType :: NodeType -> Query (Column PGInt4)
+selectNodesIdWithType :: HasDBid NodeType
+                      => NodeType -> Query (Column PGInt4)
 selectNodesIdWithType nt = proc () -> do
     row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
     restrict -< tn .== (pgInt4 $ hasDBid nt)
@@ -199,20 +204,23 @@ getNodeWith nId _ = do
 
 ------------------------------------------------------------------------
 -- | Sugar to insert Node with NodeType in Database
-insertDefaultNode :: NodeType -> ParentId -> UserId -> Cmd err [NodeId]
+insertDefaultNode :: HasDBid NodeType
+                  => NodeType -> ParentId -> UserId -> Cmd err [NodeId]
 insertDefaultNode nt p u = insertNode nt Nothing Nothing p u
 
-insertNode :: NodeType -> Maybe Name -> Maybe DefaultHyperdata -> ParentId -> UserId -> Cmd err [NodeId]
+insertNode :: HasDBid NodeType
+           => NodeType -> Maybe Name -> Maybe DefaultHyperdata -> ParentId -> UserId -> Cmd err [NodeId]
 insertNode nt n h p u = insertNodesR [nodeW nt n h p u]
 
-nodeW :: NodeType -> Maybe Name -> Maybe DefaultHyperdata -> ParentId -> UserId -> NodeWrite
+nodeW ::  HasDBid NodeType
+       => NodeType -> Maybe Name -> Maybe DefaultHyperdata -> ParentId -> UserId -> NodeWrite
 nodeW nt n h p u = node nt n' h' (Just p) u
   where
     n' = fromMaybe (defaultName nt) n
     h' = maybe     (defaultHyperdata nt) identity h
 
 ------------------------------------------------------------------------
-node :: (ToJSON a, Hyperdata a)
+node :: (ToJSON a, Hyperdata a, HasDBid NodeType)
      => NodeType
      -> Name
      -> a
@@ -265,7 +273,8 @@ insertNodesWithParentR pid ns = insertNodesR (set node_parentId (pgNodeId <$> pi
 -- currently this function removes the child relation
 -- needs a Temporary type between Node' and NodeWriteT
 
-node2table :: UserId -> Maybe ParentId -> Node' -> NodeWrite
+node2table :: HasDBid NodeType
+           => UserId -> Maybe ParentId -> Node' -> NodeWrite
 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"
 
@@ -284,7 +293,8 @@ mkNodeR :: [NodeWrite] -> Cmd err [NodeId]
 mkNodeR ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns (rReturning _node_id) Nothing
 
 ------------------------------------------------------------------------
-childWith :: UserId -> ParentId -> Node' -> NodeWrite
+childWith ::  HasDBid NodeType
+           => UserId -> ParentId -> Node' -> NodeWrite
 childWith uId pId (Node' NodeDocument txt v []) = node2table uId (Just pId) (Node' NodeDocument txt v [])
 childWith uId pId (Node' NodeContact  txt v []) = node2table uId (Just pId) (Node' NodeContact txt v [])
 childWith _   _   (Node' _        _   _ _) = panic "This NodeType can not be a child"
@@ -298,7 +308,7 @@ data CorpusType = CorpusDocument | CorpusContact
 
 class MkCorpus a
   where
-    mk :: Maybe Name -> Maybe a -> ParentId -> UserId -> Cmd err [NodeId]
+    mk :: HasDBid NodeType => Maybe Name -> Maybe a -> ParentId -> UserId -> Cmd err [NodeId]
 
 instance MkCorpus HyperdataCorpus
   where
@@ -312,7 +322,7 @@ instance MkCorpus HyperdataAnnuaire
     mk n (Just h) p u = insertNode NodeAnnuaire n (Just $ DefaultAnnuaire h) p u
 
 
-getOrMkList :: HasNodeError err
+getOrMkList :: (HasNodeError err, HasDBid NodeType)
             => ParentId
             -> UserId
             -> Cmd err ListId
@@ -322,11 +332,11 @@ getOrMkList pId uId =
       mkList' pId' uId' = maybe (nodeError MkNode) pure . headMay =<< insertDefaultNode NodeList pId' uId'
 
 -- | TODO remove defaultList
-defaultList :: HasNodeError err => CorpusId -> Cmd err ListId
+defaultList :: (HasNodeError err, HasDBid NodeType) => CorpusId -> Cmd err ListId
 defaultList cId =
   maybe (nodeError NoListFound) (pure . view node_id) . headMay =<< getListsWithParentId cId
 
 
-getListsWithParentId :: NodeId -> Cmd err [Node HyperdataList]
+getListsWithParentId :: HasDBid NodeType => NodeId -> Cmd err [Node HyperdataList]
 getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)
 

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

@@ -17,6 +17,7 @@ module Gargantext.Database.Query.Table.Node.UpdateOpaleye
 
 import Opaleye
 import Data.Aeson (encode, ToJSON)
+import Gargantext.Core
 import Gargantext.Prelude
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Admin.Types.Node
@@ -42,6 +43,7 @@ updateHyperdataQuery i h = Update
 updateNodesWithType :: ( HasNodeError err
                        , JSONB a
                        , ToJSON a
+                       , HasDBid NodeType
                        ) => NodeType -> proxy a -> (a -> a) -> Cmd err [Int64]
 updateNodesWithType nt p f = do
   ns <- getNodesWithType nt p
@@ -50,9 +52,10 @@ updateNodesWithType nt p f = do
 
 -- | In case the Hyperdata Types are not compatible
 updateNodesWithType_ :: ( HasNodeError err
-                       , JSONB a
-                       , ToJSON a
-                       ) => NodeType -> a -> Cmd err [Int64]
+                        , JSONB a
+                        , ToJSON a
+                        , HasDBid NodeType
+                        ) => NodeType -> a -> Cmd err [Int64]
 updateNodesWithType_ nt h = do
   ns <- getNodesIdWithType nt
   mapM (\n -> updateHyperdata n h) ns

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

@@ -13,6 +13,7 @@ module Gargantext.Database.Query.Table.Node.User
   where
 
 import Data.Maybe (fromMaybe)
+import Gargantext.Core
 import Gargantext.Core.Types (Name)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..), defaultHyperdataUser)
 import Gargantext.Database.Admin.Types.Node (Node, NodeId(..), UserId, NodeType(..), pgNodeId)
@@ -28,7 +29,7 @@ getNodeUser nId = do
     fromMaybe (panic $ "Node does not exist: " <> (cs $ show nId)) . headMay
              <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
 
-nodeUserW :: Maybe Name -> Maybe HyperdataUser -> UserId -> NodeWrite
+nodeUserW :: HasDBid NodeType => Maybe Name -> Maybe HyperdataUser -> UserId -> NodeWrite
 nodeUserW maybeName maybeHyperdata = node NodeUser name user Nothing
   where
     name = maybe "User" identity maybeName