[refactor] getOrMkRootWithCorpus with custom datatype
This was (User, Either CorpusName, [CorpusId]) before, but the case of UserMaster doesn't make sense with these parameters, so I rewrote the function to accept only correct datatypes as inputs.
Showing
| ... | ... | @@ -14,20 +14,19 @@ module Gargantext.Database.Query.Tree.Root |
| where | ||
| import Control.Arrow (returnA) | ||
| import Gargantext.Core | ||
| import Gargantext.Core (HasDBid(..)) | ||
| import Gargantext.Core.Types.Individu (User(..)) | ||
| import Gargantext.Core.Types.Main (CorpusName) | ||
| import Gargantext.Database.Action.Node | ||
| import Gargantext.Database.Action.Node ( mkNodeWithParent ) | ||
| import Gargantext.Database.Action.User (getUserId, getUsername) | ||
| import Gargantext.Database.Admin.Config | ||
| import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser) | ||
| import Gargantext.Database.Admin.Config ( corpusMasterName, userMaster ) | ||
| import Gargantext.Database.Admin.Types.Hyperdata.User ( HyperdataUser ) | ||
| import Gargantext.Database.Admin.Types.Node | ||
| import Gargantext.Database.Prelude (runOpaQuery, DBCmd) | ||
| import Gargantext.Database.Query.Table.Node | ||
| import Gargantext.Database.Query.Table.Node.Error | ||
| import Gargantext.Database.Query.Table.User (queryUserTable, UserPoly(..)) | ||
| import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead) | ||
| import Gargantext.Database.Schema.Node (queryNodeTable) | ||
| import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead, queryNodeTable) | ||
| import Gargantext.Prelude | ||
| import Opaleye (restrict, (.==), Select) | ||
| import Opaleye.SqlTypes (sqlStrictText, sqlInt4) | ||
| ... | ... | @@ -61,30 +60,62 @@ getOrMkRoot user = do |
| pure (userId, rootId) | ||
| getOrMk_RootWithCorpus :: (HasNodeError err, MkCorpus a) | ||
| => User | ||
| -> Either CorpusName [CorpusId] | ||
| -- | Datatype for the `getOrMkRootWithCorpus`. | ||
| -- There are only 3 possibilities: | ||
| -- - User is userMaster and then there is no corpus name | ||
| -- - User is a normal user and then we pass corpus name | ||
| -- - User is a normal user and then we pass corpus ids | ||
| data MkCorpusUser = | ||
| MkCorpusUserMaster | ||
| | MkCorpusUserNormalCorpusName User CorpusName | ||
| | MkCorpusUserNormalCorpusIds User [CorpusId] | ||
| deriving (Eq, Show) | ||
| userFromMkCorpusUser :: MkCorpusUser -> User | ||
| userFromMkCorpusUser MkCorpusUserMaster = UserName userMaster | ||
| userFromMkCorpusUser (MkCorpusUserNormalCorpusIds u _cids) = u | ||
| userFromMkCorpusUser (MkCorpusUserNormalCorpusName u _cname) = u | ||
| getOrMkRootWithCorpus :: (HasNodeError err, MkCorpus a) | ||
| => MkCorpusUser | ||
| -> Maybe a | ||
| -> DBCmd err (UserId, RootId, CorpusId) | ||
| getOrMk_RootWithCorpus user cName c = do | ||
|
||
| getOrMkRootWithCorpus MkCorpusUserMaster c = do | ||
| (userId, rootId) <- getOrMkRoot (UserName userMaster) | ||
| corpusId'' <- do | ||
| ns <- getCorporaWithParentId rootId | ||
| pure $ map _node_id ns | ||
| case corpusId'' of | ||
| [] -> mkCorpus corpusMasterName c rootId userId | ||
| cIds -> do | ||
| corpusId <- maybe (nodeError NoCorpusFound) pure (head cIds) | ||
| pure (userId, rootId, corpusId) | ||
| getOrMkRootWithCorpus (MkCorpusUserNormalCorpusName user cName) c = do | ||
| (userId, rootId) <- getOrMkRoot user | ||
| mkCorpus cName c rootId userId | ||
| getOrMkRootWithCorpus (MkCorpusUserNormalCorpusIds user []) c = do | ||
| getOrMkRootWithCorpus (MkCorpusUserNormalCorpusName user "Default") c | ||
| getOrMkRootWithCorpus (MkCorpusUserNormalCorpusIds user cIds) _c = do | ||
| (userId, rootId) <- getOrMkRoot user | ||
| corpusId'' <- if user == UserName userMaster | ||
| then do | ||
| ns <- getCorporaWithParentId rootId | ||
| pure $ map _node_id ns | ||
| else | ||
| pure $ fromRight [] cName | ||
| corpusId' <- if corpusId'' /= [] | ||
| then pure corpusId'' | ||
| else do | ||
| c' <- mk (Just $ fromLeft "Default" cName) c rootId userId | ||
| _tId <- case head c' of | ||
| Nothing -> errorWith "[G.D.Q.T.Root.getOrMk...] mk Corpus failed" | ||
| Just c'' -> insertDefaultNode NodeTexts c'' userId | ||
| pure c' | ||
| corpusId <- maybe (nodeError NoCorpusFound) pure (head corpusId') | ||
| corpusId <- maybe (nodeError NoCorpusFound) pure (head cIds) | ||
| pure (userId, rootId, corpusId) | ||
| -- | Helper function for `getOrMkRootWithCorpus`. | ||
| mkCorpus :: (HasNodeError err, MkCorpus a) | ||
| => CorpusName | ||
| -> Maybe a | ||
| -> RootId | ||
| -> UserId | ||
| -> DBCmd err (UserId, RootId, CorpusId) | ||
| mkCorpus cName c rootId userId = do | ||
| c' <- mk (Just cName) c rootId userId | ||
| _tId <- case head c' of | ||
| Nothing -> errorWith "[G.D.Q.T.Root.getOrMk...] mk Corpus failed" | ||
| Just c'' -> insertDefaultNode NodeTexts c'' userId | ||
| corpusId <- maybe (nodeError NoCorpusFound) pure (head c') | ||
| pure (userId, rootId, corpusId) | ||
| ... | ... | @@ -118,20 +149,20 @@ selectRoot :: User -> Select NodeRead |
| selectRoot (UserName username) = proc () -> do | ||
| row <- queryNodeTable -< () | ||
| users <- queryUserTable -< () | ||
| restrict -< _node_typename row .== (sqlInt4 $ toDBid NodeUser) | ||
| restrict -< user_username users .== (sqlStrictText username) | ||
| restrict -< _node_user_id row .== (user_id users) | ||
| restrict -< _node_typename row .== sqlInt4 (toDBid NodeUser) | ||
| restrict -< user_username users .== sqlStrictText username | ||
| restrict -< _node_user_id row .== user_id users | ||
| returnA -< row | ||
| selectRoot (UserDBId uid) = proc () -> do | ||
| row <- queryNodeTable -< () | ||
| restrict -< _node_typename row .== (sqlInt4 $ toDBid NodeUser) | ||
| restrict -< _node_user_id row .== (sqlInt4 $ _UserId uid) | ||
| restrict -< _node_typename row .== sqlInt4 (toDBid NodeUser) | ||
| restrict -< _node_user_id row .== sqlInt4 (_UserId uid) | ||
| returnA -< row | ||
| selectRoot (RootId nid) = | ||
| proc () -> do | ||
| row <- queryNodeTable -< () | ||
| restrict -< _node_typename row .== (sqlInt4 $ toDBid NodeUser) | ||
| restrict -< _node_id row .== (pgNodeId nid) | ||
| restrict -< _node_typename row .== sqlInt4 (toDBid NodeUser) | ||
| restrict -< _node_id row .== pgNodeId nid | ||
| returnA -< row | ||
