Commit ac9731c7 authored by Grégoire Locqueville's avatar Grégoire Locqueville

Renamed `DBCmd'` -> `DBCmdWithEnv`

parent e17737f3
...@@ -29,8 +29,7 @@ import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMkRootWithCorpus) ...@@ -29,8 +29,7 @@ import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMkRootWithCorpus)
import Gargantext.Database.Admin.Trigger.Init (initFirstTriggers, initLastTriggers) import Gargantext.Database.Admin.Trigger.Init (initFirstTriggers, initLastTriggers)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus) import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (DBCmd') import Gargantext.Database.Prelude (DBCmd, DBCmdWithEnv)
import Gargantext.Database.Prelude (DBCmd)
import Gargantext.Database.Query.Table.Node (getOrMkList) import Gargantext.Database.Query.Table.Node (getOrMkList)
import Gargantext.Database.Query.Table.User (insertNewUsers, ) import Gargantext.Database.Query.Table.User (insertNewUsers, )
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserMaster)) import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserMaster))
...@@ -49,18 +48,18 @@ initCLI (InitArgs settingsPath) = do ...@@ -49,18 +48,18 @@ initCLI (InitArgs settingsPath) = do
cfg <- readConfig settingsPath cfg <- readConfig settingsPath
let secret = _s_secret_key $ _gc_secrets cfg let secret = _s_secret_key $ _gc_secrets cfg
let createUsers :: forall env. DBCmd' env BackendInternalError Int64 let createUsers :: forall env. DBCmdWithEnv env BackendInternalError Int64
createUsers = insertNewUsers (NewUser "gargantua" (cs email) (GargPassword $ cs password) createUsers = insertNewUsers (NewUser "gargantua" (cs email) (GargPassword $ cs password)
NE.:| arbitraryNewUsers NE.:| arbitraryNewUsers
) )
let let
mkRoots :: forall env. DBCmd' env BackendInternalError [(UserId, RootId)] mkRoots :: forall env. DBCmdWithEnv env BackendInternalError [(UserId, RootId)]
mkRoots = mapM getOrMkRoot $ map UserName ("gargantua" : arbitraryUsername) mkRoots = mapM getOrMkRoot $ map UserName ("gargantua" : arbitraryUsername)
-- TODO create all users roots -- TODO create all users roots
let let
initMaster :: forall env. DBCmd' env BackendInternalError (UserId, RootId, CorpusId, ListId) initMaster :: forall env. DBCmdWithEnv env BackendInternalError (UserId, RootId, CorpusId, ListId)
initMaster = do initMaster = do
(masterUserId, masterRootId, masterCorpusId) (masterUserId, masterRootId, masterCorpusId)
<- getOrMkRootWithCorpus MkCorpusUserMaster <- getOrMkRootWithCorpus MkCorpusUserMaster
......
...@@ -31,7 +31,7 @@ import Gargantext.Core.NLP (HasNLPServer) ...@@ -31,7 +31,7 @@ import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.Worker.Jobs.Types qualified as Jobs import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
import Gargantext.Database.Action.Node (mkNodeWithParent) import Gargantext.Database.Action.Node (mkNodeWithParent)
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (IsDBCmdExtra, DBCmd') import Gargantext.Database.Prelude (IsDBCmdExtra, DBCmdWithEnv)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..)) import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Prelude import Gargantext.Prelude
import Servant.Server.Generic (AsServerT) import Servant.Server.Generic (AsServerT)
...@@ -47,7 +47,7 @@ postNode :: ( HasMail env ...@@ -47,7 +47,7 @@ postNode :: ( HasMail env
-> NodeId -> NodeId
-> PostNode -> PostNode
-- -> m [NodeId] -- -> m [NodeId]
-> DBCmd' env err [NodeId] -> DBCmdWithEnv env err [NodeId]
postNode authenticatedUser nId pn = do postNode authenticatedUser nId pn = do
postNode' authenticatedUser nId pn postNode' authenticatedUser nId pn
......
...@@ -19,7 +19,7 @@ import Gargantext.Database.Action.Search (searchInCorpus) ...@@ -19,7 +19,7 @@ import Gargantext.Database.Action.Search (searchInCorpus)
import Gargantext.Database.Action.User (getUserId) import Gargantext.Database.Action.User (getUserId)
import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus, hc_lang) import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus, hc_lang)
import Gargantext.Database.Admin.Types.Node (CorpusId, NodeId(UnsafeMkNodeId), NodeType(..), nodeId2ContextId) import Gargantext.Database.Admin.Types.Node (CorpusId, NodeId(UnsafeMkNodeId), NodeType(..), nodeId2ContextId)
import Gargantext.Database.Prelude (DBCmd') import Gargantext.Database.Prelude (DBCmdWithEnv)
import Gargantext.Database.Query.Facet.Types (facetDoc_id) import Gargantext.Database.Query.Facet.Types (facetDoc_id)
import Gargantext.Database.Query.Table.Node (insertDefaultNode, copyNodeStories, defaultList, getNodeWithType) import Gargantext.Database.Query.Table.Node (insertDefaultNode, copyNodeStories, defaultList, getNodeWithType)
import Gargantext.Database.Query.Table.Node.Document.Add qualified as Document (add) import Gargantext.Database.Query.Table.Node.Document.Add qualified as Document (add)
...@@ -55,7 +55,7 @@ makeSubcorpusFromQuery :: ( HasNodeStoryEnv env ...@@ -55,7 +55,7 @@ makeSubcorpusFromQuery :: ( HasNodeStoryEnv env
-> CorpusId -- ^ ID of the parent corpus -> CorpusId -- ^ ID of the parent corpus
-> Q.Query -- ^ The query to determine the subset of documents that will appear in the subcorpus -> Q.Query -- ^ The query to determine the subset of documents that will appear in the subcorpus
-> Bool -- ^ Whether to reuse parent term list (True) or compute a new one based only on the documents in the subcorpus (False) -> Bool -- ^ Whether to reuse parent term list (True) or compute a new one based only on the documents in the subcorpus (False)
-> DBCmd' env BackendInternalError CorpusId -- ^ The child corpus ID -> DBCmdWithEnv env BackendInternalError CorpusId -- ^ The child corpus ID
makeSubcorpusFromQuery user supercorpusId query reuseParentList = do makeSubcorpusFromQuery user supercorpusId query reuseParentList = do
userId <- getUserId user userId <- getUserId user
-- Insert the required nodes: -- Insert the required nodes:
......
...@@ -37,7 +37,7 @@ import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOn ...@@ -37,7 +37,7 @@ import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOn
import Gargantext.Database.Action.Node (mkNodeWithParent) import Gargantext.Database.Action.Node (mkNodeWithParent)
import Gargantext.Database.Admin.Config ( userMaster ) import Gargantext.Database.Admin.Config ( userMaster )
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (DBCmd, DBCmd') import Gargantext.Database.Prelude (DBCmd, DBCmdWithEnv)
import Gargantext.Database.Query.Table.Node ( getOrMkList, getNodeWith, defaultList, getClosestParentIdByType ) import Gargantext.Database.Query.Table.Node ( getOrMkList, getNodeWith, defaultList, getClosestParentIdByType )
import Gargantext.Database.Query.Table.Node.Error (HasNodeError) import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.Node.Select ( selectNodesWithUsername ) import Gargantext.Database.Query.Table.Node.Select ( selectNodesWithUsername )
...@@ -281,7 +281,7 @@ graphClone :: (HasNodeError err) ...@@ -281,7 +281,7 @@ graphClone :: (HasNodeError err)
=> UserId => UserId
-> NodeId -> NodeId
-> HyperdataGraphAPI -> HyperdataGraphAPI
-> DBCmd' env err NodeId -> DBCmdWithEnv env err NodeId
graphClone userId pId (HyperdataGraphAPI { _hyperdataAPIGraph = graph graphClone userId pId (HyperdataGraphAPI { _hyperdataAPIGraph = graph
, _hyperdataAPICamera = camera }) = do , _hyperdataAPICamera = camera }) = do
let nodeType = NodeGraph let nodeType = NodeGraph
......
...@@ -94,7 +94,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact ) ...@@ -94,7 +94,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact )
import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataAnnuaire, HyperdataCorpus(_hc_lang) ) import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataAnnuaire, HyperdataCorpus(_hc_lang) )
import Gargantext.Database.Admin.Types.Hyperdata.Document ( ToHyperdataDocument(toHyperdataDocument) ) import Gargantext.Database.Admin.Types.Hyperdata.Document ( ToHyperdataDocument(toHyperdataDocument) )
import Gargantext.Database.Admin.Types.Node hiding (DEBUG) -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId) import Gargantext.Database.Admin.Types.Node hiding (DEBUG) -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
import Gargantext.Database.Prelude (IsDBCmd, DBCmd') import Gargantext.Database.Prelude (IsDBCmd, DBCmdWithEnv)
import Gargantext.Database.Query.Table.ContextNodeNgrams2 ( ContextNodeNgrams2Poly(..), insertContextNodeNgrams2 ) import Gargantext.Database.Query.Table.ContextNodeNgrams2 ( ContextNodeNgrams2Poly(..), insertContextNodeNgrams2 )
import Gargantext.Database.Query.Table.Node ( MkCorpus, insertDefaultNodeIfNotExists, getOrMkList, getNodeWith ) import Gargantext.Database.Query.Table.Node ( MkCorpus, insertDefaultNodeIfNotExists, getOrMkList, getNodeWith )
import Gargantext.Database.Query.Table.Node.Document.Add qualified as Doc (add) import Gargantext.Database.Query.Table.Node.Document.Add qualified as Doc (add)
...@@ -136,7 +136,7 @@ getDataText :: (HasNodeError err) ...@@ -136,7 +136,7 @@ getDataText :: (HasNodeError err)
-> Maybe PUBMED.APIKey -> Maybe PUBMED.APIKey
-> Maybe EPO.AuthKey -> Maybe EPO.AuthKey
-> Maybe API.Limit -> Maybe API.Limit
-> DBCmd' env err (Either API.GetCorpusError DataText) -> DBCmdWithEnv env err (Either API.GetCorpusError DataText)
getDataText (ExternalOrigin api) la q mPubmedAPIKey mAuthKey li = do getDataText (ExternalOrigin api) la q mPubmedAPIKey mAuthKey li = do
cfg <- view hasConfig cfg <- view hasConfig
eRes <- liftBase $ API.get api (_tt_lang la) q mPubmedAPIKey mAuthKey (_ac_epo_api_url $ _gc_apis cfg) li eRes <- liftBase $ API.get api (_tt_lang la) q mPubmedAPIKey mAuthKey (_ac_epo_api_url $ _gc_apis cfg) li
...@@ -151,7 +151,7 @@ getDataText_Debug :: (HasNodeError err) ...@@ -151,7 +151,7 @@ getDataText_Debug :: (HasNodeError err)
-> TermType Lang -> TermType Lang
-> API.RawQuery -> API.RawQuery
-> Maybe API.Limit -> Maybe API.Limit
-> DBCmd' env err () -> DBCmdWithEnv env err ()
getDataText_Debug a l q li = do getDataText_Debug a l q li = do
result <- getDataText a l q Nothing Nothing li result <- getDataText a l q Nothing Nothing li
case result of case result of
......
...@@ -26,7 +26,7 @@ import Gargantext.Core.Types (Name) ...@@ -26,7 +26,7 @@ import Gargantext.Core.Types (Name)
import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Hyperdata.Default import Gargantext.Database.Admin.Types.Hyperdata.Default
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (DBCmd') import Gargantext.Database.Prelude (DBCmdWithEnv)
import Gargantext.Database.Query.Table.Node import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Error import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata) import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
...@@ -41,7 +41,7 @@ mkNodeWithParent :: (HasNodeError err, HasDBid NodeType) ...@@ -41,7 +41,7 @@ mkNodeWithParent :: (HasNodeError err, HasDBid NodeType)
-> Maybe ParentId -> Maybe ParentId
-> UserId -> UserId
-> Name -> Name
-> DBCmd' env err [NodeId] -> DBCmdWithEnv env err [NodeId]
mkNodeWithParent NodeUser (Just pId) uid _ = nodeError $ NodeCreationFailed $ UserParentAlreadyExists uid pId mkNodeWithParent NodeUser (Just pId) uid _ = nodeError $ NodeCreationFailed $ UserParentAlreadyExists uid pId
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -75,7 +75,7 @@ mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err, HasDBid NodeType) ...@@ -75,7 +75,7 @@ mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err, HasDBid NodeType)
-> Maybe ParentId -> Maybe ParentId
-> UserId -> UserId
-> Name -> Name
-> DBCmd' env err [NodeId] -> DBCmdWithEnv env err [NodeId]
mkNodeWithParent_ConfigureHyperdata Notes (Just i) uId name = mkNodeWithParent_ConfigureHyperdata Notes (Just i) uId name =
mkNodeWithParent_ConfigureHyperdata' Notes (Just i) uId name mkNodeWithParent_ConfigureHyperdata' Notes (Just i) uId name
...@@ -107,7 +107,7 @@ mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType) ...@@ -107,7 +107,7 @@ mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType)
-> Maybe ParentId -> Maybe ParentId
-> UserId -> UserId
-> Name -> Name
-> DBCmd' env err [NodeId] -> DBCmdWithEnv env err [NodeId]
mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
nodeId <- case nt of nodeId <- case nt of
Notes -> insertNode Notes (Just name) Nothing i uId Notes -> insertNode Notes (Just name) Nothing i uId
......
...@@ -34,7 +34,7 @@ import Gargantext.Core.Mail.Types (HasMail, mailSettings) ...@@ -34,7 +34,7 @@ import Gargantext.Core.Mail.Types (HasMail, mailSettings)
import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
import Gargantext.Database.Action.Flow (getOrMkRoot) import Gargantext.Database.Action.Flow (getOrMkRoot)
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd, DBCmd, IsDBCmdExtra, DBCmd') import Gargantext.Database.Prelude (Cmd, DBCmd, IsDBCmdExtra, DBCmdWithEnv)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..), nodeError, NodeError(..)) import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..), nodeError, NodeError(..))
import Gargantext.Database.Query.Table.User import Gargantext.Database.Query.Table.User
import Gargantext.Prelude import Gargantext.Prelude
...@@ -62,7 +62,7 @@ newUser emailAddress = do ...@@ -62,7 +62,7 @@ newUser emailAddress = do
-- use 'newUser' instead for standard Gargantext code. -- use 'newUser' instead for standard Gargantext code.
new_user :: (HasNodeError err) new_user :: (HasNodeError err)
=> NewUser GargPassword => NewUser GargPassword
-> DBCmd' env err UserId -> DBCmdWithEnv env err UserId
new_user rq = do new_user rq = do
(uid NE.:| _) <- new_users (rq NE.:| []) (uid NE.:| _) <- new_users (rq NE.:| [])
pure uid pure uid
...@@ -75,7 +75,7 @@ new_user rq = do ...@@ -75,7 +75,7 @@ new_user rq = do
new_users :: (HasNodeError err) new_users :: (HasNodeError err)
=> NonEmpty (NewUser GargPassword) => NonEmpty (NewUser GargPassword)
-- ^ A list of users to create. -- ^ A list of users to create.
-> DBCmd' env err (NonEmpty UserId) -> DBCmdWithEnv env err (NonEmpty UserId)
new_users us = do new_users us = do
us' <- liftBase $ mapM toUserHash us us' <- liftBase $ mapM toUserHash us
void $ insertUsers $ NE.map toUserWrite us' void $ insertUsers $ NE.map toUserWrite us'
...@@ -109,7 +109,7 @@ guessUserName n = case splitOn "@" n of ...@@ -109,7 +109,7 @@ guessUserName n = case splitOn "@" n of
------------------------------------------------------------------------ ------------------------------------------------------------------------
newUsers' :: (HasNodeError err) newUsers' :: (HasNodeError err)
=> MailConfig -> NonEmpty (NewUser GargPassword) -> DBCmd' env err (NonEmpty UserId) => MailConfig -> NonEmpty (NewUser GargPassword) -> DBCmdWithEnv env err (NonEmpty UserId)
newUsers' cfg us = do newUsers' cfg us = do
us' <- liftBase $ mapM toUserHash us us' <- liftBase $ mapM toUserHash us
void $ insertUsers $ NE.map toUserWrite us' void $ insertUsers $ NE.map toUserWrite us'
......
...@@ -93,12 +93,12 @@ type CmdRandom env err m = ...@@ -93,12 +93,12 @@ type CmdRandom env err m =
, HasMail env , HasMail env
) )
type Cmd'' env err a = forall m. CmdM'' env err m => m a type Cmd'' env err a = forall m. CmdM'' env err m => m a
type Cmd' env err a = forall m. IsCmd env err m => m a type Cmd' env err a = forall m. IsCmd env err m => m a
type Cmd err a = forall m env. IsDBCmdExtra env err m => m a type Cmd err a = forall m env. IsDBCmdExtra env err m => m a
type CmdR err a = forall m env. CmdRandom env err m => m a type CmdR err a = forall m env. CmdRandom env err m => m a
type DBCmd' env err a = forall m. IsDBCmd env err m => m a type DBCmdWithEnv env err a = forall m. IsDBCmd env err m => m a
type DBCmd err a = forall m env. IsDBCmd env err m => m a type DBCmd err a = forall m env. IsDBCmd env err m => m a
-- | Only the /minimum/ amount of class constraints required -- | Only the /minimum/ amount of class constraints required
-- to use the Gargantext Database. It's important, to ease testability, -- to use the Gargantext Database. It's important, to ease testability,
......
...@@ -22,7 +22,7 @@ import Gargantext.Database.Action.User (getUserId, getUsername) ...@@ -22,7 +22,7 @@ import Gargantext.Database.Action.User (getUserId, getUsername)
import Gargantext.Database.Admin.Config ( corpusMasterName, userMaster ) import Gargantext.Database.Admin.Config ( corpusMasterName, userMaster )
import Gargantext.Database.Admin.Types.Hyperdata.User ( HyperdataUser ) import Gargantext.Database.Admin.Types.Hyperdata.User ( HyperdataUser )
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (runOpaQuery, DBCmd, DBCmd') import Gargantext.Database.Prelude (runOpaQuery, DBCmd, DBCmdWithEnv)
import Gargantext.Database.Query.Table.Node import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Error import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Query.Table.User (queryUserTable, UserPoly(..)) import Gargantext.Database.Query.Table.User (queryUserTable, UserPoly(..))
...@@ -44,7 +44,7 @@ getRoot = runOpaQuery . selectRoot ...@@ -44,7 +44,7 @@ getRoot = runOpaQuery . selectRoot
getOrMkRoot :: (HasNodeError err) getOrMkRoot :: (HasNodeError err)
=> User => User
-> DBCmd' env err (UserId, RootId) -> DBCmdWithEnv env err (UserId, RootId)
getOrMkRoot user = do getOrMkRoot user = do
userId <- getUserId user userId <- getUserId user
...@@ -80,7 +80,7 @@ userFromMkCorpusUser (MkCorpusUserNormalCorpusName u _cname) = u ...@@ -80,7 +80,7 @@ userFromMkCorpusUser (MkCorpusUserNormalCorpusName u _cname) = u
getOrMkRootWithCorpus :: (HasNodeError err, MkCorpus a) getOrMkRootWithCorpus :: (HasNodeError err, MkCorpus a)
=> MkCorpusUser => MkCorpusUser
-> Maybe a -> Maybe a
-> DBCmd' env err (UserId, RootId, CorpusId) -> DBCmdWithEnv env err (UserId, RootId, CorpusId)
getOrMkRootWithCorpus MkCorpusUserMaster c = do getOrMkRootWithCorpus MkCorpusUserMaster c = do
(userId, rootId) <- getOrMkRoot (UserName userMaster) (userId, rootId) <- getOrMkRoot (UserName userMaster)
corpusId'' <- do corpusId'' <- do
...@@ -121,7 +121,7 @@ mkCorpus cName c rootId userId = do ...@@ -121,7 +121,7 @@ mkCorpus cName c rootId userId = do
mkRoot :: (HasNodeError err) mkRoot :: (HasNodeError err)
=> User => User
-> DBCmd' env err [RootId] -> DBCmdWithEnv env err [RootId]
mkRoot user = do mkRoot user = do
-- TODO -- TODO
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment