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

Removed `CmdRandom` and `CmdR`

Those definitions felt very ad hoc, and were not used a lot in the
codebase, so I simply replaced them with their definition.
parent ac9731c7
......@@ -16,16 +16,15 @@ module CLI.Invitations where
import CLI.Parsers
import CLI.Types
import Control.Monad.Random (MonadRandom)
import Gargantext.API.Dev (withDevEnv, runCmdDev)
import Gargantext.API.Errors.Types
import Gargantext.API.Node () -- instances only
import Gargantext.API.Node.Share qualified as Share
import Gargantext.API.Node.Share.Types qualified as Share
import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.Types
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Prelude (CmdRandom)
import Gargantext.Database.Prelude (IsDBCmdExtra)
import Gargantext.Prelude
import Options.Applicative
import Prelude (String)
......@@ -34,9 +33,8 @@ invitationsCLI :: InvitationsArgs -> IO ()
invitationsCLI (InvitationsArgs settingsPath user node_id email) = do
-- _cfg <- readConfig settingsPath
let invite :: ( CmdRandom env BackendInternalError m
, HasNLPServer env
, CET.HasCentralExchangeNotification env ) => m Int
let invite :: (IsDBCmdExtra env BackendInternalError m, MonadRandom m)
=> m Int
invite = Share.api (UserName $ cs user) node_id (Share.ShareTeamParams $ cs email)
withDevEnv settingsPath $ \env -> do
......
......@@ -675,6 +675,7 @@ executable gargantext
, haskell-bee
, ini ^>= 0.4.1
, lens >= 5.2.2 && < 5.3
, MonadRandom ^>= 0.6
, monad-logger ^>= 0.3.36
, optparse-applicative
, optparse-generic ^>= 1.4.7
......
......@@ -15,20 +15,19 @@ Portability : POSIX
module Gargantext.API.Node.Share
where
import Control.Monad.Random (MonadRandom)
import Data.List qualified as List
import Data.Text qualified as Text
import Gargantext.API.Node.Share.Types (ShareNodeParams(..))
import Gargantext.API.Prelude (IsGargServer)
import Gargantext.API.Routes.Named.Share qualified as Named
import Gargantext.Core.Notifications.CentralExchange.Types (HasCentralExchangeNotification)
import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.Types.Individu (User(..), arbitraryUsername)
import Gargantext.Database.Action.Share (ShareNodeWith(..))
import Gargantext.Database.Action.Share as DB (shareNodeWith, unshare)
import Gargantext.Database.Action.User (getUserId', getUsername)
import Gargantext.Database.Action.User.New (guessUserName, newUser)
import Gargantext.Database.Admin.Types.Node (NodeId, NodeType(..), UserId(..))
import Gargantext.Database.Prelude (CmdRandom)
import Gargantext.Database.Prelude (IsDBCmdExtra)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Query.Tree (findNodesWithType)
import Gargantext.Prelude
......@@ -38,10 +37,10 @@ import Servant.Server.Generic (AsServerT)
-- TODO permission
-- TODO refactor userId which is used twice
-- TODO change return type for better warning/info/success/error handling on the front
api :: ( HasNodeError err
, HasNLPServer env
, CmdRandom env err m
, HasCentralExchangeNotification env )
api :: ( HasNodeError err
, IsDBCmdExtra env err m
, MonadRandom m
)
=> User
-> NodeId
-> ShareNodeParams
......
......@@ -18,6 +18,7 @@ module Gargantext.API.Prelude
, serverError ) where
import Control.Lens ((#))
import Control.Monad.Random (MonadRandom)
import Gargantext.API.Admin.Auth.Types (AuthenticationError)
import Gargantext.API.Errors.Class (HasAuthenticationError, _AuthenticationError)
import Gargantext.API.Errors.Types (HasServerError(..), serverError)
......@@ -27,7 +28,7 @@ import Gargantext.Core.Mail.Types (HasMail)
import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.NodeStory (HasNodeStory, HasNodeStoryEnv)
import Gargantext.Core.Types (HasValidationError)
import Gargantext.Database.Prelude (IsDBCmdExtra, CmdRandom, HasConnectionPool)
import Gargantext.Database.Prelude (IsDBCmdExtra, HasConnectionPool)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Query.Tree (HasTreeError)
import Gargantext.Prelude
......@@ -58,8 +59,9 @@ type ErrC err =
)
type GargServerC env err m =
( CmdRandom env err m
, HasNodeStory env err m
( HasNodeStory env err m
, HasMail env
, MonadRandom m
, EnvC env
, ErrC err
, ToJSON err
......
......@@ -52,19 +52,6 @@ instance HasConnectionPool (Pool Connection) where
type JSONB = DefaultFromField SqlJsonb
-------------------------------------------------------
type CmdM'' env err m =
( MonadReader env m
, MonadError err m
, MonadBaseControl IO m
, MonadRandom m
)
type IsCmd env err m =
( MonadReader env m
, MonadError err m
, MonadBaseControl IO m
)
-- | If possible, try to not add more constraints here. When performing
-- a query/update on the DB, one shouldn't need more than being able to
-- fetch from the underlying 'env' the connection pool and access the
......@@ -81,32 +68,39 @@ type IsDBEnvExtra env =
, CET.HasCentralExchangeNotification env
)
type IsCmd env err m =
( MonadReader env m
, MonadError err m
, MonadBaseControl IO m
)
-- | Only the /minimum/ amount of class constraints required
-- to use the Gargantext Database. It's important, to ease testability,
-- that these constraints stays as few as possible.
type IsDBCmd env err m =
( IsCmd env err m
, IsDBEnv env
)
type IsDBCmdExtra env err m =
( IsCmd env err m
, IsDBEnvExtra env
)
type CmdRandom env err m =
( IsCmd env err m
, IsDBEnv env
, MonadRandom m
, HasMail env
type CmdM'' env err m =
( MonadReader env m
, MonadError err m
, MonadBaseControl IO m
, MonadRandom m
)
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 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 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
-- | Only the /minimum/ amount of class constraints required
-- to use the Gargantext Database. It's important, to ease testability,
-- that these constraints stays as few as possible.
type IsDBCmd env err m = (
IsCmd env err m
, IsDBEnv env
)
fromInt64ToInt :: Int64 -> Int
fromInt64ToInt = fromIntegral
......
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