From 5897de6ca6c5b6055f7889cf3968953a7451f7c9 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Thu, 9 Apr 2020 16:08:23 +0200 Subject: [PATCH 01/16] [Flow] with userId own Tree : OK mergeable. --- bin/gargantext-import/Main.hs | 7 ++++--- bin/gargantext-init/Main.hs | 7 ++++--- package.yaml | 1 + src/Gargantext/API/Types.hs | 15 +++++++-------- src/Gargantext/Core/Types/Individu.hs | 1 - src/Gargantext/Database/Root.hs | 1 - src/Gargantext/Database/Schema/Node.hs | 12 +++++------- 7 files changed, 21 insertions(+), 23 deletions(-) diff --git a/bin/gargantext-import/Main.hs b/bin/gargantext-import/Main.hs index 84c67e5b..c4a49548 100644 --- a/bin/gargantext-import/Main.hs +++ b/bin/gargantext-import/Main.hs @@ -28,6 +28,7 @@ import Gargantext.Text.Corpus.Parsers (FileFormat(..)) import Gargantext.Database.Utils (Cmd, ) import Gargantext.Database.Types.Node (CorpusId, toHyperdataDocument) import Gargantext.Database.Schema.User (insertUsersDemo) +import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Text.Terms (TermType(..)) import Gargantext.Core (Lang(..)) import Gargantext.API.Types (GargError) @@ -52,13 +53,13 @@ main = do tt = (Multi EN) format = CsvGargV3 -- CsvHal --WOS corpus :: forall m. FlowCmdM DevEnv GargError m => m CorpusId - corpus = flowCorpusFile (cs user) (Left (cs name :: Text)) (read limit :: Int) tt format corpusPath + corpus = flowCorpusFile (UserName $ cs user) (Left (cs name :: Text)) (read limit :: Int) tt format corpusPath corpusCsvHal :: forall m. FlowCmdM DevEnv GargError m => m CorpusId - corpusCsvHal = flowCorpusFile (cs user) (Left (cs name :: Text)) (read limit :: Int) tt CsvHal corpusPath + corpusCsvHal = flowCorpusFile (UserName $ cs user) (Left (cs name :: Text)) (read limit :: Int) tt CsvHal corpusPath annuaire :: forall m. FlowCmdM DevEnv GargError m => m CorpusId - annuaire = flowAnnuaire (cs user) (Left "Annuaire") (Multi EN) corpusPath + annuaire = flowAnnuaire (UserName $ cs user) (Left "Annuaire") (Multi EN) corpusPath {- diff --git a/bin/gargantext-init/Main.hs b/bin/gargantext-init/Main.hs index 89448d37..1755bab2 100644 --- a/bin/gargantext-init/Main.hs +++ b/bin/gargantext-init/Main.hs @@ -23,11 +23,12 @@ import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import System.Environment (getArgs) import Gargantext.Prelude +import Gargantext.Core.Types.Individu (UserId, User(..)) import Gargantext.Database.Flow (getOrMkRoot, getOrMk_RootWithCorpus) import Gargantext.Database.Schema.Node (getOrMkList) import Gargantext.Database.Utils (Cmd, ) import Gargantext.Database.Types.Node (CorpusId, RootId, HyperdataCorpus, ListId) -import Gargantext.Database.Schema.User (insertUsersDemo, UserId) +import Gargantext.Database.Schema.User (insertUsersDemo) import Gargantext.API.Types (GargError) import Gargantext.API.Node () -- instances import Gargantext.API.Settings (withDevEnv, runCmdDev) @@ -42,13 +43,13 @@ main = do let mkRoots :: Cmd GargError [(UserId, RootId)] - mkRoots = mapM getOrMkRoot ["gargantua", "user1", "user2"] + mkRoots = mapM getOrMkRoot $ map UserName ["gargantua", "user1", "user2"] -- TODO create all users roots let initMaster :: Cmd GargError (UserId, RootId, CorpusId, ListId) initMaster = do - (masterUserId, masterRootId, masterCorpusId) <- getOrMk_RootWithCorpus userMaster (Left corpusMasterName) (Nothing :: Maybe HyperdataCorpus) + (masterUserId, masterRootId, masterCorpusId) <- getOrMk_RootWithCorpus (UserName userMaster) (Left corpusMasterName) (Nothing :: Maybe HyperdataCorpus) masterListId <- getOrMkList masterCorpusId masterUserId _triggers <- initTriggers masterListId pure (masterUserId, masterRootId, masterCorpusId, masterListId) diff --git a/package.yaml b/package.yaml index 68852014..516d5624 100644 --- a/package.yaml +++ b/package.yaml @@ -38,6 +38,7 @@ library: - Gargantext.API.Types - Gargantext.Core - Gargantext.Core.Types + - Gargantext.Core.Types.Individu - Gargantext.Core.Types.Main - Gargantext.Core.Utils.Prefix - Gargantext.Database diff --git a/src/Gargantext/API/Types.hs b/src/Gargantext/API/Types.hs index bd49bba7..98d28a3b 100644 --- a/src/Gargantext/API/Types.hs +++ b/src/Gargantext/API/Types.hs @@ -37,18 +37,17 @@ import Crypto.JOSE.Error as Jose import Data.Aeson.Types import Data.Typeable import Data.Validity -import Servant -import Servant.Job.Core (HasServerError(..), serverError) -import Servant.Job.Async (HasJobEnv) -import Gargantext.Prelude -import Gargantext.API.Settings -import Gargantext.API.Orchestrator.Types import Gargantext.API.Ngrams +import Gargantext.API.Orchestrator.Types +import Gargantext.API.Settings import Gargantext.Core.Types -import Gargantext.Database.Types.Errors (NodeError(..), HasNodeError(..)) import Gargantext.Database.Tree +import Gargantext.Database.Types.Errors (NodeError(..), HasNodeError(..)) import Gargantext.Database.Utils -import Gargantext.Database.Schema.Node +import Gargantext.Prelude +import Servant +import Servant.Job.Async (HasJobEnv) +import Servant.Job.Core (HasServerError(..), serverError) class HasJoseError e where _JoseError :: Prism' e Jose.Error diff --git a/src/Gargantext/Core/Types/Individu.hs b/src/Gargantext/Core/Types/Individu.hs index 0f40dbf0..fb249934 100644 --- a/src/Gargantext/Core/Types/Individu.hs +++ b/src/Gargantext/Core/Types/Individu.hs @@ -20,7 +20,6 @@ module Gargantext.Core.Types.Individu import Gargantext.Prelude hiding (reverse) import Data.Text (Text, pack, reverse) -import Gargantext.Database.Types.Node (NodeId) type UserId = Int diff --git a/src/Gargantext/Database/Root.hs b/src/Gargantext/Database/Root.hs index 274987d4..c537b409 100644 --- a/src/Gargantext/Database/Root.hs +++ b/src/Gargantext/Database/Root.hs @@ -31,7 +31,6 @@ import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Database.Config (nodeTypeId) import Gargantext.Database.Node.User (HyperdataUser) import Gargantext.Database.Schema.Node (NodeRead) -import Gargantext.Database.Schema.Node (pgNodeId) import Gargantext.Database.Schema.Node (queryNodeTable) import Gargantext.Database.Schema.User (queryUserTable, UserPoly(..)) import Gargantext.Database.Types.Node (Node, NodePoly(..), NodeType(NodeUser)) diff --git a/src/Gargantext/Database/Schema/Node.hs b/src/Gargantext/Database/Schema/Node.hs index 320b0ce2..bad1ab57 100644 --- a/src/Gargantext/Database/Schema/Node.hs +++ b/src/Gargantext/Database/Schema/Node.hs @@ -27,9 +27,8 @@ Portability : POSIX module Gargantext.Database.Schema.Node where import Control.Arrow (returnA) -import Control.Lens (Prism', set, view, (#), (^?)) +import Control.Lens (set, view) import Control.Lens.TH (makeLensesWith, abbreviatedFields) -import Control.Monad.Error.Class (MonadError(..)) import Data.Aeson import Data.Maybe (Maybe(..), fromMaybe) import Data.Profunctor.Product.TH (makeAdaptorAndInstance) @@ -37,18 +36,17 @@ import Data.Text (Text) import Database.PostgreSQL.Simple.FromField (FromField, fromField) import GHC.Int (Int64) import Gargantext.Core.Types -import Gargantext.Database.Types.Errors import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Database.Config (nodeTypeId) -import Gargantext.Database.Queries.Filter (limit', offset') -import Gargantext.Database.Types.Node (NodeType(..), defaultCorpus, Hyperdata, HyperData(..)) -import Gargantext.Database.Node.User (HyperdataUser(..), fake_HyperdataUser) import Gargantext.Database.Node.Contact (HyperdataContact(..), arbitraryHyperdataContact) +import Gargantext.Database.Node.User (HyperdataUser(..), fake_HyperdataUser) +import Gargantext.Database.Queries.Filter (limit', offset') import Gargantext.Database.Schema.User (getUserId) +import Gargantext.Database.Types.Errors +import Gargantext.Database.Types.Node (NodeType(..), defaultCorpus, Hyperdata, HyperData(..)) import Gargantext.Database.Utils import Gargantext.Prelude hiding (sum, head) import Gargantext.Viz.Graph (HyperdataGraph(..)) - import Opaleye hiding (FromField) import Opaleye.Internal.QueryArr (Query) import Prelude hiding (null, id, map, sum) -- 2.47.0 From b7355306fdc72c18427acc75fc685485bed4e006 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Fri, 10 Apr 2020 18:21:37 +0200 Subject: [PATCH 02/16] [WIP] Starting query Garg for a Hello Word. --- src/Gargantext/API.hs | 16 +++++----------- src/Gargantext/API/Corpus/New.hs | 16 ++++++++++++---- src/Gargantext/Core/Types/Individu.hs | 3 ++- src/Gargantext/Database/Flow.hs | 10 +++++----- src/Gargantext/Database/Schema/User.hs | 3 +++ 5 files changed, 27 insertions(+), 21 deletions(-) diff --git a/src/Gargantext/API.hs b/src/Gargantext/API.hs index 45240b41..0cf8e5e9 100644 --- a/src/Gargantext/API.hs +++ b/src/Gargantext/API.hs @@ -406,8 +406,8 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid)) -- TODO access -- :<|> addUpload -- :<|> (\corpus -> addWithQuery corpus :<|> addWithFile corpus) - :<|> addCorpusWithForm (UserDBId uid) -- "user1" - :<|> addCorpusWithQuery + :<|> addCorpusWithForm (UserDBId uid) + :<|> addCorpusWithQuery (RootId uid) :<|> addAnnuaireWithForm -- :<|> New.api uid -- TODO-SECURITY @@ -416,16 +416,10 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid)) :<|> waitAPI -{- -addUpload :: GargServer New.Upload -addUpload cId = (serveJobsAPI $ JobFunction (\i log -> New.addToCorpusJobFunction cid i (liftBase . log))) - :<|> (serveJobsAPI $ JobFunction (\i log -> New.addToCorpusWithForm cid i (liftBase . log))) ---} - -addCorpusWithQuery :: GargServer New.AddWithQuery -addCorpusWithQuery cid = +addCorpusWithQuery :: User -> GargServer New.AddWithQuery +addCorpusWithQuery user cid = serveJobsAPI $ - JobFunction (\i log -> New.addToCorpusJobFunction cid i (liftBase . log)) + JobFunction (\i log -> New.addToCorpusWithQuery user cid i (liftBase . log)) addWithFile :: GargServer New.AddWithFile addWithFile cid i f = diff --git a/src/Gargantext/API/Corpus/New.hs b/src/Gargantext/API/Corpus/New.hs index a5f2c685..219b8ec3 100644 --- a/src/Gargantext/API/Corpus/New.hs +++ b/src/Gargantext/API/Corpus/New.hs @@ -82,7 +82,7 @@ type Api = PostApi type PostApi = Summary "New Corpus endpoint" :> ReqBody '[JSON] Query - :> Post '[JSON] CorpusId + :> Post '[JSON] CorpusId type GetApi = Get '[JSON] ApiInfo -- | TODO manage several apis @@ -182,18 +182,26 @@ type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint" ------------------------------------------------------------------------ -- TODO WithQuery also has a corpus id -addToCorpusJobFunction :: FlowCmdM env err m - => CorpusId +addToCorpusWithQuery :: FlowCmdM env err m + => User + -> CorpusId -> WithQuery -> (ScraperStatus -> m ()) -> m ScraperStatus -addToCorpusJobFunction _cid (WithQuery _q _dbs _l) logStatus = do +addToCorpusWithQuery u cid (WithQuery q _dbs l) logStatus = do -- TODO ... logStatus ScraperStatus { _scst_succeeded = Just 10 , _scst_failed = Just 2 , _scst_remaining = Just 138 , _scst_events = Just [] } + printDebug "addToCorpusWithQuery" cid + -- TODO add cid + -- TODO if cid is folder -> create Corpus + -- if cid is corpus -> add to corpus + -- if cid is root -> create corpus in Private + cids <- flowCorpusSearchInDatabase u (maybe EN identity l) q + printDebug "corpus id" cids -- TODO ... pure ScraperStatus { _scst_succeeded = Just 137 , _scst_failed = Just 13 diff --git a/src/Gargantext/Core/Types/Individu.hs b/src/Gargantext/Core/Types/Individu.hs index fb249934..a27d08aa 100644 --- a/src/Gargantext/Core/Types/Individu.hs +++ b/src/Gargantext/Core/Types/Individu.hs @@ -20,10 +20,11 @@ module Gargantext.Core.Types.Individu import Gargantext.Prelude hiding (reverse) import Data.Text (Text, pack, reverse) +import Gargantext.Database.Types.Node (NodeId) type UserId = Int -data User = UserDBId UserId | UserName Text +data User = UserDBId UserId | UserName Text | RootId NodeId deriving (Eq) type Username = Text diff --git a/src/Gargantext/Database/Flow.hs b/src/Gargantext/Database/Flow.hs index bdd970cc..e26cacdf 100644 --- a/src/Gargantext/Database/Flow.hs +++ b/src/Gargantext/Database/Flow.hs @@ -213,9 +213,9 @@ flowCorpusUser :: (FlowCmdM env err m, MkCorpus c) -> Maybe c -> [NodeId] -> m CorpusId -flowCorpusUser l userName corpusName ctype ids = do +flowCorpusUser l user corpusName ctype ids = do -- User Flow - (userId, _rootId, userCorpusId) <- getOrMk_RootWithCorpus userName corpusName ctype + (userId, _rootId, userCorpusId) <- getOrMk_RootWithCorpus user corpusName ctype listId <- getOrMkList userCorpusId userId _cooc <- mkNode NodeListCooc listId userId -- TODO: check if present already, ignore @@ -337,9 +337,9 @@ getOrMk_RootWithCorpus :: (HasNodeError err, MkCorpus a) -> Either CorpusName [CorpusId] -> Maybe a -> Cmd err (UserId, RootId, CorpusId) -getOrMk_RootWithCorpus username cName c = do - (userId, rootId) <- getOrMkRoot username - corpusId'' <- if username == UserName userMaster +getOrMk_RootWithCorpus user cName c = do + (userId, rootId) <- getOrMkRoot user + corpusId'' <- if user == UserName userMaster then do ns <- getCorporaWithParentId rootId pure $ map _node_id ns diff --git a/src/Gargantext/Database/Schema/User.hs b/src/Gargantext/Database/Schema/User.hs index 7768e73e..02594de7 100644 --- a/src/Gargantext/Database/Schema/User.hs +++ b/src/Gargantext/Database/Schema/User.hs @@ -179,6 +179,9 @@ getUserId :: HasNodeError err => User -> Cmd err UserId getUserId (UserDBId uid) = pure uid +getUserId (RootId rid) = do + n <- getNode rid + pure $ _node_userId n getUserId (UserName u ) = do muser <- getUser u case muser of -- 2.47.0 From 942a2832324cfacec0af248b0f44db78d1e77139 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Sat, 11 Apr 2020 08:06:13 +0200 Subject: [PATCH 03/16] [WIP/DB] Refactoring (start). --- src/Gargantext/Database/{ => Action}/Flow.hs | 2 +- .../Database/{ => Action}/Flow/Annuaire.hs | 3 +- .../Database/{ => Action}/Flow/List.hs | 2 +- .../Database/{ => Action}/Flow/Pairing.hs | 2 +- .../Database/{ => Action}/Flow/Types.hs | 2 +- .../Database/{ => Action}/Flow/Utils.hs | 2 +- src/Gargantext/Database/{ => Action}/Learn.hs | 3 +- .../Database/{ => Action}/Metrics.hs | 2 +- .../Database/{ => Action/Metrics}/Lists.hs | 3 +- .../{ => Action}/Metrics/NgramsByNode.hs | 2 +- .../{TextSearch.hs => Action/Search.hs} | 4 +- src/Gargantext/Database/{ => Admin}/Access.hs | 3 +- src/Gargantext/Database/{ => Admin}/Bashql.hs | 2 +- src/Gargantext/Database/{ => Admin}/Config.hs | 2 +- .../Database/{ => Admin}/Schema/Ngrams.hs | 2 +- src/Gargantext/Database/Admin/Schema/Node.hs | 251 ++++++ .../Database/{ => Admin}/Schema/NodeNgrams.hs | 2 +- .../Database/{ => Admin}/Schema/NodeNode.hs | 4 +- .../{ => Admin}/Schema/NodeNodeNgrams.hs | 4 +- .../{ => Admin}/Schema/NodeNodeNgrams2.hs | 4 +- .../Schema/Node_NodeNgramsNodeNgrams.hs | 4 +- .../{ => Admin}/Schema/NodesNgramsRepo.hs | 3 +- .../Database/{ => Admin}/Schema/User.hs | 78 +- .../Database/{ => Admin/Trigger}/Init.hs | 2 +- .../Trigger}/NodeNodeNgrams.hs | 2 +- .../{Triggers => Admin/Trigger}/Nodes.hs | 4 +- .../{Triggers => Admin/Trigger}/NodesNodes.hs | 2 +- .../Database/{ => Admin}/Types/Node.hs | 2 +- src/Gargantext/Database/{ => Admin}/Utils.hs | 2 +- src/Gargantext/Database/{ => Query}/Facet.hs | 6 +- .../Database/{Queries => Query}/Filter.hs | 4 +- .../Database/{Queries => Query}/Join.hs | 4 +- src/Gargantext/Database/{ => Query}/Ngrams.hs | 10 +- .../Database/{ => Query}/Node/Children.hs | 16 +- .../Database/{ => Query}/Node/Contact.hs | 2 +- .../Database/{ => Query}/Node/Document/Add.hs | 5 +- .../{ => Query}/Node/Document/Insert.hs | 2 +- .../Database/{ => Query}/Node/Select.hs | 3 +- .../Database/{ => Query}/Node/Update.hs | 3 +- .../{ => Query}/Node/UpdateOpaleye.hs | 2 +- .../Database/{ => Query}/Node/User.hs | 32 +- src/Gargantext/Database/Root.hs | 65 -- src/Gargantext/Database/Schema/Node.hs | 750 ------------------ src/Gargantext/Database/Tree.hs | 157 ---- 44 files changed, 349 insertions(+), 1112 deletions(-) rename src/Gargantext/Database/{ => Action}/Flow.hs (99%) rename src/Gargantext/Database/{ => Action}/Flow/Annuaire.hs (94%) rename src/Gargantext/Database/{ => Action}/Flow/List.hs (99%) rename src/Gargantext/Database/{ => Action}/Flow/Pairing.hs (99%) rename src/Gargantext/Database/{ => Action}/Flow/Types.hs (97%) rename src/Gargantext/Database/{ => Action}/Flow/Utils.hs (98%) rename src/Gargantext/Database/{ => Action}/Learn.hs (98%) rename src/Gargantext/Database/{ => Action}/Metrics.hs (98%) rename src/Gargantext/Database/{ => Action/Metrics}/Lists.hs (97%) rename src/Gargantext/Database/{ => Action}/Metrics/NgramsByNode.hs (99%) rename src/Gargantext/Database/{TextSearch.hs => Action/Search.hs} (99%) rename src/Gargantext/Database/{ => Admin}/Access.hs (89%) rename src/Gargantext/Database/{ => Admin}/Bashql.hs (98%) rename src/Gargantext/Database/{ => Admin}/Config.hs (98%) rename src/Gargantext/Database/{ => Admin}/Schema/Ngrams.hs (99%) create mode 100644 src/Gargantext/Database/Admin/Schema/Node.hs rename src/Gargantext/Database/{ => Admin}/Schema/NodeNgrams.hs (99%) rename src/Gargantext/Database/{ => Admin}/Schema/NodeNode.hs (98%) rename src/Gargantext/Database/{ => Admin}/Schema/NodeNodeNgrams.hs (97%) rename src/Gargantext/Database/{ => Admin}/Schema/NodeNodeNgrams2.hs (96%) rename src/Gargantext/Database/{ => Admin}/Schema/Node_NodeNgramsNodeNgrams.hs (97%) rename src/Gargantext/Database/{ => Admin}/Schema/NodesNgramsRepo.hs (97%) rename src/Gargantext/Database/{ => Admin}/Schema/User.hs (67%) rename src/Gargantext/Database/{ => Admin/Trigger}/Init.hs (96%) rename src/Gargantext/Database/{Triggers => Admin/Trigger}/NodeNodeNgrams.hs (99%) rename src/Gargantext/Database/{Triggers => Admin/Trigger}/Nodes.hs (96%) rename src/Gargantext/Database/{Triggers => Admin/Trigger}/NodesNodes.hs (99%) rename src/Gargantext/Database/{ => Admin}/Types/Node.hs (99%) rename src/Gargantext/Database/{ => Admin}/Utils.hs (99%) rename src/Gargantext/Database/{ => Query}/Facet.hs (98%) rename src/Gargantext/Database/{Queries => Query}/Filter.hs (90%) rename src/Gargantext/Database/{Queries => Query}/Join.hs (99%) rename src/Gargantext/Database/{ => Query}/Ngrams.hs (84%) rename src/Gargantext/Database/{ => Query}/Node/Children.hs (85%) rename src/Gargantext/Database/{ => Query}/Node/Contact.hs (99%) rename src/Gargantext/Database/{ => Query}/Node/Document/Add.hs (98%) rename src/Gargantext/Database/{ => Query}/Node/Document/Insert.hs (99%) rename src/Gargantext/Database/{ => Query}/Node/Select.hs (95%) rename src/Gargantext/Database/{ => Query}/Node/Update.hs (95%) rename src/Gargantext/Database/{ => Query}/Node/UpdateOpaleye.hs (95%) rename src/Gargantext/Database/{ => Query}/Node/User.hs (79%) delete mode 100644 src/Gargantext/Database/Root.hs delete mode 100644 src/Gargantext/Database/Schema/Node.hs delete mode 100644 src/Gargantext/Database/Tree.hs diff --git a/src/Gargantext/Database/Flow.hs b/src/Gargantext/Database/Action/Flow.hs similarity index 99% rename from src/Gargantext/Database/Flow.hs rename to src/Gargantext/Database/Action/Flow.hs index e26cacdf..a6791b47 100644 --- a/src/Gargantext/Database/Flow.hs +++ b/src/Gargantext/Database/Action/Flow.hs @@ -27,7 +27,7 @@ Portability : POSIX {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -module Gargantext.Database.Flow -- (flowDatabase, ngrams2list) +module Gargantext.Database.Action.Flow -- (flowDatabase, ngrams2list) ( FlowCmdM , flowCorpusFile , flowCorpus diff --git a/src/Gargantext/Database/Flow/Annuaire.hs b/src/Gargantext/Database/Action/Flow/Annuaire.hs similarity index 94% rename from src/Gargantext/Database/Flow/Annuaire.hs rename to src/Gargantext/Database/Action/Flow/Annuaire.hs index 8ac94e5f..e58bc004 100644 --- a/src/Gargantext/Database/Flow/Annuaire.hs +++ b/src/Gargantext/Database/Action/Flow/Annuaire.hs @@ -16,11 +16,10 @@ Portability : POSIX {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-} -module Gargantext.Database.Flow.Annuaire +module Gargantext.Database.Action.Flow.Annuaire where - {- import Gargantext.Prelude import Gargantext.Database.Flow diff --git a/src/Gargantext/Database/Flow/List.hs b/src/Gargantext/Database/Action/Flow/List.hs similarity index 99% rename from src/Gargantext/Database/Flow/List.hs rename to src/Gargantext/Database/Action/Flow/List.hs index c84a3e79..7c78f361 100644 --- a/src/Gargantext/Database/Flow/List.hs +++ b/src/Gargantext/Database/Action/Flow/List.hs @@ -21,7 +21,7 @@ Portability : POSIX {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -module Gargantext.Database.Flow.List +module Gargantext.Database.Action.Flow.List where import Data.Text (Text) import Control.Monad (mapM_) diff --git a/src/Gargantext/Database/Flow/Pairing.hs b/src/Gargantext/Database/Action/Flow/Pairing.hs similarity index 99% rename from src/Gargantext/Database/Flow/Pairing.hs rename to src/Gargantext/Database/Action/Flow/Pairing.hs index 73609467..baec0b47 100644 --- a/src/Gargantext/Database/Flow/Pairing.hs +++ b/src/Gargantext/Database/Action/Flow/Pairing.hs @@ -16,7 +16,7 @@ Portability : POSIX {-# LANGUAGE RankNTypes #-} -- {-# LANGUAGE Arrows #-} -module Gargantext.Database.Flow.Pairing +module Gargantext.Database.Action.Flow.Pairing (pairing) where diff --git a/src/Gargantext/Database/Flow/Types.hs b/src/Gargantext/Database/Action/Flow/Types.hs similarity index 97% rename from src/Gargantext/Database/Flow/Types.hs rename to src/Gargantext/Database/Action/Flow/Types.hs index 77a3e9eb..014b5c57 100644 --- a/src/Gargantext/Database/Flow/Types.hs +++ b/src/Gargantext/Database/Action/Flow/Types.hs @@ -21,7 +21,7 @@ Portability : POSIX {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -module Gargantext.Database.Flow.Types +module Gargantext.Database.Action.Flow.Types where import Data.Map (Map) diff --git a/src/Gargantext/Database/Flow/Utils.hs b/src/Gargantext/Database/Action/Flow/Utils.hs similarity index 98% rename from src/Gargantext/Database/Flow/Utils.hs rename to src/Gargantext/Database/Action/Flow/Utils.hs index 83d5ca3a..afe90d14 100644 --- a/src/Gargantext/Database/Flow/Utils.hs +++ b/src/Gargantext/Database/Action/Flow/Utils.hs @@ -14,7 +14,7 @@ Portability : POSIX {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Flow.Utils +module Gargantext.Database.Action.Flow.Utils where import Data.Map (Map) diff --git a/src/Gargantext/Database/Learn.hs b/src/Gargantext/Database/Action/Learn.hs similarity index 98% rename from src/Gargantext/Database/Learn.hs rename to src/Gargantext/Database/Action/Learn.hs index d2ee54b2..9af66b62 100644 --- a/src/Gargantext/Database/Learn.hs +++ b/src/Gargantext/Database/Action/Learn.hs @@ -16,7 +16,8 @@ Portability : POSIX {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MonoLocalBinds #-} -module Gargantext.Database.Learn where +module Gargantext.Database.Action.Learn + where import Data.Text (Text) import Data.Tuple (snd) diff --git a/src/Gargantext/Database/Metrics.hs b/src/Gargantext/Database/Action/Metrics.hs similarity index 98% rename from src/Gargantext/Database/Metrics.hs rename to src/Gargantext/Database/Action/Metrics.hs index a8bc06e1..5771ed05 100644 --- a/src/Gargantext/Database/Metrics.hs +++ b/src/Gargantext/Database/Action/Metrics.hs @@ -15,7 +15,7 @@ Node API {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE FlexibleContexts #-} -module Gargantext.Database.Metrics +module Gargantext.Database.Action.Metrics where import Data.Map (Map) diff --git a/src/Gargantext/Database/Lists.hs b/src/Gargantext/Database/Action/Metrics/Lists.hs similarity index 97% rename from src/Gargantext/Database/Lists.hs rename to src/Gargantext/Database/Action/Metrics/Lists.hs index 36b3b56b..6d8fd06a 100644 --- a/src/Gargantext/Database/Lists.hs +++ b/src/Gargantext/Database/Action/Metrics/Lists.hs @@ -23,7 +23,8 @@ Portability : POSIX {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} -module Gargantext.Database.Lists where +module Gargantext.Database.Action.Metrics.Lists + where import Gargantext.API.Ngrams (TabType(..)) import Gargantext.Core.Types -- (NodePoly(..), NodeCorpus, ListId) diff --git a/src/Gargantext/Database/Metrics/NgramsByNode.hs b/src/Gargantext/Database/Action/Metrics/NgramsByNode.hs similarity index 99% rename from src/Gargantext/Database/Metrics/NgramsByNode.hs rename to src/Gargantext/Database/Action/Metrics/NgramsByNode.hs index 24df8612..78bbd524 100644 --- a/src/Gargantext/Database/Metrics/NgramsByNode.hs +++ b/src/Gargantext/Database/Action/Metrics/NgramsByNode.hs @@ -17,7 +17,7 @@ Ngrams by node enable contextual metrics. {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Metrics.NgramsByNode +module Gargantext.Database.Action.Metrics.NgramsByNode where import Debug.Trace (trace) diff --git a/src/Gargantext/Database/TextSearch.hs b/src/Gargantext/Database/Action/Search.hs similarity index 99% rename from src/Gargantext/Database/TextSearch.hs rename to src/Gargantext/Database/Action/Search.hs index 97ef4651..46f35d25 100644 --- a/src/Gargantext/Database/TextSearch.hs +++ b/src/Gargantext/Database/Action/Search.hs @@ -14,7 +14,7 @@ Portability : POSIX {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.TextSearch where +module Gargantext.Database.Action.Search where import Data.Aeson import Data.Map.Strict hiding (map, drop, take) @@ -35,7 +35,7 @@ import Gargantext.Database.Schema.Node import Gargantext.Database.Schema.Ngrams import Gargantext.Database.Schema.NodeNode hiding (joinInCorpus) import Gargantext.Database.Schema.NodeNodeNgrams -import Gargantext.Database.Queries.Join (leftJoin6) +import Gargantext.Database.Query.Join (leftJoin6) import Gargantext.Database.Utils (Cmd, runPGSQuery, runOpaQuery, runCountOpaQuery) import Gargantext.Text.Terms.Mono.Stem.En (stemIt) import Gargantext.Core.Types diff --git a/src/Gargantext/Database/Access.hs b/src/Gargantext/Database/Admin/Access.hs similarity index 89% rename from src/Gargantext/Database/Access.hs rename to src/Gargantext/Database/Admin/Access.hs index ee3b53db..254030a3 100644 --- a/src/Gargantext/Database/Access.hs +++ b/src/Gargantext/Database/Admin/Access.hs @@ -13,8 +13,7 @@ TODO-SECURITY review purpose of this module {-# LANGUAGE NoImplicitPrelude #-} - -module Gargantext.Database.Access where +module Gargantext.Database.Admin.Access where data Action = Read | Write | Exec data Roles = RoleUser | RoleMaster diff --git a/src/Gargantext/Database/Bashql.hs b/src/Gargantext/Database/Admin/Bashql.hs similarity index 98% rename from src/Gargantext/Database/Bashql.hs rename to src/Gargantext/Database/Admin/Bashql.hs index ecd13ae7..1bab0511 100644 --- a/src/Gargantext/Database/Bashql.hs +++ b/src/Gargantext/Database/Admin/Bashql.hs @@ -64,7 +64,7 @@ TODO-ACCESS: should the checks be done here or before. {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Bashql () {-( get +module Gargantext.Database.Admin.Bashql () {-( get , ls , home , post diff --git a/src/Gargantext/Database/Config.hs b/src/Gargantext/Database/Admin/Config.hs similarity index 98% rename from src/Gargantext/Database/Config.hs rename to src/Gargantext/Database/Admin/Config.hs index 39f0e0c8..48670c2b 100644 --- a/src/Gargantext/Database/Config.hs +++ b/src/Gargantext/Database/Admin/Config.hs @@ -16,7 +16,7 @@ TODO: configure nodes table in Haskell (Config typenames etc.) {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -module Gargantext.Database.Config +module Gargantext.Database.Admin.Config where diff --git a/src/Gargantext/Database/Schema/Ngrams.hs b/src/Gargantext/Database/Admin/Schema/Ngrams.hs similarity index 99% rename from src/Gargantext/Database/Schema/Ngrams.hs rename to src/Gargantext/Database/Admin/Schema/Ngrams.hs index 8ab13dfa..2617af4b 100644 --- a/src/Gargantext/Database/Schema/Ngrams.hs +++ b/src/Gargantext/Database/Admin/Schema/Ngrams.hs @@ -24,7 +24,7 @@ Ngrams connection to the Database. {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} -module Gargantext.Database.Schema.Ngrams where +module Gargantext.Database.Admin.Schema.Ngrams where import Control.Lens (makeLenses, over) import Control.Monad (mzero) diff --git a/src/Gargantext/Database/Admin/Schema/Node.hs b/src/Gargantext/Database/Admin/Schema/Node.hs new file mode 100644 index 00000000..bbcbeef4 --- /dev/null +++ b/src/Gargantext/Database/Admin/Schema/Node.hs @@ -0,0 +1,251 @@ +{-| +Module : Gargantext.Database.Schema.Node +Description : Main requests of Node to the database +Copyright : (c) CNRS, 2017-Present +License : AGPL + CECILL v3 +Maintainer : team@gargantext.org +Stability : experimental +Portability : POSIX +-} + +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +{-# LANGUAGE Arrows #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Gargantext.Database.Schema.Node where + +import Control.Arrow (returnA) +import Control.Lens (set, view) +import Control.Lens.TH (makeLensesWith, abbreviatedFields) +import Data.Aeson +import Data.Maybe (Maybe(..), fromMaybe) +import Data.Profunctor.Product.TH (makeAdaptorAndInstance) +import Data.Text (Text) +import Database.PostgreSQL.Simple.FromField (FromField, fromField) +import GHC.Int (Int64) +import Gargantext.Core.Types +import Gargantext.Core.Types.Individu (User(..)) +import Gargantext.Database.Config (nodeTypeId) +import Gargantext.Database.Node.Contact (HyperdataContact(..), arbitraryHyperdataContact) +import Gargantext.Database.Query.Filter (limit', offset') +import Gargantext.Database.Types.Errors +import Gargantext.Database.Types.Node (NodeType(..), defaultCorpus, Hyperdata, HyperData(..)) +import Gargantext.Database.Utils +import Gargantext.Prelude hiding (sum, head) +import Gargantext.Viz.Graph (HyperdataGraph(..)) +import Opaleye hiding (FromField) +import Opaleye.Internal.QueryArr (Query) +import Prelude hiding (null, id, map, sum) + +------------------------------------------------------------------------ +instance FromField HyperdataAny where + fromField = fromField' + +instance FromField HyperdataCorpus + where + fromField = fromField' + +instance FromField HyperdataDocument + where + fromField = fromField' + +instance FromField HyperdataDocumentV3 + where + fromField = fromField' + +instance FromField HyperData + where + fromField = fromField' + +instance FromField HyperdataListModel + where + fromField = fromField' + +instance FromField HyperdataGraph + where + fromField = fromField' + +instance FromField HyperdataPhylo + where + fromField = fromField' + +instance FromField HyperdataAnnuaire + where + fromField = fromField' + +instance FromField HyperdataList + where + fromField = fromField' + +instance FromField (NodeId, Text) + where + fromField = fromField' +------------------------------------------------------------------------ +instance QueryRunnerColumnDefault PGJsonb HyperdataAny + where + queryRunnerColumnDefault = fieldQueryRunnerColumn + +instance QueryRunnerColumnDefault PGJsonb HyperdataList + where + queryRunnerColumnDefault = fieldQueryRunnerColumn + +instance QueryRunnerColumnDefault PGJsonb HyperData + where + queryRunnerColumnDefault = fieldQueryRunnerColumn + + +instance QueryRunnerColumnDefault PGJsonb HyperdataDocument + where + queryRunnerColumnDefault = fieldQueryRunnerColumn + +instance QueryRunnerColumnDefault PGJsonb HyperdataDocumentV3 + where + queryRunnerColumnDefault = fieldQueryRunnerColumn + +instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus + where + queryRunnerColumnDefault = fieldQueryRunnerColumn + +instance QueryRunnerColumnDefault PGJsonb HyperdataListModel + where + queryRunnerColumnDefault = fieldQueryRunnerColumn + +instance QueryRunnerColumnDefault PGJsonb HyperdataGraph + where + queryRunnerColumnDefault = fieldQueryRunnerColumn + +instance QueryRunnerColumnDefault PGJsonb HyperdataPhylo + where + queryRunnerColumnDefault = fieldQueryRunnerColumn + +instance QueryRunnerColumnDefault PGJsonb HyperdataAnnuaire + where + queryRunnerColumnDefault = fieldQueryRunnerColumn + +instance QueryRunnerColumnDefault PGTSVector (Maybe TSVector) + where + queryRunnerColumnDefault = fieldQueryRunnerColumn + +instance QueryRunnerColumnDefault PGInt4 (Maybe NodeId) + where + queryRunnerColumnDefault = fieldQueryRunnerColumn + +instance QueryRunnerColumnDefault PGInt4 NodeId + where + queryRunnerColumnDefault = fieldQueryRunnerColumn + +instance QueryRunnerColumnDefault (Nullable PGInt4) NodeId + where + queryRunnerColumnDefault = fieldQueryRunnerColumn + + +------------------------------------------------------------------------ +$(makeAdaptorAndInstance "pNode" ''NodePoly) +$(makeLensesWith abbreviatedFields ''NodePoly) + +$(makeAdaptorAndInstance "pNodeSearch" ''NodePolySearch) +$(makeLensesWith abbreviatedFields ''NodePolySearch) + +type NodeWrite = NodePoly (Maybe (Column PGInt4) ) + (Column PGInt4) + (Column PGInt4) + (Maybe (Column PGInt4) ) + (Column PGText) + (Maybe (Column PGTimestamptz)) + (Column PGJsonb) + +type NodeRead = NodePoly (Column PGInt4 ) + (Column PGInt4 ) + (Column PGInt4 ) + (Column PGInt4 ) + (Column PGText ) + (Column PGTimestamptz ) + (Column PGJsonb ) + +type NodeReadNull = NodePoly (Column (Nullable PGInt4)) + (Column (Nullable PGInt4)) + (Column (Nullable PGInt4)) + (Column (Nullable PGInt4)) + (Column (Nullable PGText)) + (Column (Nullable PGTimestamptz)) + (Column (Nullable PGJsonb)) + +nodeTable :: Table NodeWrite NodeRead +nodeTable = Table "nodes" (pNode Node { _node_id = optional "id" + , _node_typename = required "typename" + , _node_userId = required "user_id" + + , _node_parentId = optional "parent_id" + , _node_name = required "name" + , _node_date = optional "date" + + , _node_hyperdata = required "hyperdata" + } + ) + +queryNodeTable :: Query NodeRead +queryNodeTable = queryTable nodeTable + +------------------------------------------------------------------------ +-- | Node(Read|Write)Search is slower than Node(Write|Read) use it +-- for full text search only +type NodeSearchWrite = + NodePolySearch + (Maybe (Column PGInt4) ) + (Column PGInt4 ) + (Column PGInt4 ) + (Column (Nullable PGInt4) ) + (Column PGText ) + (Maybe (Column PGTimestamptz)) + (Column PGJsonb ) + (Maybe (Column PGTSVector) ) + +type NodeSearchRead = + NodePolySearch + (Column PGInt4 ) + (Column PGInt4 ) + (Column PGInt4 ) + (Column (Nullable PGInt4 )) + (Column PGText ) + (Column PGTimestamptz ) + (Column PGJsonb ) + (Column PGTSVector ) + +type NodeSearchReadNull = + NodePolySearch + (Column (Nullable PGInt4) ) + (Column (Nullable PGInt4) ) + (Column (Nullable PGInt4) ) + (Column (Nullable PGInt4) ) + (Column (Nullable PGText) ) + (Column (Nullable PGTimestamptz)) + (Column (Nullable PGJsonb) ) + (Column (Nullable PGTSVector) ) + +nodeTableSearch :: Table NodeSearchWrite NodeSearchRead +nodeTableSearch = Table "nodes" (pNodeSearch NodeSearch { _ns_id = optional "id" + , _ns_typename = required "typename" + , _ns_userId = required "user_id" + + , _ns_parentId = required "parent_id" + , _ns_name = required "name" + , _ns_date = optional "date" + + , _ns_hyperdata = required "hyperdata" + , _ns_search = optional "search" + } + ) + + diff --git a/src/Gargantext/Database/Schema/NodeNgrams.hs b/src/Gargantext/Database/Admin/Schema/NodeNgrams.hs similarity index 99% rename from src/Gargantext/Database/Schema/NodeNgrams.hs rename to src/Gargantext/Database/Admin/Schema/NodeNgrams.hs index 5926dff0..adac96ce 100644 --- a/src/Gargantext/Database/Schema/NodeNgrams.hs +++ b/src/Gargantext/Database/Admin/Schema/NodeNgrams.hs @@ -25,7 +25,7 @@ NodeNgrams register Context of Ngrams (named Cgrams then) {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} -module Gargantext.Database.Schema.NodeNgrams where +module Gargantext.Database.Admin.Schema.NodeNgrams where import Data.Map (Map) import qualified Data.Map as Map diff --git a/src/Gargantext/Database/Schema/NodeNode.hs b/src/Gargantext/Database/Admin/Schema/NodeNode.hs similarity index 98% rename from src/Gargantext/Database/Schema/NodeNode.hs rename to src/Gargantext/Database/Admin/Schema/NodeNode.hs index 7e14de65..eee91656 100644 --- a/src/Gargantext/Database/Schema/NodeNode.hs +++ b/src/Gargantext/Database/Admin/Schema/NodeNode.hs @@ -24,7 +24,7 @@ commentary with @some markup@. {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} -module Gargantext.Database.Schema.NodeNode where +module Gargantext.Database.Admin.Schema.NodeNode where import Control.Lens (view, (^.)) import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..)) @@ -34,7 +34,7 @@ import Control.Lens.TH (makeLenses) import Data.Maybe (Maybe, catMaybes) import Data.Text (Text, splitOn) import Data.Profunctor.Product.TH (makeAdaptorAndInstance) -import Gargantext.Database.Schema.Node +import Gargantext.Database.Tools.Node (pgNodeId) import Gargantext.Core.Types import Gargantext.Database.Utils import Gargantext.Database.Config (nodeTypeId) diff --git a/src/Gargantext/Database/Schema/NodeNodeNgrams.hs b/src/Gargantext/Database/Admin/Schema/NodeNodeNgrams.hs similarity index 97% rename from src/Gargantext/Database/Schema/NodeNodeNgrams.hs rename to src/Gargantext/Database/Admin/Schema/NodeNodeNgrams.hs index 19b55178..e9d99d76 100644 --- a/src/Gargantext/Database/Schema/NodeNodeNgrams.hs +++ b/src/Gargantext/Database/Admin/Schema/NodeNodeNgrams.hs @@ -20,7 +20,7 @@ Portability : POSIX {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} -module Gargantext.Database.Schema.NodeNodeNgrams +module Gargantext.Database.Admin.Schema.NodeNodeNgrams where import Prelude @@ -28,7 +28,7 @@ import Data.Profunctor.Product.TH (makeAdaptorAndInstance) import Control.Lens.TH (makeLenses) import Gargantext.Database.Utils (Cmd, mkCmd) import Gargantext.Database.Schema.Ngrams (NgramsTypeId, pgNgramsTypeId, NgramsId) -import Gargantext.Database.Schema.Node (pgNodeId) +import Gargantext.Database.Tools.Node (pgNodeId) import Gargantext.Database.Types.Node import Opaleye diff --git a/src/Gargantext/Database/Schema/NodeNodeNgrams2.hs b/src/Gargantext/Database/Admin/Schema/NodeNodeNgrams2.hs similarity index 96% rename from src/Gargantext/Database/Schema/NodeNodeNgrams2.hs rename to src/Gargantext/Database/Admin/Schema/NodeNodeNgrams2.hs index dbc8a9ab..e6e04184 100644 --- a/src/Gargantext/Database/Schema/NodeNodeNgrams2.hs +++ b/src/Gargantext/Database/Admin/Schema/NodeNodeNgrams2.hs @@ -20,7 +20,7 @@ Portability : POSIX {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} -module Gargantext.Database.Schema.NodeNodeNgrams2 +module Gargantext.Database.Admin.Schema.NodeNodeNgrams2 where import Prelude @@ -28,7 +28,7 @@ import Data.Profunctor.Product.TH (makeAdaptorAndInstance) import Control.Lens.TH (makeLenses) import Gargantext.Database.Utils (Cmd, mkCmd) import Gargantext.Database.Schema.NodeNgrams (NodeNgramsId) -import Gargantext.Database.Schema.Node (pgNodeId) +import Gargantext.Database.Tools.Node (pgNodeId) import Gargantext.Database.Types.Node import Opaleye diff --git a/src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs b/src/Gargantext/Database/Admin/Schema/Node_NodeNgramsNodeNgrams.hs similarity index 97% rename from src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs rename to src/Gargantext/Database/Admin/Schema/Node_NodeNgramsNodeNgrams.hs index 19732b4b..674cdb41 100644 --- a/src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs +++ b/src/Gargantext/Database/Admin/Schema/Node_NodeNgramsNodeNgrams.hs @@ -33,7 +33,7 @@ Next Step benchmark: {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Gargantext.Database.Schema.Node_NodeNgramsNodeNgrams +module Gargantext.Database.Admin.Schema.Node_NodeNgramsNodeNgrams where import Control.Lens.TH (makeLensesWith, abbreviatedFields) @@ -41,7 +41,7 @@ import Data.Maybe (Maybe) import Data.Profunctor.Product.TH (makeAdaptorAndInstance) import Gargantext.Database.Utils (Cmd, runOpaQuery, mkCmd) import Gargantext.Database.Types.Node (CorpusId) -import Gargantext.Database.Schema.Node (pgNodeId) +import Gargantext.Database.Tools.Node (pgNodeId) import Gargantext.Prelude import Opaleye diff --git a/src/Gargantext/Database/Schema/NodesNgramsRepo.hs b/src/Gargantext/Database/Admin/Schema/NodesNgramsRepo.hs similarity index 97% rename from src/Gargantext/Database/Schema/NodesNgramsRepo.hs rename to src/Gargantext/Database/Admin/Schema/NodesNgramsRepo.hs index d7f422e2..5ac37ec0 100644 --- a/src/Gargantext/Database/Schema/NodesNgramsRepo.hs +++ b/src/Gargantext/Database/Admin/Schema/NodesNgramsRepo.hs @@ -25,7 +25,8 @@ Portability : POSIX {-# LANGUAGE TemplateHaskell #-} -module Gargantext.Database.Schema.NodesNgramsRepo where +module Gargantext.Database.Admin.Schema.NodesNgramsRepo + where import Control.Arrow (returnA) import Control.Lens.TH (makeLenses) diff --git a/src/Gargantext/Database/Schema/User.hs b/src/Gargantext/Database/Admin/Schema/User.hs similarity index 67% rename from src/Gargantext/Database/Schema/User.hs rename to src/Gargantext/Database/Admin/Schema/User.hs index 02594de7..be93a436 100644 --- a/src/Gargantext/Database/Schema/User.hs +++ b/src/Gargantext/Database/Admin/Schema/User.hs @@ -23,7 +23,7 @@ Functions to deal with users, database side. {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Schema.User where +module Gargantext.Database.Admin.Schema.User where import Control.Arrow (returnA) import Control.Lens.TH (makeLensesWith, abbreviatedFields) @@ -113,79 +113,3 @@ userTable = Table "auth_user" (pUserDB UserDB { user_id = optional "id" } ) --- TODO: on conflict, nice message -insertUsers :: [UserWrite] -> Cmd err Int64 -insertUsers us = mkCmd $ \c -> runInsert_ c insert - where - insert = Insert userTable us rCount Nothing - - -gargantextUser :: Username -> UserWrite -gargantextUser u = UserDB (Nothing) (pgStrictText "password") - (Nothing) (pgBool True) (pgStrictText u) - (pgStrictText "first_name") - (pgStrictText "last_name") - (pgStrictText "e@mail") - (pgBool True) (pgBool True) (Nothing) - -insertUsersDemo :: Cmd err Int64 -insertUsersDemo = insertUsers $ map (\u -> gargantextUser u) arbitraryUsername - ------------------------------------------------------------------- -queryUserTable :: Query UserRead -queryUserTable = queryTable userTable - -selectUsersLight :: Query UserRead -selectUsersLight = proc () -> do - row@(UserDB i _p _ll _is _un _fn _ln _m _iff _ive _dj) <- queryUserTable -< () - restrict -< i .== 1 - --returnA -< User i p ll is un fn ln m iff ive dj - returnA -< row ------------------------------------------------------------------- --- | Select User with some parameters --- Not optimized version -userWith :: (Eq a1, Foldable t) => (a -> a1) -> a1 -> t a -> Maybe a -userWith f t xs = find (\x -> f x == t) xs - --- | Select User with Username -userWithUsername :: Text -> [UserDB] -> Maybe UserDB -userWithUsername t xs = userWith user_username t xs - -userWithId :: Int -> [UserDB] -> Maybe UserDB -userWithId t xs = userWith user_id t xs - -userLightWithUsername :: Text -> [UserLight] -> Maybe UserLight -userLightWithUsername t xs = userWith userLight_username t xs - -userLightWithId :: Int -> [UserLight] -> Maybe UserLight -userLightWithId t xs = userWith userLight_id t xs - - -instance QueryRunnerColumnDefault PGTimestamptz (Maybe UTCTime) where - queryRunnerColumnDefault = fieldQueryRunnerColumn - - -users :: Cmd err [UserDB] -users = runOpaQuery queryUserTable - -usersLight :: Cmd err [UserLight] -usersLight = map toUserLight <$> users - -getUser :: Username -> Cmd err (Maybe UserLight) -getUser u = userLightWithUsername u <$> usersLight - - -getUserId :: HasNodeError err - => User - -> Cmd err UserId -getUserId (UserDBId uid) = pure uid -getUserId (RootId rid) = do - n <- getNode rid - pure $ _node_userId n -getUserId (UserName u ) = do - muser <- getUser u - case muser of - Just user -> pure $ userLight_id user - Nothing -> nodeError NoUserFound - - diff --git a/src/Gargantext/Database/Init.hs b/src/Gargantext/Database/Admin/Trigger/Init.hs similarity index 96% rename from src/Gargantext/Database/Init.hs rename to src/Gargantext/Database/Admin/Trigger/Init.hs index bc90c9ca..15a4c055 100644 --- a/src/Gargantext/Database/Init.hs +++ b/src/Gargantext/Database/Admin/Trigger/Init.hs @@ -17,7 +17,7 @@ Ngrams by node enable contextual metrics. {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Init +module Gargantext.Database.Admin.Trigger.Init where -- import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) diff --git a/src/Gargantext/Database/Triggers/NodeNodeNgrams.hs b/src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs similarity index 99% rename from src/Gargantext/Database/Triggers/NodeNodeNgrams.hs rename to src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs index 5f3331f0..3cc6d563 100644 --- a/src/Gargantext/Database/Triggers/NodeNodeNgrams.hs +++ b/src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs @@ -17,7 +17,7 @@ Triggers on NodeNodeNgrams table. {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Triggers.NodeNodeNgrams +module Gargantext.Database.Admin.Trigger.NodeNodeNgrams where import Database.PostgreSQL.Simple.SqlQQ (sql) diff --git a/src/Gargantext/Database/Triggers/Nodes.hs b/src/Gargantext/Database/Admin/Trigger/Nodes.hs similarity index 96% rename from src/Gargantext/Database/Triggers/Nodes.hs rename to src/Gargantext/Database/Admin/Trigger/Nodes.hs index a41c6b2f..30e7ce3c 100644 --- a/src/Gargantext/Database/Triggers/Nodes.hs +++ b/src/Gargantext/Database/Admin/Trigger/Nodes.hs @@ -1,5 +1,5 @@ {-| -Module : Gargantext.Database.Triggers.Nodes +Module : Gargantext.Database.Admin.Trigger.Nodes Description : Triggers configuration Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 @@ -17,7 +17,7 @@ Triggers on Nodes table. {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Triggers.Nodes +module Gargantext.Database.Admin.Trigger.Nodes where import Database.PostgreSQL.Simple.SqlQQ (sql) diff --git a/src/Gargantext/Database/Triggers/NodesNodes.hs b/src/Gargantext/Database/Admin/Trigger/NodesNodes.hs similarity index 99% rename from src/Gargantext/Database/Triggers/NodesNodes.hs rename to src/Gargantext/Database/Admin/Trigger/NodesNodes.hs index 484e026e..675c29f0 100644 --- a/src/Gargantext/Database/Triggers/NodesNodes.hs +++ b/src/Gargantext/Database/Admin/Trigger/NodesNodes.hs @@ -17,7 +17,7 @@ Triggers on NodesNodes table. {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Triggers.NodesNodes +module Gargantext.Database.Admin.Trigger.NodesNodes where import Database.PostgreSQL.Simple.SqlQQ (sql) diff --git a/src/Gargantext/Database/Types/Node.hs b/src/Gargantext/Database/Admin/Types/Node.hs similarity index 99% rename from src/Gargantext/Database/Types/Node.hs rename to src/Gargantext/Database/Admin/Types/Node.hs index 45ab0ea0..2d559a93 100644 --- a/src/Gargantext/Database/Types/Node.hs +++ b/src/Gargantext/Database/Admin/Types/Node.hs @@ -22,7 +22,7 @@ Portability : POSIX -- {-# LANGUAGE DuplicateRecordFields #-} -module Gargantext.Database.Types.Node +module Gargantext.Database.Admin.Types.Node where import Prelude (Enum, Bounded, minBound, maxBound) diff --git a/src/Gargantext/Database/Utils.hs b/src/Gargantext/Database/Admin/Utils.hs similarity index 99% rename from src/Gargantext/Database/Utils.hs rename to src/Gargantext/Database/Admin/Utils.hs index 483a3450..37726911 100644 --- a/src/Gargantext/Database/Utils.hs +++ b/src/Gargantext/Database/Admin/Utils.hs @@ -19,7 +19,7 @@ commentary with @some markup@. {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Utils where +module Gargantext.Database.Admin.Utils where import Data.ByteString.Char8 (hPutStrLn) import System.IO (stderr) diff --git a/src/Gargantext/Database/Facet.hs b/src/Gargantext/Database/Query/Facet.hs similarity index 98% rename from src/Gargantext/Database/Facet.hs rename to src/Gargantext/Database/Query/Facet.hs index e642d21c..bc96da3e 100644 --- a/src/Gargantext/Database/Facet.hs +++ b/src/Gargantext/Database/Query/Facet.hs @@ -25,7 +25,7 @@ Portability : POSIX {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} ------------------------------------------------------------------------ -module Gargantext.Database.Facet +module Gargantext.Database.Query.Facet ( runViewAuthorsDoc , runViewDocuments , filterWith @@ -62,8 +62,8 @@ import Gargantext.Database.Schema.NodeNode import Gargantext.Database.Schema.NodeNodeNgrams -- import Gargantext.Database.Schema.NodeNodeNgrams2 import Gargantext.Database.Utils -import Gargantext.Database.Queries.Filter -import Gargantext.Database.Queries.Join (leftJoin5) +import Gargantext.Database.Query.Filter +import Gargantext.Database.Query.Join (leftJoin5) import Opaleye import Prelude hiding (null, id, map, sum, not, read) import Servant.API diff --git a/src/Gargantext/Database/Queries/Filter.hs b/src/Gargantext/Database/Query/Filter.hs similarity index 90% rename from src/Gargantext/Database/Queries/Filter.hs rename to src/Gargantext/Database/Query/Filter.hs index 0246eae8..cd5f74d4 100644 --- a/src/Gargantext/Database/Queries/Filter.hs +++ b/src/Gargantext/Database/Query/Filter.hs @@ -1,5 +1,5 @@ {-| -Module : Gargantext.Database.Queries.Filter +Module : Gargantext.Database.Query.Filter Description : Main requests of Node to the database Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 @@ -19,7 +19,7 @@ Portability : POSIX {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Gargantext.Database.Queries.Filter where +module Gargantext.Database.Query.Filter where import Gargantext.Core.Types (Limit, Offset) import Data.Maybe (Maybe, maybe) diff --git a/src/Gargantext/Database/Queries/Join.hs b/src/Gargantext/Database/Query/Join.hs similarity index 99% rename from src/Gargantext/Database/Queries/Join.hs rename to src/Gargantext/Database/Query/Join.hs index 22c007d1..fcd938bf 100644 --- a/src/Gargantext/Database/Queries/Join.hs +++ b/src/Gargantext/Database/Query/Join.hs @@ -1,5 +1,5 @@ {-| -Module : Gargantext.Database.Queries.Join +Module : Gargantext.Database.Query.Join Description : Main Join queries (using Opaleye) Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 @@ -26,7 +26,7 @@ Multiple Join functions with Opaleye. {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} ------------------------------------------------------------------------ -module Gargantext.Database.Queries.Join +module Gargantext.Database.Query.Query.Join where ------------------------------------------------------------------------ diff --git a/src/Gargantext/Database/Ngrams.hs b/src/Gargantext/Database/Query/Ngrams.hs similarity index 84% rename from src/Gargantext/Database/Ngrams.hs rename to src/Gargantext/Database/Query/Ngrams.hs index db92e562..7422b86b 100644 --- a/src/Gargantext/Database/Ngrams.hs +++ b/src/Gargantext/Database/Query/Ngrams.hs @@ -14,16 +14,16 @@ Portability : POSIX {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Ngrams +module Gargantext.Database.Query.Ngrams where import Data.Text (Text) import Control.Lens ((^.)) import Gargantext.Core.Types -import Gargantext.Database.Utils (runOpaQuery, Cmd) -import Gargantext.Database.Schema.Ngrams -import Gargantext.Database.Schema.NodeNodeNgrams -import Gargantext.Database.Schema.Node +import Gargantext.Database.Admin.Utils (runOpaQuery, Cmd) +import Gargantext.Database.Admin.Schema.Ngrams +import Gargantext.Database.Admin.Schema.NodeNodeNgrams +import Gargantext.Database.Admin.Schema.Node import Gargantext.Prelude import Opaleye import Control.Arrow (returnA) diff --git a/src/Gargantext/Database/Node/Children.hs b/src/Gargantext/Database/Query/Node/Children.hs similarity index 85% rename from src/Gargantext/Database/Node/Children.hs rename to src/Gargantext/Database/Query/Node/Children.hs index 3d5babcc..98b43131 100644 --- a/src/Gargantext/Database/Node/Children.hs +++ b/src/Gargantext/Database/Query/Node/Children.hs @@ -16,18 +16,18 @@ Portability : POSIX {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Node.Children where +module Gargantext.Database.Query.Node.Children where import Data.Proxy import Opaleye import Gargantext.Core.Types -import Gargantext.Database.Schema.Node -import Gargantext.Database.Utils -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 Gargantext.Database.Admin.Schema.Node +import Gargantext.Database.Admin.Utils +import Gargantext.Database.Admin.Schema.NodeNode +import Gargantext.Database.Admin.Config (nodeTypeId) +import Gargantext.Database.Query.Filter +import Gargantext.Database.Query.Node.Contact (HyperdataContact) +import Gargantext.Database.Admin.Schema.Node (pgNodeId) import Control.Arrow (returnA) getAllDocuments :: ParentId -> Cmd err (TableResult (Node HyperdataDocument)) diff --git a/src/Gargantext/Database/Node/Contact.hs b/src/Gargantext/Database/Query/Node/Contact.hs similarity index 99% rename from src/Gargantext/Database/Node/Contact.hs rename to src/Gargantext/Database/Query/Node/Contact.hs index ea5cf987..740ada53 100644 --- a/src/Gargantext/Database/Node/Contact.hs +++ b/src/Gargantext/Database/Query/Node/Contact.hs @@ -17,7 +17,7 @@ Portability : POSIX {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} -module Gargantext.Database.Node.Contact +module Gargantext.Database.Query.Node.Contact where import Control.Lens (makeLenses) diff --git a/src/Gargantext/Database/Node/Document/Add.hs b/src/Gargantext/Database/Query/Node/Document/Add.hs similarity index 98% rename from src/Gargantext/Database/Node/Document/Add.hs rename to src/Gargantext/Database/Query/Node/Document/Add.hs index 465126b5..956379f5 100644 --- a/src/Gargantext/Database/Node/Document/Add.hs +++ b/src/Gargantext/Database/Query/Node/Document/Add.hs @@ -21,9 +21,10 @@ Add Documents/Contact to a Corpus/Annuaire. {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeSynonymInstances #-} ------------------------------------------------------------------------- -module Gargantext.Database.Node.Document.Add where +------------------------------------------------------------------------ +module Gargantext.Database.Query.Node.Document.Add + where import Data.ByteString.Internal (ByteString) import Data.Typeable (Typeable) diff --git a/src/Gargantext/Database/Node/Document/Insert.hs b/src/Gargantext/Database/Query/Node/Document/Insert.hs similarity index 99% rename from src/Gargantext/Database/Node/Document/Insert.hs rename to src/Gargantext/Database/Query/Node/Document/Insert.hs index 3d8c6b39..6776bf2d 100644 --- a/src/Gargantext/Database/Node/Document/Insert.hs +++ b/src/Gargantext/Database/Query/Node/Document/Insert.hs @@ -57,7 +57,7 @@ the concatenation of the parameters defined by @shaParameters@. {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeSynonymInstances #-} ------------------------------------------------------------------------ -module Gargantext.Database.Node.Document.Insert where +module Gargantext.Database.Query.Node.Document.Insert where import Control.Lens (set, view) import Control.Lens.Prism diff --git a/src/Gargantext/Database/Node/Select.hs b/src/Gargantext/Database/Query/Node/Select.hs similarity index 95% rename from src/Gargantext/Database/Node/Select.hs rename to src/Gargantext/Database/Query/Node/Select.hs index 5c8f6a60..5e5f3ced 100644 --- a/src/Gargantext/Database/Node/Select.hs +++ b/src/Gargantext/Database/Query/Node/Select.hs @@ -14,7 +14,8 @@ Portability : POSIX {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Node.Select where +module Gargantext.Database.Query.Node.Select + where import Opaleye import Gargantext.Core.Types diff --git a/src/Gargantext/Database/Node/Update.hs b/src/Gargantext/Database/Query/Node/Update.hs similarity index 95% rename from src/Gargantext/Database/Node/Update.hs rename to src/Gargantext/Database/Query/Node/Update.hs index 307405b5..c19dcd85 100644 --- a/src/Gargantext/Database/Node/Update.hs +++ b/src/Gargantext/Database/Query/Node/Update.hs @@ -16,7 +16,8 @@ Portability : POSIX {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Node.Update (Update(..), update) where +module Gargantext.Database.Query.Node.Update (Update(..), update) + where import qualified Data.Text as DT import Database.PostgreSQL.Simple diff --git a/src/Gargantext/Database/Node/UpdateOpaleye.hs b/src/Gargantext/Database/Query/Node/UpdateOpaleye.hs similarity index 95% rename from src/Gargantext/Database/Node/UpdateOpaleye.hs rename to src/Gargantext/Database/Query/Node/UpdateOpaleye.hs index d572f4b9..85545079 100644 --- a/src/Gargantext/Database/Node/UpdateOpaleye.hs +++ b/src/Gargantext/Database/Query/Node/UpdateOpaleye.hs @@ -16,7 +16,7 @@ Portability : POSIX {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Node.UpdateOpaleye where +module Gargantext.Database.Query.Node.UpdateOpaleye where import Opaleye diff --git a/src/Gargantext/Database/Node/User.hs b/src/Gargantext/Database/Query/Node/User.hs similarity index 79% rename from src/Gargantext/Database/Node/User.hs rename to src/Gargantext/Database/Query/Node/User.hs index 502207af..21b78b65 100644 --- a/src/Gargantext/Database/Node/User.hs +++ b/src/Gargantext/Database/Query/Node/User.hs @@ -17,7 +17,7 @@ Portability : POSIX {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} -module Gargantext.Database.Node.User +module Gargantext.Database.Query.Node.User where import Control.Lens (makeLenses) @@ -31,6 +31,9 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) import Gargantext.Database.Node.Contact (HyperdataContact, fake_HyperdataContact) import Gargantext.Database.Types.Node (Node,Hyperdata, DocumentId, NodeId(..)) import Gargantext.Database.Utils (fromField') +import Gargantext.Database.Tools.Node (getNode) +import Gargantext.Database.Schema.Node (Node(..)) +import Gargantext.Core.Types.Individu (Username, arbitraryUsername, User(..), UserId) import Gargantext.Prelude import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn) import Test.QuickCheck (elements) @@ -126,5 +129,32 @@ $(deriveJSON (unPrefix "_hpr_") ''HyperdataPrivate) $(deriveJSON (unPrefix "_hpu_") ''HyperdataPublic) +----------------------------------------------------------------- +getUserId :: HasNodeError err + => User + -> Cmd err UserId +getUserId (UserDBId uid) = pure uid +getUserId (RootId rid) = do + n <- getNode rid + pure $ _node_userId n +getUserId (UserName u ) = do + muser <- getUser u + case muser of + Just user -> pure $ userLight_id user + Nothing -> nodeError NoUserFound + + +getNodeUser :: NodeId -> Cmd err (Node HyperdataUser) +getNodeUser nId = do + fromMaybe (error $ "Node does not exist: " <> show nId) . headMay + <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId)) + + +nodeUserW :: Maybe Name -> Maybe HyperdataUser -> UserId -> NodeWrite +nodeUserW maybeName maybeHyperdata = node NodeUser name user Nothing + where + name = maybe "User" identity maybeName + user = maybe fake_HyperdataUser identity maybeHyperdata + diff --git a/src/Gargantext/Database/Root.hs b/src/Gargantext/Database/Root.hs deleted file mode 100644 index c537b409..00000000 --- a/src/Gargantext/Database/Root.hs +++ /dev/null @@ -1,65 +0,0 @@ -{-| -Module : Gargantext.Database.Root -Description : Main requests to get root of users -Copyright : (c) CNRS, 2017-Present -License : AGPL + CECILL v3 -Maintainer : team@gargantext.org -Stability : experimental -Portability : POSIX --} - -{-# OPTIONS_GHC -fno-warn-name-shadowing #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -{-# LANGUAGE Arrows #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TemplateHaskell #-} - -module Gargantext.Database.Root where - -import Control.Arrow (returnA) -import Gargantext.Core.Types.Individu (User(..)) -import Gargantext.Database.Config (nodeTypeId) -import Gargantext.Database.Node.User (HyperdataUser) -import Gargantext.Database.Schema.Node (NodeRead) -import Gargantext.Database.Schema.Node (queryNodeTable) -import Gargantext.Database.Schema.User (queryUserTable, UserPoly(..)) -import Gargantext.Database.Types.Node (Node, NodePoly(..), NodeType(NodeUser)) -import Gargantext.Database.Utils (Cmd, runOpaQuery) -import Gargantext.Prelude -import Opaleye (restrict, (.==), Query) -import Opaleye.PGTypes (pgStrictText, pgInt4) - -getRoot :: User -> Cmd err [Node HyperdataUser] -getRoot = runOpaQuery . selectRoot - -selectRoot :: User -> Query NodeRead -selectRoot (UserName username) = proc () -> do - row <- queryNodeTable -< () - users <- queryUserTable -< () - restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser) - restrict -< user_username users .== (pgStrictText username) - restrict -< _node_userId row .== (user_id users) - returnA -< row - -selectRoot (UserDBId uid) = proc () -> do - row <- queryNodeTable -< () - restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser) - restrict -< _node_userId row .== (pgInt4 uid) - returnA -< row - - - - - - - diff --git a/src/Gargantext/Database/Schema/Node.hs b/src/Gargantext/Database/Schema/Node.hs deleted file mode 100644 index bad1ab57..00000000 --- a/src/Gargantext/Database/Schema/Node.hs +++ /dev/null @@ -1,750 +0,0 @@ -{-| -Module : Gargantext.Database.Schema.Node -Description : Main requests of Node to the database -Copyright : (c) CNRS, 2017-Present -License : AGPL + CECILL v3 -Maintainer : team@gargantext.org -Stability : experimental -Portability : POSIX --} - -{-# OPTIONS_GHC -fno-warn-name-shadowing #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -{-# LANGUAGE Arrows #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} - -module Gargantext.Database.Schema.Node where - -import Control.Arrow (returnA) -import Control.Lens (set, view) -import Control.Lens.TH (makeLensesWith, abbreviatedFields) -import Data.Aeson -import Data.Maybe (Maybe(..), fromMaybe) -import Data.Profunctor.Product.TH (makeAdaptorAndInstance) -import Data.Text (Text) -import Database.PostgreSQL.Simple.FromField (FromField, fromField) -import GHC.Int (Int64) -import Gargantext.Core.Types -import Gargantext.Core.Types.Individu (User(..)) -import Gargantext.Database.Config (nodeTypeId) -import Gargantext.Database.Node.Contact (HyperdataContact(..), arbitraryHyperdataContact) -import Gargantext.Database.Node.User (HyperdataUser(..), fake_HyperdataUser) -import Gargantext.Database.Queries.Filter (limit', offset') -import Gargantext.Database.Schema.User (getUserId) -import Gargantext.Database.Types.Errors -import Gargantext.Database.Types.Node (NodeType(..), defaultCorpus, Hyperdata, HyperData(..)) -import Gargantext.Database.Utils -import Gargantext.Prelude hiding (sum, head) -import Gargantext.Viz.Graph (HyperdataGraph(..)) -import Opaleye hiding (FromField) -import Opaleye.Internal.QueryArr (Query) -import Prelude hiding (null, id, map, sum) - ------------------------------------------------------------------------- -instance FromField HyperdataAny where - fromField = fromField' - -instance FromField HyperdataCorpus - where - fromField = fromField' - -instance FromField HyperdataDocument - where - fromField = fromField' - -instance FromField HyperdataDocumentV3 - where - fromField = fromField' - -instance FromField HyperData - where - fromField = fromField' - -instance FromField HyperdataListModel - where - fromField = fromField' - -instance FromField HyperdataGraph - where - fromField = fromField' - -instance FromField HyperdataPhylo - where - fromField = fromField' - -instance FromField HyperdataAnnuaire - where - fromField = fromField' - -instance FromField HyperdataList - where - fromField = fromField' - -instance FromField (NodeId, Text) - where - fromField = fromField' ------------------------------------------------------------------------- -instance QueryRunnerColumnDefault PGJsonb HyperdataAny - where - queryRunnerColumnDefault = fieldQueryRunnerColumn - -instance QueryRunnerColumnDefault PGJsonb HyperdataList - where - queryRunnerColumnDefault = fieldQueryRunnerColumn - -instance QueryRunnerColumnDefault PGJsonb HyperData - where - queryRunnerColumnDefault = fieldQueryRunnerColumn - - -instance QueryRunnerColumnDefault PGJsonb HyperdataDocument - where - queryRunnerColumnDefault = fieldQueryRunnerColumn - -instance QueryRunnerColumnDefault PGJsonb HyperdataDocumentV3 - where - queryRunnerColumnDefault = fieldQueryRunnerColumn - -instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus - where - queryRunnerColumnDefault = fieldQueryRunnerColumn - -instance QueryRunnerColumnDefault PGJsonb HyperdataListModel - where - queryRunnerColumnDefault = fieldQueryRunnerColumn - -instance QueryRunnerColumnDefault PGJsonb HyperdataGraph - where - queryRunnerColumnDefault = fieldQueryRunnerColumn - -instance QueryRunnerColumnDefault PGJsonb HyperdataPhylo - where - queryRunnerColumnDefault = fieldQueryRunnerColumn - -instance QueryRunnerColumnDefault PGJsonb HyperdataAnnuaire - where - queryRunnerColumnDefault = fieldQueryRunnerColumn - -instance QueryRunnerColumnDefault PGTSVector (Maybe TSVector) - where - queryRunnerColumnDefault = fieldQueryRunnerColumn - -instance QueryRunnerColumnDefault PGInt4 (Maybe NodeId) - where - queryRunnerColumnDefault = fieldQueryRunnerColumn - -instance QueryRunnerColumnDefault PGInt4 NodeId - where - queryRunnerColumnDefault = fieldQueryRunnerColumn - -instance QueryRunnerColumnDefault (Nullable PGInt4) NodeId - where - queryRunnerColumnDefault = fieldQueryRunnerColumn - - ------------------------------------------------------------------------- -$(makeAdaptorAndInstance "pNode" ''NodePoly) -$(makeLensesWith abbreviatedFields ''NodePoly) - -$(makeAdaptorAndInstance "pNodeSearch" ''NodePolySearch) -$(makeLensesWith abbreviatedFields ''NodePolySearch) - -type NodeWrite = NodePoly (Maybe (Column PGInt4) ) - (Column PGInt4) - (Column PGInt4) - (Maybe (Column PGInt4) ) - (Column PGText) - (Maybe (Column PGTimestamptz)) - (Column PGJsonb) - -type NodeRead = NodePoly (Column PGInt4 ) - (Column PGInt4 ) - (Column PGInt4 ) - (Column PGInt4 ) - (Column PGText ) - (Column PGTimestamptz ) - (Column PGJsonb ) - -type NodeReadNull = NodePoly (Column (Nullable PGInt4)) - (Column (Nullable PGInt4)) - (Column (Nullable PGInt4)) - (Column (Nullable PGInt4)) - (Column (Nullable PGText)) - (Column (Nullable PGTimestamptz)) - (Column (Nullable PGJsonb)) - -nodeTable :: Table NodeWrite NodeRead -nodeTable = Table "nodes" (pNode Node { _node_id = optional "id" - , _node_typename = required "typename" - , _node_userId = required "user_id" - - , _node_parentId = optional "parent_id" - , _node_name = required "name" - , _node_date = optional "date" - - , _node_hyperdata = required "hyperdata" - } - ) - -queryNodeTable :: Query NodeRead -queryNodeTable = queryTable nodeTable - ------------------------------------------------------------------------- --- | Node(Read|Write)Search is slower than Node(Write|Read) use it --- for full text search only -type NodeSearchWrite = - NodePolySearch - (Maybe (Column PGInt4) ) - (Column PGInt4 ) - (Column PGInt4 ) - (Column (Nullable PGInt4) ) - (Column PGText ) - (Maybe (Column PGTimestamptz)) - (Column PGJsonb ) - (Maybe (Column PGTSVector) ) - -type NodeSearchRead = - NodePolySearch - (Column PGInt4 ) - (Column PGInt4 ) - (Column PGInt4 ) - (Column (Nullable PGInt4 )) - (Column PGText ) - (Column PGTimestamptz ) - (Column PGJsonb ) - (Column PGTSVector ) - -type NodeSearchReadNull = - NodePolySearch - (Column (Nullable PGInt4) ) - (Column (Nullable PGInt4) ) - (Column (Nullable PGInt4) ) - (Column (Nullable PGInt4) ) - (Column (Nullable PGText) ) - (Column (Nullable PGTimestamptz)) - (Column (Nullable PGJsonb) ) - (Column (Nullable PGTSVector) ) - -nodeTableSearch :: Table NodeSearchWrite NodeSearchRead -nodeTableSearch = Table "nodes" (pNodeSearch NodeSearch { _ns_id = optional "id" - , _ns_typename = required "typename" - , _ns_userId = required "user_id" - - , _ns_parentId = required "parent_id" - , _ns_name = required "name" - , _ns_date = optional "date" - - , _ns_hyperdata = required "hyperdata" - , _ns_search = optional "search" - } - ) - - -queryNodeSearchTable :: Query NodeSearchRead -queryNodeSearchTable = queryTable nodeTableSearch - -selectNode :: Column PGInt4 -> Query NodeRead -selectNode id = proc () -> do - row <- queryNodeTable -< () - restrict -< _node_id row .== id - returnA -< row - - - -runGetNodes :: Query NodeRead -> Cmd err [Node HyperdataAny] -runGetNodes = runOpaQuery - ------------------------------------------------------------------------- ------------------------------------------------------------------------- --- | order by publication date --- Favorites (Bool), node_ngrams -selectNodesWith :: 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 - limit' maybeLimit $ offset' maybeOffset - $ orderBy (asc _node_id) - $ selectNodesWith' parentId maybeNodeType - -selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead -selectNodesWith' parentId maybeNodeType = proc () -> do - node <- (proc () -> do - row@(Node _ typeId _ parentId' _ _ _) <- queryNodeTable -< () - restrict -< parentId' .== (pgNodeId parentId) - - let typeId' = maybe 0 nodeTypeId maybeNodeType - - restrict -< if typeId' > 0 - then typeId .== (pgInt4 (typeId' :: Int)) - else (pgBool True) - returnA -< row ) -< () - returnA -< node - -deleteNode :: NodeId -> Cmd err Int -deleteNode n = mkCmd $ \conn -> - fromIntegral <$> runDelete conn nodeTable - (\(Node n_id _ _ _ _ _ _) -> n_id .== pgNodeId n) - -deleteNodes :: [NodeId] -> Cmd err Int -deleteNodes ns = mkCmd $ \conn -> - fromIntegral <$> runDelete conn nodeTable - (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgNodeId ns)) n_id) - --- TODO: NodeType should match with `a' -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 :: (Hyperdata a, QueryRunnerColumnDefault PGJsonb a) - => Maybe NodeId - -> Cmd err [Node a] -getNodesWithParentId n = runOpaQuery $ selectNodesWithParentID n' - where - n' = case n of - Just n'' -> n'' - Nothing -> 0 - ------------------------------------------------------------------------- -getDocumentsV3WithParentId :: 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 n = runOpaQuery $ selectNodesWith' n (Just NodeDocument) - -getListsModelWithParentId :: NodeId -> Cmd err [Node HyperdataListModel] -getListsModelWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeListModel) - -getCorporaWithParentId :: NodeId -> Cmd err [Node HyperdataCorpus] -getCorporaWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeCorpus) - ------------------------------------------------------------------------- -selectNodesWithParentID :: NodeId -> Query NodeRead -selectNodesWithParentID n = proc () -> do - row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< () - restrict -< parent_id .== (pgNodeId n) - returnA -< row - -selectNodesWithType :: Column PGInt4 -> Query NodeRead -selectNodesWithType type_id = proc () -> do - row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< () - restrict -< tn .== type_id - returnA -< row - -type JSONB = QueryRunnerColumnDefault PGJsonb - - -getNode :: NodeId -> Cmd err (Node Value) -getNode nId = fromMaybe (error $ "Node does not exist: " <> show nId) . headMay - <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId)) - -getNodeWith :: JSONB a => NodeId -> proxy a -> Cmd err (Node a) -getNodeWith nId _ = do - fromMaybe (error $ "Node does not exist: " <> show nId) . headMay - <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId)) - -getNodeUser :: NodeId -> Cmd err (Node HyperdataUser) -getNodeUser nId = do - fromMaybe (error $ "Node does not exist: " <> show nId) . headMay - <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId)) - - -getNodePhylo :: NodeId -> Cmd err (Node HyperdataPhylo) -getNodePhylo nId = do - fromMaybe (error $ "Node Phylo does not exist: " <> show nId) . headMay - <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId)) - - -getNodesWithType :: Column PGInt4 -> Cmd err [Node HyperdataDocument] -getNodesWithType = runOpaQuery . selectNodesWithType - ------------------------------------------------------------------------- -nodeUserW :: Maybe Name -> Maybe HyperdataUser -> UserId -> NodeWrite -nodeUserW maybeName maybeHyperdata = node NodeUser name user Nothing - where - name = maybe "User" identity maybeName - user = maybe fake_HyperdataUser identity maybeHyperdata - -nodeContactW :: Maybe Name -> Maybe HyperdataContact - -> AnnuaireId -> UserId -> NodeWrite -nodeContactW maybeName maybeContact aId = - node NodeContact name contact (Just aId) - where - name = maybe "Contact" identity maybeName - contact = maybe arbitraryHyperdataContact identity maybeContact ------------------------------------------------------------------------- -defaultFolder :: HyperdataCorpus -defaultFolder = defaultCorpus - -nodeFolderW :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> NodeWrite -nodeFolderW maybeName maybeFolder pid = node NodeFolder name folder (Just pid) - where - name = maybe "Folder" identity maybeName - folder = maybe defaultFolder identity maybeFolder ------------------------------------------------------------------------- -nodeCorpusW :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> NodeWrite -nodeCorpusW maybeName maybeCorpus pId = node NodeCorpus name corpus (Just pId) - where - name = maybe "Corpus" identity maybeName - corpus = maybe defaultCorpus identity maybeCorpus - -------------------------- -defaultDocument :: HyperdataDocument -defaultDocument = hyperdataDocument - -nodeDocumentW :: Maybe Name -> Maybe HyperdataDocument -> CorpusId -> UserId -> NodeWrite -nodeDocumentW maybeName maybeDocument cId = node NodeDocument name doc (Just cId) - where - name = maybe "Document" identity maybeName - doc = maybe defaultDocument identity maybeDocument ------------------------------------------------------------------------- -defaultAnnuaire :: HyperdataAnnuaire -defaultAnnuaire = HyperdataAnnuaire (Just "Title") (Just "Description") - -nodeAnnuaireW :: Maybe Name -> Maybe HyperdataAnnuaire -> ParentId -> UserId -> NodeWrite -nodeAnnuaireW maybeName maybeAnnuaire pId = node NodeAnnuaire name annuaire (Just pId) - where - name = maybe "Annuaire" identity maybeName - annuaire = maybe defaultAnnuaire identity maybeAnnuaire - ------------------------------------------------------------------------- - -{- -class IsNodeDb a where - data Node'' a :: * - data Hyper a :: * - -instance IsNodeDb NodeType where - data - -instance HasHyperdata NodeType where - data Hyper NodeType = HyperList HyperdataList - | HyperCorpus HyperdataCorpus - - hasHyperdata nt = case nt of - NodeList -> HyperList $ HyperdataList (Just "list") - - unHyper h = case h of - HyperList h' -> h' - ---} - - -class HasDefault a where - hasDefaultData :: a -> HyperData - hasDefaultName :: a -> Text - -instance HasDefault NodeType where - hasDefaultData nt = case nt of - NodeTexts -> HyperdataTexts (Just "Preferences") - NodeList -> HyperdataList' (Just "Preferences") - NodeListCooc -> HyperdataList' (Just "Preferences") - _ -> undefined - --NodeAnnuaire -> HyperdataAnnuaire (Just "Title") (Just "Description") - - hasDefaultName nt = case nt of - NodeTexts -> "Texts" - NodeList -> "Lists" - NodeListCooc -> "Cooc" - _ -> undefined - ------------------------------------------------------------------------- - -nodeDefault :: NodeType -> ParentId -> UserId -> NodeWrite -nodeDefault nt parent = node nt name hyper (Just parent) - where - name = (hasDefaultName nt) - hyper = (hasDefaultData nt) - ------------------------------------------------------------------------- -arbitraryListModel :: HyperdataListModel -arbitraryListModel = HyperdataListModel (400,500) "data/models/test.model" (Just 0.83) - -mkListModelNode :: HasNodeError err => ParentId -> UserId -> Cmd err [NodeId] -mkListModelNode p u = insertNodesR [nodeListModelW Nothing Nothing p u] - -nodeListModelW :: Maybe Name -> Maybe HyperdataListModel -> ParentId -> UserId -> NodeWrite -nodeListModelW maybeName maybeListModel pId = node NodeListModel name list (Just pId) - where - name = maybe "List Model" identity maybeName - list = maybe arbitraryListModel identity maybeListModel - ------------------------------------------------------------------------- -arbitraryGraph :: HyperdataGraph -arbitraryGraph = HyperdataGraph Nothing - -nodeGraphW :: Maybe Name -> Maybe HyperdataGraph -> ParentId -> UserId -> NodeWrite -nodeGraphW maybeName maybeGraph pId = node NodeGraph name graph (Just pId) - where - name = maybe "Graph" identity maybeName - graph = maybe arbitraryGraph identity maybeGraph - -mkGraph :: ParentId -> UserId -> Cmd err [GraphId] -mkGraph p u = insertNodesR [nodeGraphW Nothing Nothing p u] - -insertGraph :: ParentId -> UserId -> HyperdataGraph -> Cmd err [GraphId] -insertGraph p u h = insertNodesR [nodeGraphW Nothing (Just h) p u] - ------------------------------------------------------------------------- -arbitraryPhylo :: HyperdataPhylo -arbitraryPhylo = HyperdataPhylo Nothing Nothing - -nodePhyloW :: Maybe Name -> Maybe HyperdataPhylo -> ParentId -> UserId -> NodeWrite -nodePhyloW maybeName maybePhylo pId = node NodePhylo name graph (Just pId) - where - name = maybe "Phylo" identity maybeName - graph = maybe arbitraryPhylo identity maybePhylo - - ------------------------------------------------------------------------- -arbitraryDashboard :: HyperdataDashboard -arbitraryDashboard = HyperdataDashboard (Just "Preferences") [] ------------------------------------------------------------------------- - -node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite -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 - - ------------------------------- -insertNodes :: [NodeWrite] -> Cmd err Int64 -insertNodes ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns rCount Nothing - -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 (pgNodeId <$> 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 - -{- TODO semantic to achieve -post c uid pid [ Node' NodeCorpus "name" "{}" [] - , Node' NodeFolder "name" "{}" [Node' NodeCorpus "test 2" "" [ Node' NodeDocument "title" "metaData" [] - , Node' NodeDocument "title" "jsonData" [] - ] - ] - ] --} ------------------------------------------------------------------------- - --- TODO --- 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 pgNodeId pid) (pgStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v) -node2table _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet" - - -data Node' = Node' { _n_type :: NodeType - , _n_name :: Text - , _n_data :: Value - , _n_children :: [Node'] - } deriving (Show) - -mkNodes :: [NodeWrite] -> Cmd err Int64 -mkNodes ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns rCount Nothing - -mkNodeR :: [NodeWrite] -> Cmd err [NodeId] -mkNodeR ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns (rReturning _node_id) Nothing - ------------------------------------------------------------------------- - -data NewNode = NewNode { _newNodeId :: NodeId - , _newNodeChildren :: [NodeId] } - -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' [] - _ -> nodeError ManyParents - -postNode uid pid (Node' NodeCorpus txt v ns) = do - NewNode pid' _ <- postNode uid pid (Node' NodeCorpus txt v []) - pids <- mkNodeR (concat $ map (\n -> [childWith uid pid' n]) ns) - pure $ NewNode pid' pids - -postNode uid pid (Node' NodeAnnuaire txt v ns) = do - NewNode pid' _ <- postNode uid pid (Node' NodeAnnuaire txt v []) - pids <- mkNodeR (concat $ map (\n -> [childWith uid pid' n]) ns) - pure $ NewNode pid' pids - -postNode uid pid (Node' NodeDashboard txt v ns) = do - NewNode pid' _ <- postNode uid pid (Node' NodeDashboard txt v []) - pids <- mkNodeR (concat $ map (\n -> [childWith uid pid' n]) ns) - pure $ NewNode pid' pids - -postNode _ _ (Node' _ _ _ _) = nodeError NotImplYet - - -childWith :: 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" - - --- =================================================================== -- ------------------------------------------------------------------------- --- | TODO mk all others nodes -mkNodeWithParent :: HasNodeError err - => NodeType - -> Maybe ParentId - -> UserId - -> Name - -> Cmd err [NodeId] -mkNodeWithParent NodeUser (Just _) _ _ = nodeError UserNoParent - ------------------------------------------------------------------------- -mkNodeWithParent NodeUser Nothing uId name = - insertNodesWithParentR Nothing [node NodeUser name fake_HyperdataUser Nothing uId] - -mkNodeWithParent _ Nothing _ _ = nodeError HasParent ------------------------------------------------------------------------- -mkNodeWithParent NodeFolder (Just i) uId name = - insertNodesWithParentR (Just i) [node NodeFolder name hd Nothing uId] - where - hd = defaultFolder - -mkNodeWithParent NodeFolderPrivate (Just i) uId _ = - insertNodesWithParentR (Just i) [node NodeFolderPrivate "Private" hd Nothing uId] - where - hd = defaultFolder - -mkNodeWithParent NodeFolderShared (Just i) uId _ = - insertNodesWithParentR (Just i) [node NodeFolderShared "Shared" hd Nothing uId] - where - hd = defaultFolder - -mkNodeWithParent NodeFolderPublic (Just i) uId _ = - insertNodesWithParentR (Just i) [node NodeFolderPublic "Public" hd Nothing uId] - where - hd = defaultFolder - -mkNodeWithParent NodeTeam (Just i) uId _ = - insertNodesWithParentR (Just i) [node NodeTeam "Team" hd Nothing uId] - where - hd = defaultFolder ------------------------------------------------------------------------- -mkNodeWithParent NodeCorpus (Just i) uId name = - insertNodesWithParentR (Just i) [node NodeCorpus name hd Nothing uId] - where - hd = defaultCorpus - -mkNodeWithParent NodeAnnuaire (Just i) uId name = - insertNodesWithParentR (Just i) [node NodeAnnuaire name hd Nothing uId] - where - hd = defaultAnnuaire - -mkNodeWithParent _ _ _ _ = nodeError NotImplYet ------------------------------------------------------------------------- --- =================================================================== -- - -mkRoot :: HasNodeError err - => User - -> Cmd err [RootId] -mkRoot user = do - - uid <- getUserId user - - let una = "username" - - case uid > 0 of - False -> nodeError NegativeId - True -> do - rs <- mkNodeWithParent NodeUser Nothing uid una - _ <- case rs of - [r] -> do - _ <- mkNodeWithParent NodeFolderPrivate (Just r) uid una - _ <- mkNodeWithParent NodeFolderShared (Just r) uid una - _ <- mkNodeWithParent NodeFolderPublic (Just r) uid una - pure rs - _ -> pure rs - pure rs - --- | --- CorpusDocument is a corpus made from a set of documents --- CorpusContact is a corpus made from a set of contacts (syn of Annuaire) -data CorpusType = CorpusDocument | CorpusContact - -class MkCorpus a - where - mk :: Maybe Name -> Maybe a -> ParentId -> UserId -> Cmd err [NodeId] - -instance MkCorpus HyperdataCorpus - where - mk n h p u = insertNodesR [nodeCorpusW n h p u] - - -instance MkCorpus HyperdataAnnuaire - where - mk n h p u = insertNodesR [nodeAnnuaireW n h p u] - - -getOrMkList :: HasNodeError err => ParentId -> UserId -> Cmd err ListId -getOrMkList pId uId = - maybe (mkList' pId uId) (pure . view node_id) . headMay =<< getListsWithParentId pId - where - mkList' pId uId = maybe (nodeError MkNode) pure . headMay =<< mkNode NodeList pId uId - --- | TODO remove defaultList -defaultList :: HasNodeError err => CorpusId -> Cmd err ListId -defaultList cId = - maybe (nodeError NoListFound) (pure . view node_id) . headMay =<< getListsWithParentId cId - -mkNode :: NodeType -> ParentId -> UserId -> Cmd err [NodeId] -mkNode nt p u = insertNodesR [nodeDefault nt p u] - -mkDashboard :: ParentId -> UserId -> Cmd err [NodeId] -mkDashboard p u = insertNodesR [nodeDashboardW Nothing Nothing p u] - where - nodeDashboardW :: Maybe Name -> Maybe HyperdataDashboard -> ParentId -> UserId -> NodeWrite - nodeDashboardW maybeName maybeDashboard pId = node NodeDashboard name dashboard (Just pId) - where - name = maybe "Board" identity maybeName - dashboard = maybe arbitraryDashboard identity maybeDashboard - - -mkPhylo :: ParentId -> UserId -> Cmd err [NodeId] -mkPhylo p u = insertNodesR [nodePhyloW Nothing Nothing p u] - --- | Default CorpusId Master and ListId Master - -pgNodeId :: NodeId -> Column PGInt4 -pgNodeId = pgInt4 . id2int - -getListsWithParentId :: NodeId -> Cmd err [Node HyperdataList] -getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList) - - --- import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata) --- updateNodeUser_fake :: NodeId -> Cmd err Int64 --- updateNodeUser_fake n = updateHyperdata n fake_HyperdataUser - - diff --git a/src/Gargantext/Database/Tree.hs b/src/Gargantext/Database/Tree.hs deleted file mode 100644 index b7d83cdd..00000000 --- a/src/Gargantext/Database/Tree.hs +++ /dev/null @@ -1,157 +0,0 @@ -{-| -Module : Gargantext.Database.Tree -Description : Tree of Resource Nodes built from Database -Copyright : (c) CNRS, 2017-Present -License : AGPL + CECILL v3 -Maintainer : team@gargantext.org -Stability : experimental -Portability : POSIX - -Let a Root Node, return the Tree of the Node as a directed acyclic graph -(Tree). - --} - -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE RankNTypes #-} - -module Gargantext.Database.Tree - ( treeDB - , TreeError(..) - , HasTreeError(..) - , dbTree - , toNodeTree - , DbTreeNode - , isDescendantOf - , isIn - ) where - -import Control.Lens (Prism', (#), (^..), at, each, _Just, to) -import Control.Monad.Error.Class (MonadError(throwError)) -import Data.Map (Map, fromListWith, lookup) -import Data.Text (Text) -import Database.PostgreSQL.Simple -import Database.PostgreSQL.Simple.SqlQQ - -import Gargantext.Prelude -import Gargantext.Core.Types.Main (NodeTree(..), Tree(..)) -import Gargantext.Database.Config (fromNodeTypeId, nodeTypeId) -import Gargantext.Database.Types.Node (NodeId, NodeType, DocId, allNodeTypes) -import Gargantext.Database.Utils (Cmd, runPGSQuery) ------------------------------------------------------------------------- --- import Gargantext.Database.Utils (runCmdDev) --- treeTest :: IO (Tree NodeTree) --- treeTest = runCmdDev $ treeDB 347474 ------------------------------------------------------------------------- - -data TreeError = NoRoot | EmptyRoot | TooManyRoots - deriving (Show) - -class HasTreeError e where - _TreeError :: Prism' e TreeError - -treeError :: (MonadError e m, HasTreeError e) => TreeError -> m a -treeError te = throwError $ _TreeError # te - --- | Returns the Tree of Nodes in Database -treeDB :: HasTreeError err => RootId -> [NodeType] -> Cmd err (Tree NodeTree) -treeDB r nodeTypes = toTree =<< (toTreeParent <$> dbTree r nodeTypes) - -type RootId = NodeId -type ParentId = NodeId ------------------------------------------------------------------------- -toTree :: (MonadError e m, HasTreeError e) - => Map (Maybe ParentId) [DbTreeNode] -> m (Tree NodeTree) -toTree m = - case lookup Nothing m of - Just [n] -> pure $ toTree' m n - Nothing -> treeError NoRoot - Just [] -> treeError EmptyRoot - Just _ -> treeError TooManyRoots - -toTree' :: Map (Maybe ParentId) [DbTreeNode] -> DbTreeNode -> Tree NodeTree -toTree' m n = - TreeN (toNodeTree n) $ - m ^.. at (Just $ dt_nodeId n) . _Just . each . to (toTree' m) - ------------------------------------------------------------------------- -toNodeTree :: DbTreeNode -> NodeTree -toNodeTree (DbTreeNode nId tId _ n) = NodeTree n nodeType nId - where - nodeType = fromNodeTypeId tId ------------------------------------------------------------------------- -toTreeParent :: [DbTreeNode] -> Map (Maybe ParentId) [DbTreeNode] -toTreeParent = fromListWith (<>) . map (\n -> (dt_parentId n, [n])) ------------------------------------------------------------------------- -data DbTreeNode = DbTreeNode { dt_nodeId :: NodeId - , dt_typeId :: Int - , dt_parentId :: Maybe NodeId - , dt_name :: Text - } deriving (Show) - --- | Main DB Tree function --- TODO add typenames as parameters -dbTree :: RootId -> [NodeType] -> Cmd err [DbTreeNode] -dbTree rootId nodeTypes = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n) - <$> runPGSQuery [sql| - WITH RECURSIVE - tree (id, typename, parent_id, name) AS - ( - SELECT p.id, p.typename, p.parent_id, p.name - FROM nodes AS p - WHERE p.id = ? - - UNION - - SELECT c.id, c.typename, c.parent_id, c.name - FROM nodes AS c - - INNER JOIN tree AS s ON c.parent_id = s.id - WHERE c.typename IN ? - ) - SELECT * from tree; - |] (rootId, In typename) - where - typename = map nodeTypeId ns - ns = case nodeTypes of - [] -> allNodeTypes - -- [2, 20, 21, 22, 3, 5, 30, 31, 40, 7, 9, 90, 71] - _ -> nodeTypes - -isDescendantOf :: NodeId -> RootId -> Cmd err Bool -isDescendantOf childId rootId = (== [Only True]) - <$> runPGSQuery [sql| - BEGIN ; - SET TRANSACTION READ ONLY; - COMMIT; - - WITH RECURSIVE - tree (id, parent_id) AS - ( - SELECT c.id, c.parent_id - FROM nodes AS c - WHERE c.id = ? - - UNION - - SELECT p.id, p.parent_id - FROM nodes AS p - INNER JOIN tree AS t ON t.parent_id = p.id - - ) - SELECT COUNT(*) = 1 from tree AS t - WHERE t.id = ?; - |] (childId, rootId) - --- TODO should we check the category? -isIn :: NodeId -> DocId -> Cmd err Bool -isIn cId docId = ( == [Only True]) - <$> runPGSQuery [sql| SELECT COUNT(*) = 1 - FROM nodes_nodes nn - WHERE nn.node1_id = ? - AND nn.node2_id = ?; - |] (cId, docId) - - -- 2.47.0 From 64eb199f820f866bb88e5add9a7d3114a8a181df Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Sat, 11 Apr 2020 08:07:46 +0200 Subject: [PATCH 04/16] [FIX] Missing files --- src/Gargantext/Core/Flow/Ngrams.hs | 22 + src/Gargantext/Database/Admin/Types/Errors.hs | 55 ++ src/Gargantext/Database/Query/Node.hs | 513 ++++++++++++++++++ src/Gargantext/Database/Query/Tree.hs | 184 +++++++ src/Gargantext/Database/Query/Tree/Root.hs | 59 ++ src/Gargantext/Database/Query/User.hs | 106 ++++ 6 files changed, 939 insertions(+) create mode 100644 src/Gargantext/Core/Flow/Ngrams.hs create mode 100644 src/Gargantext/Database/Admin/Types/Errors.hs create mode 100644 src/Gargantext/Database/Query/Node.hs create mode 100644 src/Gargantext/Database/Query/Tree.hs create mode 100644 src/Gargantext/Database/Query/Tree/Root.hs create mode 100644 src/Gargantext/Database/Query/User.hs diff --git a/src/Gargantext/Core/Flow/Ngrams.hs b/src/Gargantext/Core/Flow/Ngrams.hs new file mode 100644 index 00000000..832dabd9 --- /dev/null +++ b/src/Gargantext/Core/Flow/Ngrams.hs @@ -0,0 +1,22 @@ +{-| +Module : Gargantext.Core.Flow.Ngrams +Description : Core Flow main fun for Ngrams +Copyright : (c) CNRS, 2017-Present +License : AGPL + CECILL v3 +Maintainer : team@gargantext.org +Stability : experimental +Portability : POSIX + +-} + +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ConstrainedClassMethods #-} + +module Gargantext.Core.Flow.Ngrams where + +-- import Gargantext.Text.Terms.WithList (filterWith) + + + diff --git a/src/Gargantext/Database/Admin/Types/Errors.hs b/src/Gargantext/Database/Admin/Types/Errors.hs new file mode 100644 index 00000000..bdbe5065 --- /dev/null +++ b/src/Gargantext/Database/Admin/Types/Errors.hs @@ -0,0 +1,55 @@ +{-| +Module : Gargantext.Database.Types.Errors +Description : Main requests of Node to the database +Copyright : (c) CNRS, 2017-Present +License : AGPL + CECILL v3 +Maintainer : team@gargantext.org +Stability : experimental +Portability : POSIX +-} + +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +{-# LANGUAGE Arrows #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Gargantext.Database.Admin.Types.Errors where + +import Control.Lens (Prism', (#), (^?)) +import Control.Monad.Error.Class (MonadError(..)) +import Gargantext.Prelude hiding (sum, head) +import Prelude hiding (null, id, map, sum) + +------------------------------------------------------------------------ +data NodeError = NoListFound + | NoRootFound + | NoCorpusFound + | NoUserFound + | MkNode + | UserNoParent + | HasParent + | ManyParents + | NegativeId + | NotImplYet + | ManyNodeUsers + deriving (Show) + +class HasNodeError e where + _NodeError :: Prism' e NodeError + +nodeError :: (MonadError e m, HasNodeError e) => NodeError -> m a +nodeError ne = throwError $ _NodeError # ne + +catchNodeError :: (MonadError e m, HasNodeError e) => m a -> (NodeError -> m a) -> m a +catchNodeError f g = catchError f (\e -> maybe (throwError e) g (e ^? _NodeError)) diff --git a/src/Gargantext/Database/Query/Node.hs b/src/Gargantext/Database/Query/Node.hs new file mode 100644 index 00000000..b9589e1d --- /dev/null +++ b/src/Gargantext/Database/Query/Node.hs @@ -0,0 +1,513 @@ +{-| +Module : Gargantext.Database.Tools.Node +Description : Main Tools of Node to the database +Copyright : (c) CNRS, 2017-Present +License : AGPL + CECILL v3 +Maintainer : team@gargantext.org +Stability : experimental +Portability : POSIX +-} + +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +{-# LANGUAGE Arrows #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Gargantext.Database.Query.Node where + +import Control.Arrow (returnA) +import Control.Lens (set, view) +import Control.Lens.TH (makeLensesWith, abbreviatedFields) +import Data.Aeson +import Data.Maybe (Maybe(..), fromMaybe) +import Data.Profunctor.Product.TH (makeAdaptorAndInstance) +import Data.Text (Text) +import Database.PostgreSQL.Simple.FromField (FromField, fromField) +import GHC.Int (Int64) +import Gargantext.Core.Types +import Gargantext.Core.Types.Individu (User(..)) +import Gargantext.Database.Config (nodeTypeId) +import Gargantext.Database.Node.Contact (HyperdataContact(..), arbitraryHyperdataContact) +import Gargantext.Database.Query.Filter (limit', offset') +import Gargantext.Database.Schema.Node +import Gargantext.Database.Types.Errors +import Gargantext.Database.Types.Node (NodeType(..), defaultCorpus, Hyperdata, HyperData(..)) +import Gargantext.Database.Utils +import Gargantext.Prelude hiding (sum, head) +import Gargantext.Viz.Graph (HyperdataGraph(..)) +import Opaleye hiding (FromField) +import Opaleye.Internal.QueryArr (Query) +import Prelude hiding (null, id, map, sum) + + +pgNodeId :: NodeId -> Column PGInt4 +pgNodeId = pgInt4 . id2int + +queryNodeSearchTable :: Query NodeSearchRead +queryNodeSearchTable = queryTable nodeTableSearch + +selectNode :: Column PGInt4 -> Query NodeRead +selectNode id = proc () -> do + row <- queryNodeTable -< () + restrict -< _node_id row .== id + returnA -< row + + + +runGetNodes :: Query NodeRead -> Cmd err [Node HyperdataAny] +runGetNodes = runOpaQuery + +------------------------------------------------------------------------ +------------------------------------------------------------------------ +-- | order by publication date +-- Favorites (Bool), node_ngrams +selectNodesWith :: 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 + limit' maybeLimit $ offset' maybeOffset + $ orderBy (asc _node_id) + $ selectNodesWith' parentId maybeNodeType + +selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead +selectNodesWith' parentId maybeNodeType = proc () -> do + node <- (proc () -> do + row@(Node _ typeId _ parentId' _ _ _) <- queryNodeTable -< () + restrict -< parentId' .== (pgNodeId parentId) + + let typeId' = maybe 0 nodeTypeId maybeNodeType + + restrict -< if typeId' > 0 + then typeId .== (pgInt4 (typeId' :: Int)) + else (pgBool True) + returnA -< row ) -< () + returnA -< node + +deleteNode :: NodeId -> Cmd err Int +deleteNode n = mkCmd $ \conn -> + fromIntegral <$> runDelete conn nodeTable + (\(Node n_id _ _ _ _ _ _) -> n_id .== pgNodeId n) + +deleteNodes :: [NodeId] -> Cmd err Int +deleteNodes ns = mkCmd $ \conn -> + fromIntegral <$> runDelete conn nodeTable + (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgNodeId ns)) n_id) + +-- TODO: NodeType should match with `a' +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 :: (Hyperdata a, QueryRunnerColumnDefault PGJsonb a) + => Maybe NodeId + -> Cmd err [Node a] +getNodesWithParentId n = runOpaQuery $ selectNodesWithParentID n' + where + n' = case n of + Just n'' -> n'' + Nothing -> 0 + +------------------------------------------------------------------------ +getDocumentsV3WithParentId :: 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 n = runOpaQuery $ selectNodesWith' n (Just NodeDocument) + +getListsModelWithParentId :: NodeId -> Cmd err [Node HyperdataListModel] +getListsModelWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeListModel) + +getCorporaWithParentId :: NodeId -> Cmd err [Node HyperdataCorpus] +getCorporaWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeCorpus) + +------------------------------------------------------------------------ +selectNodesWithParentID :: NodeId -> Query NodeRead +selectNodesWithParentID n = proc () -> do + row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< () + restrict -< parent_id .== (pgNodeId n) + returnA -< row + +selectNodesWithType :: Column PGInt4 -> Query NodeRead +selectNodesWithType type_id = proc () -> do + row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< () + restrict -< tn .== type_id + returnA -< row + +type JSONB = QueryRunnerColumnDefault PGJsonb + + +getNode :: NodeId -> Cmd err (Node Value) +getNode nId = fromMaybe (error $ "Node does not exist: " <> show nId) . headMay + <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId)) + +getNodeWith :: JSONB a => NodeId -> proxy a -> Cmd err (Node a) +getNodeWith nId _ = do + fromMaybe (error $ "Node does not exist: " <> show nId) . headMay + <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId)) + + +getNodePhylo :: NodeId -> Cmd err (Node HyperdataPhylo) +getNodePhylo nId = do + fromMaybe (error $ "Node Phylo does not exist: " <> show nId) . headMay + <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId)) + + +getNodesWithType :: Column PGInt4 -> Cmd err [Node HyperdataDocument] +getNodesWithType = runOpaQuery . selectNodesWithType + +------------------------------------------------------------------------ +nodeContactW :: Maybe Name -> Maybe HyperdataContact + -> AnnuaireId -> UserId -> NodeWrite +nodeContactW maybeName maybeContact aId = + node NodeContact name contact (Just aId) + where + name = maybe "Contact" identity maybeName + contact = maybe arbitraryHyperdataContact identity maybeContact +------------------------------------------------------------------------ +defaultFolder :: HyperdataCorpus +defaultFolder = defaultCorpus + +nodeFolderW :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> NodeWrite +nodeFolderW maybeName maybeFolder pid = node NodeFolder name folder (Just pid) + where + name = maybe "Folder" identity maybeName + folder = maybe defaultFolder identity maybeFolder +------------------------------------------------------------------------ +nodeCorpusW :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> NodeWrite +nodeCorpusW maybeName maybeCorpus pId = node NodeCorpus name corpus (Just pId) + where + name = maybe "Corpus" identity maybeName + corpus = maybe defaultCorpus identity maybeCorpus + -------------------------- +defaultDocument :: HyperdataDocument +defaultDocument = hyperdataDocument + +nodeDocumentW :: Maybe Name -> Maybe HyperdataDocument -> CorpusId -> UserId -> NodeWrite +nodeDocumentW maybeName maybeDocument cId = node NodeDocument name doc (Just cId) + where + name = maybe "Document" identity maybeName + doc = maybe defaultDocument identity maybeDocument +------------------------------------------------------------------------ +defaultAnnuaire :: HyperdataAnnuaire +defaultAnnuaire = HyperdataAnnuaire (Just "Title") (Just "Description") + +nodeAnnuaireW :: Maybe Name -> Maybe HyperdataAnnuaire -> ParentId -> UserId -> NodeWrite +nodeAnnuaireW maybeName maybeAnnuaire pId = node NodeAnnuaire name annuaire (Just pId) + where + name = maybe "Annuaire" identity maybeName + annuaire = maybe defaultAnnuaire identity maybeAnnuaire + +------------------------------------------------------------------------ + +{- +class IsNodeDb a where + data Node'' a :: * + data Hyper a :: * + +instance IsNodeDb NodeType where + data + +instance HasHyperdata NodeType where + data Hyper NodeType = HyperList HyperdataList + | HyperCorpus HyperdataCorpus + + hasHyperdata nt = case nt of + NodeList -> HyperList $ HyperdataList (Just "list") + + unHyper h = case h of + HyperList h' -> h' + +--} + + +class HasDefault a where + hasDefaultData :: a -> HyperData + hasDefaultName :: a -> Text + +instance HasDefault NodeType where + hasDefaultData nt = case nt of + NodeTexts -> HyperdataTexts (Just "Preferences") + NodeList -> HyperdataList' (Just "Preferences") + NodeListCooc -> HyperdataList' (Just "Preferences") + _ -> undefined + --NodeAnnuaire -> HyperdataAnnuaire (Just "Title") (Just "Description") + + hasDefaultName nt = case nt of + NodeTexts -> "Texts" + NodeList -> "Lists" + NodeListCooc -> "Cooc" + _ -> undefined + +------------------------------------------------------------------------ + +nodeDefault :: NodeType -> ParentId -> UserId -> NodeWrite +nodeDefault nt parent = node nt name hyper (Just parent) + where + name = (hasDefaultName nt) + hyper = (hasDefaultData nt) + +------------------------------------------------------------------------ +arbitraryListModel :: HyperdataListModel +arbitraryListModel = HyperdataListModel (400,500) "data/models/test.model" (Just 0.83) + +mkListModelNode :: HasNodeError err => ParentId -> UserId -> Cmd err [NodeId] +mkListModelNode p u = insertNodesR [nodeListModelW Nothing Nothing p u] + +nodeListModelW :: Maybe Name -> Maybe HyperdataListModel -> ParentId -> UserId -> NodeWrite +nodeListModelW maybeName maybeListModel pId = node NodeListModel name list (Just pId) + where + name = maybe "List Model" identity maybeName + list = maybe arbitraryListModel identity maybeListModel + +------------------------------------------------------------------------ +arbitraryGraph :: HyperdataGraph +arbitraryGraph = HyperdataGraph Nothing + +nodeGraphW :: Maybe Name -> Maybe HyperdataGraph -> ParentId -> UserId -> NodeWrite +nodeGraphW maybeName maybeGraph pId = node NodeGraph name graph (Just pId) + where + name = maybe "Graph" identity maybeName + graph = maybe arbitraryGraph identity maybeGraph + +mkGraph :: ParentId -> UserId -> Cmd err [GraphId] +mkGraph p u = insertNodesR [nodeGraphW Nothing Nothing p u] + +insertGraph :: ParentId -> UserId -> HyperdataGraph -> Cmd err [GraphId] +insertGraph p u h = insertNodesR [nodeGraphW Nothing (Just h) p u] + +------------------------------------------------------------------------ +arbitraryPhylo :: HyperdataPhylo +arbitraryPhylo = HyperdataPhylo Nothing Nothing + +nodePhyloW :: Maybe Name -> Maybe HyperdataPhylo -> ParentId -> UserId -> NodeWrite +nodePhyloW maybeName maybePhylo pId = node NodePhylo name graph (Just pId) + where + name = maybe "Phylo" identity maybeName + graph = maybe arbitraryPhylo identity maybePhylo + + +------------------------------------------------------------------------ +arbitraryDashboard :: HyperdataDashboard +arbitraryDashboard = HyperdataDashboard (Just "Preferences") [] +------------------------------------------------------------------------ + +node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite +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 + + ------------------------------- +insertNodes :: [NodeWrite] -> Cmd err Int64 +insertNodes ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns rCount Nothing + +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 (pgNodeId <$> 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 + +{- TODO semantic to achieve +post c uid pid [ Node' NodeCorpus "name" "{}" [] + , Node' NodeFolder "name" "{}" [Node' NodeCorpus "test 2" "" [ Node' NodeDocument "title" "metaData" [] + , Node' NodeDocument "title" "jsonData" [] + ] + ] + ] +-} +------------------------------------------------------------------------ + +-- TODO +-- 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 pgNodeId pid) (pgStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v) +node2table _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet" + + + +data Node' = Node' { _n_type :: NodeType + , _n_name :: Text + , _n_data :: Value + , _n_children :: [Node'] + } deriving (Show) + +mkNodes :: [NodeWrite] -> Cmd err Int64 +mkNodes ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns rCount Nothing + +mkNodeR :: [NodeWrite] -> Cmd err [NodeId] +mkNodeR ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns (rReturning _node_id) Nothing + +------------------------------------------------------------------------ + +data NewNode = NewNode { _newNodeId :: NodeId + , _newNodeChildren :: [NodeId] } + +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' [] + _ -> nodeError ManyParents + +postNode uid pid (Node' NodeCorpus txt v ns) = do + NewNode pid' _ <- postNode uid pid (Node' NodeCorpus txt v []) + pids <- mkNodeR (concat $ map (\n -> [childWith uid pid' n]) ns) + pure $ NewNode pid' pids + +postNode uid pid (Node' NodeAnnuaire txt v ns) = do + NewNode pid' _ <- postNode uid pid (Node' NodeAnnuaire txt v []) + pids <- mkNodeR (concat $ map (\n -> [childWith uid pid' n]) ns) + pure $ NewNode pid' pids + +postNode uid pid (Node' NodeDashboard txt v ns) = do + NewNode pid' _ <- postNode uid pid (Node' NodeDashboard txt v []) + pids <- mkNodeR (concat $ map (\n -> [childWith uid pid' n]) ns) + pure $ NewNode pid' pids + +postNode _ _ (Node' _ _ _ _) = nodeError NotImplYet + + +childWith :: 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" + + +-- =================================================================== -- +------------------------------------------------------------------------ +-- | TODO mk all others nodes +mkNodeWithParent :: HasNodeError err + => NodeType + -> Maybe ParentId + -> UserId + -> Name + -> Cmd err [NodeId] +mkNodeWithParent NodeUser (Just _) _ _ = nodeError UserNoParent + +------------------------------------------------------------------------ +mkNodeWithParent NodeUser Nothing uId name = + insertNodesWithParentR Nothing [node NodeUser name fake_HyperdataUser Nothing uId] + +mkNodeWithParent _ Nothing _ _ = nodeError HasParent +------------------------------------------------------------------------ +mkNodeWithParent NodeFolder (Just i) uId name = + insertNodesWithParentR (Just i) [node NodeFolder name hd Nothing uId] + where + hd = defaultFolder + +mkNodeWithParent NodeFolderPrivate (Just i) uId _ = + insertNodesWithParentR (Just i) [node NodeFolderPrivate "Private" hd Nothing uId] + where + hd = defaultFolder + +mkNodeWithParent NodeFolderShared (Just i) uId _ = + insertNodesWithParentR (Just i) [node NodeFolderShared "Shared" hd Nothing uId] + where + hd = defaultFolder + +mkNodeWithParent NodeFolderPublic (Just i) uId _ = + insertNodesWithParentR (Just i) [node NodeFolderPublic "Public" hd Nothing uId] + where + hd = defaultFolder + +mkNodeWithParent NodeTeam (Just i) uId _ = + insertNodesWithParentR (Just i) [node NodeTeam "Team" hd Nothing uId] + where + hd = defaultFolder +------------------------------------------------------------------------ +mkNodeWithParent NodeCorpus (Just i) uId name = + insertNodesWithParentR (Just i) [node NodeCorpus name hd Nothing uId] + where + hd = defaultCorpus + +mkNodeWithParent NodeAnnuaire (Just i) uId name = + insertNodesWithParentR (Just i) [node NodeAnnuaire name hd Nothing uId] + where + hd = defaultAnnuaire + +mkNodeWithParent _ _ _ _ = nodeError NotImplYet +------------------------------------------------------------------------ +-- =================================================================== -- +-- | +-- CorpusDocument is a corpus made from a set of documents +-- CorpusContact is a corpus made from a set of contacts (syn of Annuaire) +data CorpusType = CorpusDocument | CorpusContact + +class MkCorpus a + where + mk :: Maybe Name -> Maybe a -> ParentId -> UserId -> Cmd err [NodeId] + +instance MkCorpus HyperdataCorpus + where + mk n h p u = insertNodesR [nodeCorpusW n h p u] + + +instance MkCorpus HyperdataAnnuaire + where + mk n h p u = insertNodesR [nodeAnnuaireW n h p u] + + +getOrMkList :: HasNodeError err => ParentId -> UserId -> Cmd err ListId +getOrMkList pId uId = + maybe (mkList' pId uId) (pure . view node_id) . headMay =<< getListsWithParentId pId + where + mkList' pId uId = maybe (nodeError MkNode) pure . headMay =<< mkNode NodeList pId uId + +-- | TODO remove defaultList +defaultList :: HasNodeError err => CorpusId -> Cmd err ListId +defaultList cId = + maybe (nodeError NoListFound) (pure . view node_id) . headMay =<< getListsWithParentId cId + +mkNode :: NodeType -> ParentId -> UserId -> Cmd err [NodeId] +mkNode nt p u = insertNodesR [nodeDefault nt p u] + +mkDashboard :: ParentId -> UserId -> Cmd err [NodeId] +mkDashboard p u = insertNodesR [nodeDashboardW Nothing Nothing p u] + where + nodeDashboardW :: Maybe Name -> Maybe HyperdataDashboard -> ParentId -> UserId -> NodeWrite + nodeDashboardW maybeName maybeDashboard pId = node NodeDashboard name dashboard (Just pId) + where + name = maybe "Board" identity maybeName + dashboard = maybe arbitraryDashboard identity maybeDashboard + + +mkPhylo :: ParentId -> UserId -> Cmd err [NodeId] +mkPhylo p u = insertNodesR [nodePhyloW Nothing Nothing p u] + +getListsWithParentId :: NodeId -> Cmd err [Node HyperdataList] +getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList) + +-- import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata) +-- updateNodeUser_fake :: NodeId -> Cmd err Int64 +-- updateNodeUser_fake n = updateHyperdata n fake_HyperdataUser + diff --git a/src/Gargantext/Database/Query/Tree.hs b/src/Gargantext/Database/Query/Tree.hs new file mode 100644 index 00000000..1ae08e63 --- /dev/null +++ b/src/Gargantext/Database/Query/Tree.hs @@ -0,0 +1,184 @@ +{-| +Module : Gargantext.Database.Tree +Description : Tree of Resource Nodes built from Database +Copyright : (c) CNRS, 2017-Present +License : AGPL + CECILL v3 +Maintainer : team@gargantext.org +Stability : experimental +Portability : POSIX + +Let a Root Node, return the Tree of the Node as a directed acyclic graph +(Tree). + +-} + +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RankNTypes #-} + +module Gargantext.Database.Query.Tree + ( treeDB + , TreeError(..) + , HasTreeError(..) + , dbTree + , toNodeTree + , DbTreeNode + , isDescendantOf + , isIn + ) where + +import Control.Lens (Prism', (#), (^..), at, each, _Just, to) +import Control.Monad.Error.Class (MonadError(throwError)) +import Data.Map (Map, fromListWith, lookup) +import Data.Text (Text) +import Database.PostgreSQL.Simple +import Database.PostgreSQL.Simple.SqlQQ + +import Gargantext.Prelude +import Gargantext.Core.Types.Main (NodeTree(..), Tree(..)) +import Gargantext.Database.Config (fromNodeTypeId, nodeTypeId) +import Gargantext.Database.Types.Node (NodeId, NodeType, DocId, allNodeTypes) +import Gargantext.Database.Utils (Cmd, runPGSQuery) +import Gargantext.Database.Tools.Node +import Gargantext.Database.Tools.User + +------------------------------------------------------------------------ +-- import Gargantext.Database.Utils (runCmdDev) +-- treeTest :: IO (Tree NodeTree) +-- treeTest = runCmdDev $ treeDB 347474 +------------------------------------------------------------------------ + +mkRoot :: HasNodeError err + => User + -> Cmd err [RootId] +mkRoot user = do + + uid <- getUserId user + + let una = "username" + + case uid > 0 of + False -> nodeError NegativeId + True -> do + rs <- mkNodeWithParent NodeUser Nothing uid una + _ <- case rs of + [r] -> do + _ <- mkNodeWithParent NodeFolderPrivate (Just r) uid una + _ <- mkNodeWithParent NodeFolderShared (Just r) uid una + _ <- mkNodeWithParent NodeFolderPublic (Just r) uid una + pure rs + _ -> pure rs + pure rs + + +------------------------------------------------------------------------ +data TreeError = NoRoot | EmptyRoot | TooManyRoots + deriving (Show) + +class HasTreeError e where + _TreeError :: Prism' e TreeError + +treeError :: (MonadError e m, HasTreeError e) => TreeError -> m a +treeError te = throwError $ _TreeError # te + +-- | Returns the Tree of Nodes in Database +treeDB :: HasTreeError err => RootId -> [NodeType] -> Cmd err (Tree NodeTree) +treeDB r nodeTypes = toTree =<< (toTreeParent <$> dbTree r nodeTypes) + +type RootId = NodeId +type ParentId = NodeId +------------------------------------------------------------------------ +toTree :: (MonadError e m, HasTreeError e) + => Map (Maybe ParentId) [DbTreeNode] -> m (Tree NodeTree) +toTree m = + case lookup Nothing m of + Just [n] -> pure $ toTree' m n + Nothing -> treeError NoRoot + Just [] -> treeError EmptyRoot + Just _ -> treeError TooManyRoots + +toTree' :: Map (Maybe ParentId) [DbTreeNode] -> DbTreeNode -> Tree NodeTree +toTree' m n = + TreeN (toNodeTree n) $ + m ^.. at (Just $ dt_nodeId n) . _Just . each . to (toTree' m) + +------------------------------------------------------------------------ +toNodeTree :: DbTreeNode -> NodeTree +toNodeTree (DbTreeNode nId tId _ n) = NodeTree n nodeType nId + where + nodeType = fromNodeTypeId tId +------------------------------------------------------------------------ +toTreeParent :: [DbTreeNode] -> Map (Maybe ParentId) [DbTreeNode] +toTreeParent = fromListWith (<>) . map (\n -> (dt_parentId n, [n])) +------------------------------------------------------------------------ +data DbTreeNode = DbTreeNode { dt_nodeId :: NodeId + , dt_typeId :: Int + , dt_parentId :: Maybe NodeId + , dt_name :: Text + } deriving (Show) + +-- | Main DB Tree function +-- TODO add typenames as parameters +dbTree :: RootId -> [NodeType] -> Cmd err [DbTreeNode] +dbTree rootId nodeTypes = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n) + <$> runPGSQuery [sql| + WITH RECURSIVE + tree (id, typename, parent_id, name) AS + ( + SELECT p.id, p.typename, p.parent_id, p.name + FROM nodes AS p + WHERE p.id = ? + + UNION + + SELECT c.id, c.typename, c.parent_id, c.name + FROM nodes AS c + + INNER JOIN tree AS s ON c.parent_id = s.id + WHERE c.typename IN ? + ) + SELECT * from tree; + |] (rootId, In typename) + where + typename = map nodeTypeId ns + ns = case nodeTypes of + [] -> allNodeTypes + -- [2, 20, 21, 22, 3, 5, 30, 31, 40, 7, 9, 90, 71] + _ -> nodeTypes + +isDescendantOf :: NodeId -> RootId -> Cmd err Bool +isDescendantOf childId rootId = (== [Only True]) + <$> runPGSQuery [sql| + BEGIN ; + SET TRANSACTION READ ONLY; + COMMIT; + + WITH RECURSIVE + tree (id, parent_id) AS + ( + SELECT c.id, c.parent_id + FROM nodes AS c + WHERE c.id = ? + + UNION + + SELECT p.id, p.parent_id + FROM nodes AS p + INNER JOIN tree AS t ON t.parent_id = p.id + + ) + SELECT COUNT(*) = 1 from tree AS t + WHERE t.id = ?; + |] (childId, rootId) + +-- TODO should we check the category? +isIn :: NodeId -> DocId -> Cmd err Bool +isIn cId docId = ( == [Only True]) + <$> runPGSQuery [sql| SELECT COUNT(*) = 1 + FROM nodes_nodes nn + WHERE nn.node1_id = ? + AND nn.node2_id = ?; + |] (cId, docId) + + diff --git a/src/Gargantext/Database/Query/Tree/Root.hs b/src/Gargantext/Database/Query/Tree/Root.hs new file mode 100644 index 00000000..78f32cdb --- /dev/null +++ b/src/Gargantext/Database/Query/Tree/Root.hs @@ -0,0 +1,59 @@ +{-| +Module : Gargantext.Database.Root +Description : Main requests to get root of users +Copyright : (c) CNRS, 2017-Present +License : AGPL + CECILL v3 +Maintainer : team@gargantext.org +Stability : experimental +Portability : POSIX +-} + +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +{-# LANGUAGE Arrows #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} + +module Gargantext.Database.Query.Tree.Root where + +import Control.Arrow (returnA) +import Gargantext.Core.Types.Individu (User(..)) +import Gargantext.Database.Config (nodeTypeId) +import Gargantext.Database.Node.User (HyperdataUser) +import Gargantext.Database.Schema.Node (NodeRead) +import Gargantext.Database.Schema.Node (queryNodeTable) +import Gargantext.Database.Schema.User (queryUserTable, UserPoly(..)) +import Gargantext.Database.Types.Node (Node, NodePoly(..), NodeType(NodeUser)) +import Gargantext.Database.Utils (Cmd, runOpaQuery) +import Gargantext.Prelude +import Opaleye (restrict, (.==), Query) +import Opaleye.PGTypes (pgStrictText, pgInt4) + +getRoot :: User -> Cmd err [Node HyperdataUser] +getRoot = runOpaQuery . selectRoot + +selectRoot :: User -> Query NodeRead +selectRoot (UserName username) = proc () -> do + row <- queryNodeTable -< () + users <- queryUserTable -< () + restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser) + restrict -< user_username users .== (pgStrictText username) + restrict -< _node_userId row .== (user_id users) + returnA -< row + +selectRoot (UserDBId uid) = proc () -> do + row <- queryNodeTable -< () + restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser) + restrict -< _node_userId row .== (pgInt4 uid) + returnA -< row + diff --git a/src/Gargantext/Database/Query/User.hs b/src/Gargantext/Database/Query/User.hs new file mode 100644 index 00000000..85bb5845 --- /dev/null +++ b/src/Gargantext/Database/Query/User.hs @@ -0,0 +1,106 @@ +{-| +Module : Gargantext.Database.user +Description : User Database management tools +Copyright : (c) CNRS, 2017-Present +License : AGPL + CECILL v3 +Maintainer : team@gargantext.org +Stability : experimental +Portability : POSIX + +Functions to deal with users, database side. +-} + +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE Arrows #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} + +module Gargantext.Database.Query.Tools.User + where + +import Control.Arrow (returnA) +import Control.Lens.TH (makeLensesWith, abbreviatedFields) +import Data.Eq(Eq(..)) +import Data.List (find) +import Data.Maybe (Maybe) +import Data.Profunctor.Product.TH (makeAdaptorAndInstance) +import Data.Text (Text) +import Data.Time (UTCTime) +import GHC.Show(Show(..)) +import Gargantext.Core.Types.Individu (Username, arbitraryUsername, User(..), UserId) +import Gargantext.Database.Types.Errors +import Gargantext.Database.Schema.User +import Gargantext.Database.Utils +import Gargantext.Prelude +import Opaleye + +------------------------------------------------------------------------ +-- TODO: on conflict, nice message +insertUsers :: [UserWrite] -> Cmd err Int64 +insertUsers us = mkCmd $ \c -> runInsert_ c insert + where + insert = Insert userTable us rCount Nothing + + +gargantextUser :: Username -> UserWrite +gargantextUser u = UserDB (Nothing) (pgStrictText "password") + (Nothing) (pgBool True) (pgStrictText u) + (pgStrictText "first_name") + (pgStrictText "last_name") + (pgStrictText "e@mail") + (pgBool True) (pgBool True) (Nothing) + +insertUsersDemo :: Cmd err Int64 +insertUsersDemo = insertUsers $ map (\u -> gargantextUser u) arbitraryUsername + +------------------------------------------------------------------ +queryUserTable :: Query UserRead +queryUserTable = queryTable userTable + +selectUsersLight :: Query UserRead +selectUsersLight = proc () -> do + row@(UserDB i _p _ll _is _un _fn _ln _m _iff _ive _dj) <- queryUserTable -< () + restrict -< i .== 1 + --returnA -< User i p ll is un fn ln m iff ive dj + returnA -< row +------------------------------------------------------------------ +-- | Select User with some parameters +-- Not optimized version +userWith :: (Eq a1, Foldable t) => (a -> a1) -> a1 -> t a -> Maybe a +userWith f t xs = find (\x -> f x == t) xs + +-- | Select User with Username +userWithUsername :: Text -> [UserDB] -> Maybe UserDB +userWithUsername t xs = userWith user_username t xs + +userWithId :: Int -> [UserDB] -> Maybe UserDB +userWithId t xs = userWith user_id t xs + +userLightWithUsername :: Text -> [UserLight] -> Maybe UserLight +userLightWithUsername t xs = userWith userLight_username t xs + +userLightWithId :: Int -> [UserLight] -> Maybe UserLight +userLightWithId t xs = userWith userLight_id t xs + + +instance QueryRunnerColumnDefault PGTimestamptz (Maybe UTCTime) where + queryRunnerColumnDefault = fieldQueryRunnerColumn + + +users :: Cmd err [UserDB] +users = runOpaQuery queryUserTable + +usersLight :: Cmd err [UserLight] +usersLight = map toUserLight <$> users + +getUser :: Username -> Cmd err (Maybe UserLight) +getUser u = userLightWithUsername u <$> usersLight + -- 2.47.0 From abdfbed2ba740425db6c387e5b4e9ab7c1a8e053 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Sat, 11 Apr 2020 08:08:08 +0200 Subject: [PATCH 05/16] [GIT] ignoring *sql --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 1fb1ddd9..4f3c74d9 100644 --- a/.gitignore +++ b/.gitignore @@ -23,6 +23,7 @@ doc deps _darcs *.pdf +*.sql # Runtime -- 2.47.0 From fe40f925162db71621be8f2ad94353259ffb2c3b Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Sat, 11 Apr 2020 21:57:19 +0200 Subject: [PATCH 06/16] [ADM] ini file fixed --- .gitignore | 1 + gargantext.ini | 68 ----------------------------------------- gargantext.ini_toModify | 30 ++++++++++++++++++ 3 files changed, 31 insertions(+), 68 deletions(-) delete mode 100644 gargantext.ini create mode 100644 gargantext.ini_toModify diff --git a/.gitignore b/.gitignore index 4f3c74d9..0f676cf3 100644 --- a/.gitignore +++ b/.gitignore @@ -24,6 +24,7 @@ deps _darcs *.pdf *.sql +*.ini # Runtime diff --git a/gargantext.ini b/gargantext.ini deleted file mode 100644 index d8de2ddf..00000000 --- a/gargantext.ini +++ /dev/null @@ -1,68 +0,0 @@ -[gargantext] -MASTER_USER = gargantua - -[django] - -# SECURITY WARNING: don't run with debug turned on in production! -DEBUG = True -# SECURITY WARNING: keep the secret key used in production secret! -SECRET_KEY = %4{Vs(Pc!GU-]@OaAl0)(*4/yERwU Date: Sat, 11 Apr 2020 22:03:50 +0200 Subject: [PATCH 07/16] [ADM] doc for gargantext.ini --- README.md | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/README.md b/README.md index 6ca2c9fc..9d6cea7f 100644 --- a/README.md +++ b/README.md @@ -65,6 +65,17 @@ Initialization schema should be loaded automatically (from `devops/postgres/sche #### Gargantext +##### Fix the passwords + +Change the passwords in gargantext.ini_toModify then move it: + +mv gargantext.ini_toModify gargantext.ini + +(.gitignore avoids adding this file to the repository by mistake) + + +##### Run Gargantext + Users have to be created first (`user1` is created as instance): ``` sh -- 2.47.0 From 705f5759fdbb8da9db0deecb91913d70b04e45ee Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Sun, 12 Apr 2020 07:58:40 +0200 Subject: [PATCH 08/16] [FACTO/WIP] files org and import fix in Database/* --- src/Gargantext/Database.hs | 2 +- src/Gargantext/Database/Action/Flow.hs | 24 ++++---- src/Gargantext/Database/Action/Flow/List.hs | 9 +-- .../Database/Action/Flow/Pairing.hs | 26 ++++---- src/Gargantext/Database/Action/Flow/Types.hs | 6 +- src/Gargantext/Database/Action/Flow/Utils.hs | 10 +-- src/Gargantext/Database/Action/Learn.hs | 11 ++-- src/Gargantext/Database/Action/Metrics.hs | 12 ++-- .../Database/Action/Metrics/Lists.hs | 5 +- .../Database/Action/Metrics/NgramsByNode.hs | 8 +-- .../Database/{ => Action}/Query/Facet.hs | 16 +++-- .../Database/{ => Action}/Query/Filter.hs | 3 +- .../Database/{ => Action}/Query/Join.hs | 7 +-- .../Database/{ => Action}/Query/Ngrams.hs | 12 ++-- .../Database/{ => Action}/Query/Node.hs | 13 ++-- .../{ => Action}/Query/Node/Children.hs | 19 +++--- .../{ => Action}/Query/Node/Contact.hs | 6 +- .../{ => Action}/Query/Node/Document/Add.hs | 12 ++-- .../Query/Node/Document/Insert.hs | 18 +++--- .../{ => Action}/Query/Node/Select.hs | 12 ++-- .../{ => Action}/Query/Node/Update.hs | 7 +-- .../{ => Action}/Query/Node/UpdateOpaleye.hs | 7 ++- .../Database/{ => Action}/Query/Node/User.hs | 12 ++-- .../Database/{ => Action}/Query/Tree.hs | 10 +-- .../Database/{ => Action}/Query/Tree/Root.hs | 11 ++-- .../Database/{ => Action}/Query/User.hs | 6 +- src/Gargantext/Database/Action/Search.hs | 26 ++++---- src/Gargantext/Database/Admin/Bashql.hs | 4 +- src/Gargantext/Database/Admin/Config.hs | 8 +-- src/Gargantext/Database/Admin/Trigger/Init.hs | 10 +-- .../Database/Admin/Trigger/NodeNodeNgrams.hs | 7 +-- .../Database/Admin/Trigger/Nodes.hs | 7 +-- .../Database/Admin/Trigger/NodesNodes.hs | 6 +- src/Gargantext/Database/Admin/Types/Node.hs | 61 ++++++++----------- src/Gargantext/Database/Admin/Utils.hs | 11 ++-- .../Database/{Admin => }/Schema/Ngrams.hs | 10 +-- .../Database/{Admin => }/Schema/Node.hs | 12 ++-- .../Database/{Admin => }/Schema/NodeNgrams.hs | 21 +++---- .../Database/{Admin => }/Schema/NodeNode.hs | 20 +++--- .../{Admin => }/Schema/NodeNodeNgrams.hs | 8 +-- .../{Admin => }/Schema/NodeNodeNgrams2.hs | 12 ++-- .../Schema/Node_NodeNgramsNodeNgrams.hs | 8 +-- .../{Admin => }/Schema/NodesNgramsRepo.hs | 6 +- .../Database/{Admin => }/Schema/User.hs | 6 +- src/Gargantext/Ext/IMTUser.hs | 2 +- 45 files changed, 255 insertions(+), 274 deletions(-) rename src/Gargantext/Database/{ => Action}/Query/Facet.hs (96%) rename src/Gargantext/Database/{ => Action}/Query/Filter.hs (94%) rename src/Gargantext/Database/{ => Action}/Query/Join.hs (99%) rename src/Gargantext/Database/{ => Action}/Query/Ngrams.hs (88%) rename src/Gargantext/Database/{ => Action}/Query/Node.hs (98%) rename src/Gargantext/Database/{ => Action}/Query/Node/Children.hs (88%) rename src/Gargantext/Database/{ => Action}/Query/Node/Contact.hs (97%) rename src/Gargantext/Database/{ => Action}/Query/Node/Document/Add.hs (94%) rename src/Gargantext/Database/{ => Action}/Query/Node/Document/Insert.hs (96%) rename src/Gargantext/Database/{ => Action}/Query/Node/Select.hs (89%) rename src/Gargantext/Database/{ => Action}/Query/Node/Update.hs (89%) rename src/Gargantext/Database/{ => Action}/Query/Node/UpdateOpaleye.hs (87%) rename src/Gargantext/Database/{ => Action}/Query/Node/User.hs (93%) rename src/Gargantext/Database/{ => Action}/Query/Tree.hs (95%) rename src/Gargantext/Database/{ => Action}/Query/Tree/Root.hs (85%) rename src/Gargantext/Database/{ => Action}/Query/User.hs (96%) rename src/Gargantext/Database/{Admin => }/Schema/Ngrams.hs (98%) rename src/Gargantext/Database/{Admin => }/Schema/Node.hs (95%) rename src/Gargantext/Database/{Admin => }/Schema/NodeNgrams.hs (98%) rename src/Gargantext/Database/{Admin => }/Schema/NodeNode.hs (97%) rename src/Gargantext/Database/{Admin => }/Schema/NodeNodeNgrams.hs (94%) rename src/Gargantext/Database/{Admin => }/Schema/NodeNodeNgrams2.hs (93%) rename src/Gargantext/Database/{Admin => }/Schema/Node_NodeNgramsNodeNgrams.hs (94%) rename src/Gargantext/Database/{Admin => }/Schema/NodesNgramsRepo.hs (93%) rename src/Gargantext/Database/{Admin => }/Schema/User.hs (97%) diff --git a/src/Gargantext/Database.hs b/src/Gargantext/Database.hs index 3e6fe7d4..91cdd67b 100644 --- a/src/Gargantext/Database.hs +++ b/src/Gargantext/Database.hs @@ -21,5 +21,5 @@ module Gargantext.Database ( module Gargantext.Database.Utils ) where -import Gargantext.Database.Utils (connectGargandb) +import Gargantext.Database.Admin.Utils (connectGargandb) -- import Gargantext.Database.Bashql diff --git a/src/Gargantext/Database/Action/Flow.hs b/src/Gargantext/Database/Action/Flow.hs index a6791b47..9cf8a115 100644 --- a/src/Gargantext/Database/Action/Flow.hs +++ b/src/Gargantext/Database/Action/Flow.hs @@ -53,22 +53,22 @@ import Gargantext.Core.Flow.Types import Gargantext.Core.Types (NodePoly(..), Terms(..)) import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Core.Types.Main -import Gargantext.Database.Config (userMaster, corpusMasterName) -import Gargantext.Database.Flow.List -import Gargantext.Database.Flow.Types -import Gargantext.Database.Flow.Utils (insertDocNgrams) -import Gargantext.Database.Node.Contact -- (HyperdataContact(..), ContactWho(..)) -import Gargantext.Database.Node.Document.Insert -- (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..)) -import Gargantext.Database.Root (getRoot) +import Gargantext.Database.Action.Flow.List +import Gargantext.Database.Action.Flow.Types +import Gargantext.Database.Action.Flow.Utils (insertDocNgrams) +import Gargantext.Database.Action.Query.Node.Contact -- (HyperdataContact(..), ContactWho(..)) +import Gargantext.Database.Action.Query.Node.Document.Insert -- (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..)) +import Gargantext.Database.Action.Root (getRoot) +import Gargantext.Database.Action.Search (searchInDatabase) +import Gargantext.Database.Admin.Config (userMaster, corpusMasterName) +import Gargantext.Database.Admin.Types.Errors (HasNodeError(..), NodeError(..), nodeError) +import Gargantext.Database.Admin.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId) +import Gargantext.Database.Admin.Utils (Cmd) import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams, NgramsType(..), text2ngrams, ngramsTypeId) import Gargantext.Database.Schema.Node -- (mkRoot, mkCorpus, getOrMkList, mkGraph, {-mkPhylo,-} mkDashboard, mkAnnuaire, getCorporaWithParentId, HasNodeError, NodeError(..), nodeError) import Gargantext.Database.Schema.NodeNgrams (listInsertDb , getCgramsId) import Gargantext.Database.Schema.NodeNodeNgrams2 -- (NodeNodeNgrams2, insertNodeNodeNgrams2) import Gargantext.Database.Schema.User (getUserId) -import Gargantext.Database.TextSearch (searchInDatabase) -import Gargantext.Database.Types.Errors (HasNodeError(..), NodeError(..), nodeError) -import Gargantext.Database.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId) -import Gargantext.Database.Utils (Cmd) import Gargantext.Ext.IMT (toSchoolName) import Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile) import Gargantext.Prelude @@ -83,7 +83,7 @@ import System.FilePath (FilePath) import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Text as Text -import qualified Gargantext.Database.Node.Document.Add as Doc (add) +import qualified Gargantext.Database.Action.Query.Node.Document.Add as Doc (add) import qualified Gargantext.Text.Corpus.API.Isidore as Isidore import qualified Gargantext.Text.Corpus.Parsers.GrandDebat as GD diff --git a/src/Gargantext/Database/Action/Flow/List.hs b/src/Gargantext/Database/Action/Flow/List.hs index 7c78f361..44f26f05 100644 --- a/src/Gargantext/Database/Action/Flow/List.hs +++ b/src/Gargantext/Database/Action/Flow/List.hs @@ -23,17 +23,18 @@ Portability : POSIX module Gargantext.Database.Action.Flow.List where -import Data.Text (Text) + import Control.Monad (mapM_) import Data.Map (Map, toList) import Data.Maybe (Maybe(..), catMaybes) +import Data.Text (Text) import Gargantext.API.Ngrams (NgramsElement(..), putListNgrams) -import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams, NgramsType(..), text2ngrams, ngramsTypeId) import Gargantext.Core.Types.Main (ListType(CandidateTerm)) +import Gargantext.Database.Action.Flow.Types +import Gargantext.Database.Admin.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId) +import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams, NgramsType(..), text2ngrams, ngramsTypeId) import Gargantext.Database.Schema.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb, getCgramsId) import Gargantext.Database.Schema.Node_NodeNgramsNodeNgrams -- (insert_Node_NodeNgrams_NodeNgrams, Node_NodeNgrams_NodeNgrams(..)) -import Gargantext.Database.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId) -import Gargantext.Database.Flow.Types import Gargantext.Prelude import qualified Data.List as List import qualified Data.Map as Map diff --git a/src/Gargantext/Database/Action/Flow/Pairing.hs b/src/Gargantext/Database/Action/Flow/Pairing.hs index baec0b47..39d89171 100644 --- a/src/Gargantext/Database/Action/Flow/Pairing.hs +++ b/src/Gargantext/Database/Action/Flow/Pairing.hs @@ -20,26 +20,22 @@ module Gargantext.Database.Action.Flow.Pairing (pairing) where ---import Debug.Trace (trace) import Control.Lens (_Just, (^.)) -import Database.PostgreSQL.Simple.SqlQQ (sql) --- import Opaleye --- import Opaleye.Aggregate --- import Control.Arrow (returnA) -import Data.Maybe (catMaybes) import Data.Map (Map, fromList) -import Safe (lastMay) -import qualified Data.Map as DM +import Data.Maybe (catMaybes) import Data.Text (Text, toLower) -import qualified Data.Text as DT -import Gargantext.Prelude hiding (sum) +import Database.PostgreSQL.Simple.SqlQQ (sql) import Gargantext.Core.Types (TableResult(..)) -import Gargantext.Database.Schema.Ngrams -- (NgramsType(..)) -import Gargantext.Database.Node.Contact -- (HyperdataContact(..)) -import Gargantext.Database.Flow.Utils -import Gargantext.Database.Utils (Cmd, runPGSQuery) -import Gargantext.Database.Types.Node (AnnuaireId, CorpusId, ListId{-, DocId, ContactId-}) +import Gargantext.Database.Action.Flow.Utils +import Gargantext.Database.Admin.Types.Node (AnnuaireId, CorpusId, ListId{-, DocId, ContactId-}) +import Gargantext.Database.Admin.Utils (Cmd, runPGSQuery) import Gargantext.Database.Node.Children (getAllContacts) +import Gargantext.Database.Node.Contact -- (HyperdataContact(..)) +import Gargantext.Database.Schema.Ngrams -- (NgramsType(..)) +import Gargantext.Prelude hiding (sum) +import Safe (lastMay) +import qualified Data.Map as DM +import qualified Data.Text as DT -- TODO mv this type in Types Main type Terms = Text diff --git a/src/Gargantext/Database/Action/Flow/Types.hs b/src/Gargantext/Database/Action/Flow/Types.hs index 014b5c57..4e4bd501 100644 --- a/src/Gargantext/Database/Action/Flow/Types.hs +++ b/src/Gargantext/Database/Action/Flow/Types.hs @@ -29,9 +29,9 @@ import Gargantext.Prelude import Gargantext.Core.Flow.Types import Gargantext.API.Ngrams (HasRepoVar, RepoCmdM) import Gargantext.Database.Schema.Ngrams (Ngrams(..), NgramsType(..)) -import Gargantext.Database.Types.Node (NodeId) -import Gargantext.Database.Types.Errors (HasNodeError) -import Gargantext.Database.Utils (CmdM) +import Gargantext.Database.Admin.Types.Node (NodeId) +import Gargantext.Database.Admin.Types.Errors (HasNodeError) +import Gargantext.Database.Admin.Utils (CmdM) type FlowCmdM env err m = ( CmdM env err m diff --git a/src/Gargantext/Database/Action/Flow/Utils.hs b/src/Gargantext/Database/Action/Flow/Utils.hs index afe90d14..718c5a4f 100644 --- a/src/Gargantext/Database/Action/Flow/Utils.hs +++ b/src/Gargantext/Database/Action/Flow/Utils.hs @@ -18,13 +18,13 @@ module Gargantext.Database.Action.Flow.Utils where import Data.Map (Map) -import qualified Data.Map as DM -import Gargantext.Prelude +import Gargantext.Database.Admin.Types.Node +import Gargantext.Database.Admin.Types.Node (NodeId, Node, NodePoly(..), Hyperdata) +import Gargantext.Database.Admin.Utils (Cmd) import Gargantext.Database.Schema.Ngrams -import Gargantext.Database.Types.Node (NodeId, Node, NodePoly(..), Hyperdata) -import Gargantext.Database.Utils (Cmd) import Gargantext.Database.Schema.NodeNodeNgrams -import Gargantext.Database.Types.Node +import Gargantext.Prelude +import qualified Data.Map as DM toMaps :: Hyperdata a => (a -> Map (NgramsT Ngrams) Int) diff --git a/src/Gargantext/Database/Action/Learn.hs b/src/Gargantext/Database/Action/Learn.hs index 9af66b62..4087b4c7 100644 --- a/src/Gargantext/Database/Action/Learn.hs +++ b/src/Gargantext/Database/Action/Learn.hs @@ -19,18 +19,17 @@ Portability : POSIX module Gargantext.Database.Action.Learn where +import Data.Maybe import Data.Text (Text) import Data.Tuple (snd) -import Data.Maybe -import Gargantext.Database.Facet -import Gargantext.Database.Types.Node +import Gargantext.Core.Types (Offset, Limit) +import Gargantext.Database.Action.Facet +import Gargantext.Database.Admin.Types.Node +import Gargantext.Database.Admin.Utils (Cmd) import Gargantext.Prelude import Gargantext.Text.Learn import qualified Data.List as List import qualified Data.Text as Text ---import Gargantext.Database.Schema.NodeNode (nodeNodesCategory) -import Gargantext.Database.Utils (Cmd) -import Gargantext.Core.Types (Offset, Limit) data FavOrTrash = IsFav | IsTrash deriving (Eq) diff --git a/src/Gargantext/Database/Action/Metrics.hs b/src/Gargantext/Database/Action/Metrics.hs index 5771ed05..c10dff13 100644 --- a/src/Gargantext/Database/Action/Metrics.hs +++ b/src/Gargantext/Database/Action/Metrics.hs @@ -23,17 +23,15 @@ import Data.Text (Text) import Gargantext.API.Ngrams (TabType(..), ngramsTypeFromTabType) import Gargantext.API.Ngrams.Tools (filterListWithRoot, groupNodesByNgrams, Diagonal(..), getCoocByNgrams, mapTermListRoot, RootTerm, getRepo) import Gargantext.Core.Types (ListType(..), Limit, NodeType(..)) -import Gargantext.Database.Flow (FlowCmdM) -import Gargantext.Database.Metrics.NgramsByNode (getNodesByNgramsOnlyUser{-, getTficfWith-}) -import Gargantext.Database.Node.Select +import Gargantext.Database.Action.Flow (FlowCmdM) +import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsOnlyUser{-, getTficfWith-}) +import Gargantext.Database.Action.Query.Node.Select +import Gargantext.Database.Admin.Config (userMaster) +import Gargantext.Database.Admin.Types.Node (ListId, CorpusId{-, HyperdataCorpus-}) import Gargantext.Database.Schema.Node (defaultList) -import Gargantext.Database.Types.Node (ListId, CorpusId{-, HyperdataCorpus-}) ---import Gargantext.Database.Flow (getOrMkRootWithCorpus) -import Gargantext.Database.Config (userMaster) import Gargantext.Prelude import Gargantext.Text.Metrics (scored, Scored(..), {-localMetrics, toScored-}) import qualified Data.Map as Map ---import qualified Data.Vector.Storable as Vec getMetrics :: FlowCmdM env err m => CorpusId -> Maybe ListId -> TabType -> Maybe Limit diff --git a/src/Gargantext/Database/Action/Metrics/Lists.hs b/src/Gargantext/Database/Action/Metrics/Lists.hs index 6d8fd06a..4ae08506 100644 --- a/src/Gargantext/Database/Action/Metrics/Lists.hs +++ b/src/Gargantext/Database/Action/Metrics/Lists.hs @@ -28,14 +28,13 @@ module Gargantext.Database.Action.Metrics.Lists import Gargantext.API.Ngrams (TabType(..)) import Gargantext.Core.Types -- (NodePoly(..), NodeCorpus, ListId) -import Gargantext.Database.Flow (FlowCmdM) +import Gargantext.Database.Action.Flow (FlowCmdM) import Gargantext.Prelude hiding (sum, head) import Gargantext.Text.Metrics (Scored(..)) import Prelude hiding (null, id, map, sum) import qualified Data.Map as Map import qualified Data.Vector as Vec -import qualified Gargantext.Database.Metrics as Metrics - +import qualified Gargantext.Database.Action.Metrics as Metrics {- trainModel :: FlowCmdM env ServantErr m diff --git a/src/Gargantext/Database/Action/Metrics/NgramsByNode.hs b/src/Gargantext/Database/Action/Metrics/NgramsByNode.hs index 78bbd524..c3bfc09a 100644 --- a/src/Gargantext/Database/Action/Metrics/NgramsByNode.hs +++ b/src/Gargantext/Database/Action/Metrics/NgramsByNode.hs @@ -20,7 +20,6 @@ Ngrams by node enable contextual metrics. module Gargantext.Database.Action.Metrics.NgramsByNode where -import Debug.Trace (trace) import Data.Map.Strict (Map, fromListWith, elems, toList, fromList) import Data.Map.Strict.Patch (PatchMap, Replace, diff) import Data.Set (Set) @@ -28,11 +27,12 @@ import Data.Text (Text) import Data.Tuple.Extra (second, swap) import Database.PostgreSQL.Simple.SqlQQ (sql) import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) +import Debug.Trace (trace) import Gargantext.Core (Lang(..)) -import Gargantext.Database.Config (nodeTypeId) +import Gargantext.Database.Admin.Config (nodeTypeId) +import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId) +import Gargantext.Database.Admin.Utils (Cmd, runPGSQuery) import Gargantext.Database.Schema.Ngrams (ngramsTypeId, NgramsType(..)) -import Gargantext.Database.Types.Node -- (ListId, CorpusId, NodeId) -import Gargantext.Database.Utils (Cmd, runPGSQuery) import Gargantext.Prelude import Gargantext.Text.Metrics.TFICF import Gargantext.Text.Terms.Mono.Stem (stem) diff --git a/src/Gargantext/Database/Query/Facet.hs b/src/Gargantext/Database/Action/Query/Facet.hs similarity index 96% rename from src/Gargantext/Database/Query/Facet.hs rename to src/Gargantext/Database/Action/Query/Facet.hs index bc96da3e..0675583a 100644 --- a/src/Gargantext/Database/Query/Facet.hs +++ b/src/Gargantext/Database/Action/Query/Facet.hs @@ -25,7 +25,7 @@ Portability : POSIX {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} ------------------------------------------------------------------------ -module Gargantext.Database.Query.Facet +module Gargantext.Database.Action.Query.Facet ( runViewAuthorsDoc , runViewDocuments , filterWith @@ -39,10 +39,9 @@ module Gargantext.Database.Query.Facet , OrderBy(..) ) where ------------------------------------------------------------------------- + import Control.Arrow (returnA) import Control.Lens ((^.)) --- import Control.Lens.TH (makeLensesWith, abbreviatedFields) import Data.Aeson (FromJSON, ToJSON) import Data.Aeson.TH (deriveJSON) import Data.Either(Either(Left)) @@ -55,15 +54,14 @@ import Data.Time.Segment (jour) import GHC.Generics (Generic) import Gargantext.Core.Types import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) -import Gargantext.Database.Config (nodeTypeId) -import Gargantext.Database.Schema.Node +import Gargantext.Database.Action.Query.Filter +import Gargantext.Database.Action.Query.Join (leftJoin5) +import Gargantext.Database.Admin.Config (nodeTypeId) +import Gargantext.Database.Admin.Utils import Gargantext.Database.Schema.Ngrams +import Gargantext.Database.Schema.Node import Gargantext.Database.Schema.NodeNode import Gargantext.Database.Schema.NodeNodeNgrams --- import Gargantext.Database.Schema.NodeNodeNgrams2 -import Gargantext.Database.Utils -import Gargantext.Database.Query.Filter -import Gargantext.Database.Query.Join (leftJoin5) import Opaleye import Prelude hiding (null, id, map, sum, not, read) import Servant.API diff --git a/src/Gargantext/Database/Query/Filter.hs b/src/Gargantext/Database/Action/Query/Filter.hs similarity index 94% rename from src/Gargantext/Database/Query/Filter.hs rename to src/Gargantext/Database/Action/Query/Filter.hs index cd5f74d4..06a8ce77 100644 --- a/src/Gargantext/Database/Query/Filter.hs +++ b/src/Gargantext/Database/Action/Query/Filter.hs @@ -19,7 +19,8 @@ Portability : POSIX {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Gargantext.Database.Query.Filter where +module Gargantext.Database.Action.Query.Filter + where import Gargantext.Core.Types (Limit, Offset) import Data.Maybe (Maybe, maybe) diff --git a/src/Gargantext/Database/Query/Join.hs b/src/Gargantext/Database/Action/Query/Join.hs similarity index 99% rename from src/Gargantext/Database/Query/Join.hs rename to src/Gargantext/Database/Action/Query/Join.hs index fcd938bf..a4012275 100644 --- a/src/Gargantext/Database/Query/Join.hs +++ b/src/Gargantext/Database/Action/Query/Join.hs @@ -25,10 +25,11 @@ Multiple Join functions with Opaleye. {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} + ------------------------------------------------------------------------ -module Gargantext.Database.Query.Query.Join + +module Gargantext.Database.Action.Query.Join where ------------------------------------------------------------------------- import Control.Applicative ((<*>)) import Control.Arrow ((>>>)) @@ -38,7 +39,6 @@ import Opaleye import Opaleye.Internal.Join (NullMaker(..)) import qualified Opaleye.Internal.Unpackspec() - --leftJoin3 :: Query columnsL1 -> Query columnsR -> Query columnsL -- -> ((columnsL1, columnsR) -> Column PGBool) -- -> ((columnsL, (columnsL1, nullableColumnsR1)) -> Column PGBool) @@ -50,7 +50,6 @@ join3 :: Query columnsA -> Query columnsB -> Query columnsC join3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond ------------------------------------------------------------------------ - leftJoin3 :: (Default Unpackspec fieldsL1 fieldsL1, Default Unpackspec fieldsL2 fieldsL2, diff --git a/src/Gargantext/Database/Query/Ngrams.hs b/src/Gargantext/Database/Action/Query/Ngrams.hs similarity index 88% rename from src/Gargantext/Database/Query/Ngrams.hs rename to src/Gargantext/Database/Action/Query/Ngrams.hs index 7422b86b..1dd0e0ce 100644 --- a/src/Gargantext/Database/Query/Ngrams.hs +++ b/src/Gargantext/Database/Action/Query/Ngrams.hs @@ -14,19 +14,19 @@ Portability : POSIX {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Query.Ngrams +module Gargantext.Database.Action.Query.Ngrams where -import Data.Text (Text) +import Control.Arrow (returnA) import Control.Lens ((^.)) +import Data.Text (Text) import Gargantext.Core.Types import Gargantext.Database.Admin.Utils (runOpaQuery, Cmd) -import Gargantext.Database.Admin.Schema.Ngrams -import Gargantext.Database.Admin.Schema.NodeNodeNgrams -import Gargantext.Database.Admin.Schema.Node +import Gargantext.Database.Schema.Ngrams +import Gargantext.Database.Schema.Node +import Gargantext.Database.Schema.NodeNodeNgrams import Gargantext.Prelude import Opaleye -import Control.Arrow (returnA) selectNgramsByDoc :: [ListId] -> DocId -> NgramsType -> Cmd err [Text] selectNgramsByDoc lIds dId nt = runOpaQuery (query lIds dId nt) diff --git a/src/Gargantext/Database/Query/Node.hs b/src/Gargantext/Database/Action/Query/Node.hs similarity index 98% rename from src/Gargantext/Database/Query/Node.hs rename to src/Gargantext/Database/Action/Query/Node.hs index b9589e1d..0301ca6e 100644 --- a/src/Gargantext/Database/Query/Node.hs +++ b/src/Gargantext/Database/Action/Query/Node.hs @@ -24,7 +24,8 @@ Portability : POSIX {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -module Gargantext.Database.Query.Node where +module Gargantext.Database.Action.Query.Node + where import Control.Arrow (returnA) import Control.Lens (set, view) @@ -37,13 +38,13 @@ import Database.PostgreSQL.Simple.FromField (FromField, fromField) import GHC.Int (Int64) import Gargantext.Core.Types import Gargantext.Core.Types.Individu (User(..)) -import Gargantext.Database.Config (nodeTypeId) +import Gargantext.Database.Action.Query.Filter (limit', offset') +import Gargantext.Database.Admin.Config (nodeTypeId) +import Gargantext.Database.Admin.Types.Errors +import Gargantext.Database.Admin.Types.Node (NodeType(..), defaultCorpus, Hyperdata, HyperData(..)) +import Gargantext.Database.Admin.Utils import Gargantext.Database.Node.Contact (HyperdataContact(..), arbitraryHyperdataContact) -import Gargantext.Database.Query.Filter (limit', offset') import Gargantext.Database.Schema.Node -import Gargantext.Database.Types.Errors -import Gargantext.Database.Types.Node (NodeType(..), defaultCorpus, Hyperdata, HyperData(..)) -import Gargantext.Database.Utils import Gargantext.Prelude hiding (sum, head) import Gargantext.Viz.Graph (HyperdataGraph(..)) import Opaleye hiding (FromField) diff --git a/src/Gargantext/Database/Query/Node/Children.hs b/src/Gargantext/Database/Action/Query/Node/Children.hs similarity index 88% rename from src/Gargantext/Database/Query/Node/Children.hs rename to src/Gargantext/Database/Action/Query/Node/Children.hs index 98b43131..3ccee5ec 100644 --- a/src/Gargantext/Database/Query/Node/Children.hs +++ b/src/Gargantext/Database/Action/Query/Node/Children.hs @@ -16,19 +16,20 @@ Portability : POSIX {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Query.Node.Children where +module Gargantext.Database.Action.Query.Node.Children + where +import Control.Arrow (returnA) import Data.Proxy -import Opaleye import Gargantext.Core.Types -import Gargantext.Database.Admin.Schema.Node -import Gargantext.Database.Admin.Utils -import Gargantext.Database.Admin.Schema.NodeNode +import Gargantext.Database.Action.Query.Filter +import Gargantext.Database.Action.Query.Node.Contact (HyperdataContact) import Gargantext.Database.Admin.Config (nodeTypeId) -import Gargantext.Database.Query.Filter -import Gargantext.Database.Query.Node.Contact (HyperdataContact) -import Gargantext.Database.Admin.Schema.Node (pgNodeId) -import Control.Arrow (returnA) +import Gargantext.Database.Admin.Utils +import Gargantext.Database.Schema.Node +import Gargantext.Database.Schema.Node (pgNodeId) +import Gargantext.Database.Schema.NodeNode +import Opaleye getAllDocuments :: ParentId -> Cmd err (TableResult (Node HyperdataDocument)) getAllDocuments pId = getAllChildren pId (Proxy :: Proxy HyperdataDocument) diff --git a/src/Gargantext/Database/Query/Node/Contact.hs b/src/Gargantext/Database/Action/Query/Node/Contact.hs similarity index 97% rename from src/Gargantext/Database/Query/Node/Contact.hs rename to src/Gargantext/Database/Action/Query/Node/Contact.hs index 740ada53..f8d6c814 100644 --- a/src/Gargantext/Database/Query/Node/Contact.hs +++ b/src/Gargantext/Database/Action/Query/Node/Contact.hs @@ -17,7 +17,7 @@ Portability : POSIX {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} -module Gargantext.Database.Query.Node.Contact +module Gargantext.Database.Action.Query.Node.Contact where import Control.Lens (makeLenses) @@ -29,8 +29,8 @@ import Data.Time (UTCTime) import Database.PostgreSQL.Simple.FromField (FromField, fromField) import GHC.Generics (Generic) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) -import Gargantext.Database.Types.Node (Node,Hyperdata) -import Gargantext.Database.Utils (fromField') +import Gargantext.Database.Admin.Types.Node (Node,Hyperdata) +import Gargantext.Database.Admin.Utils (fromField') import Gargantext.Prelude import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn) import Test.QuickCheck (elements) diff --git a/src/Gargantext/Database/Query/Node/Document/Add.hs b/src/Gargantext/Database/Action/Query/Node/Document/Add.hs similarity index 94% rename from src/Gargantext/Database/Query/Node/Document/Add.hs rename to src/Gargantext/Database/Action/Query/Node/Document/Add.hs index 956379f5..0fdefded 100644 --- a/src/Gargantext/Database/Query/Node/Document/Add.hs +++ b/src/Gargantext/Database/Action/Query/Node/Document/Add.hs @@ -23,24 +23,22 @@ Add Documents/Contact to a Corpus/Annuaire. {-# LANGUAGE TypeSynonymInstances #-} ------------------------------------------------------------------------ -module Gargantext.Database.Query.Node.Document.Add +module Gargantext.Database.Action.Query.Node.Document.Add where import Data.ByteString.Internal (ByteString) +import Data.Text (Text) import Data.Typeable (Typeable) import Database.PostgreSQL.Simple (Query, Only(..)) import Database.PostgreSQL.Simple.SqlQQ import Database.PostgreSQL.Simple.ToField (toField) import Database.PostgreSQL.Simple.ToRow (ToRow(..)) import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) - -import Data.Text (Text) - -import Gargantext.Database.Utils (Cmd, runPGSQuery, formatPGSQuery) -import Gargantext.Database.Types.Node +import GHC.Generics (Generic) +import Gargantext.Database.Admin.Types.Node +import Gargantext.Database.Admin.Utils (Cmd, runPGSQuery, formatPGSQuery) import Gargantext.Prelude -import GHC.Generics (Generic) --------------------------------------------------------------------------- add :: ParentId -> [NodeId] -> Cmd err [Only Int] diff --git a/src/Gargantext/Database/Query/Node/Document/Insert.hs b/src/Gargantext/Database/Action/Query/Node/Document/Insert.hs similarity index 96% rename from src/Gargantext/Database/Query/Node/Document/Insert.hs rename to src/Gargantext/Database/Action/Query/Node/Document/Insert.hs index 6776bf2d..7b8031ea 100644 --- a/src/Gargantext/Database/Query/Node/Document/Insert.hs +++ b/src/Gargantext/Database/Action/Query/Node/Document/Insert.hs @@ -57,30 +57,32 @@ the concatenation of the parameters defined by @shaParameters@. {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeSynonymInstances #-} ------------------------------------------------------------------------ -module Gargantext.Database.Query.Node.Document.Insert where +module Gargantext.Database.Action.Query.Node.Document.Insert + where import Control.Lens (set, view) -import Control.Lens.Prism import Control.Lens.Cons +import Control.Lens.Prism import Data.Aeson (toJSON) import Data.Maybe (maybe) -import Data.Time.Segment (jour) import Data.Text (Text) +import Data.Time.Segment (jour) import Database.PostgreSQL.Simple (FromRow, Query, Only(..)) import Database.PostgreSQL.Simple.FromRow (fromRow, field) import Database.PostgreSQL.Simple.SqlQQ import Database.PostgreSQL.Simple.ToField (toField, Action) import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) import GHC.Generics (Generic) -import Gargantext.Database.Config (nodeTypeId) -import Gargantext.Database.Utils (Cmd, runPGSQuery) -import Gargantext.Database.Node.Contact -- (HyperdataContact(..), ContactWho(..)) -import Gargantext.Database.Types.Node +import Gargantext.Database.Action.Query.Node.Contact -- (HyperdataContact(..), ContactWho(..)) +import Gargantext.Database.Admin.Config (nodeTypeId) +import Gargantext.Database.Admin.Types.Node +import Gargantext.Database.Admin.Utils (Cmd, runPGSQuery) import Gargantext.Prelude +import Gargantext.Prelude.Utils (sha) import qualified Data.ByteString.Lazy.Char8 as DC (pack) import qualified Data.Digest.Pure.SHA as SHA (sha256, showDigest) import qualified Data.Text as DT (pack, unpack, concat, take) -import Gargantext.Prelude.Utils (sha) + -- TODO : the import of Document constructor below does not work -- import Gargantext.Database.Types.Node (Document) --import Gargantext.Database.Types.Node (docExample, hyperdataDocument, HyperdataDocument(..) diff --git a/src/Gargantext/Database/Query/Node/Select.hs b/src/Gargantext/Database/Action/Query/Node/Select.hs similarity index 89% rename from src/Gargantext/Database/Query/Node/Select.hs rename to src/Gargantext/Database/Action/Query/Node/Select.hs index 5e5f3ced..211dfcec 100644 --- a/src/Gargantext/Database/Query/Node/Select.hs +++ b/src/Gargantext/Database/Action/Query/Node/Select.hs @@ -14,17 +14,17 @@ Portability : POSIX {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Query.Node.Select +module Gargantext.Database.Action.Query.Node.Select where -import Opaleye +import Control.Arrow (returnA) import Gargantext.Core.Types +import Gargantext.Core.Types.Individu (Username) +import Gargantext.Database.Admin.Config +import Gargantext.Database.Admin.Utils import Gargantext.Database.Schema.Node -import Gargantext.Database.Utils -import Gargantext.Database.Config import Gargantext.Database.Schema.User -import Gargantext.Core.Types.Individu (Username) -import Control.Arrow (returnA) +import Opaleye selectNodesWithUsername :: NodeType -> Username -> Cmd err [NodeId] selectNodesWithUsername nt u = runOpaQuery (q u) diff --git a/src/Gargantext/Database/Query/Node/Update.hs b/src/Gargantext/Database/Action/Query/Node/Update.hs similarity index 89% rename from src/Gargantext/Database/Query/Node/Update.hs rename to src/Gargantext/Database/Action/Query/Node/Update.hs index c19dcd85..5fe700e5 100644 --- a/src/Gargantext/Database/Query/Node/Update.hs +++ b/src/Gargantext/Database/Action/Query/Node/Update.hs @@ -15,8 +15,7 @@ Portability : POSIX {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RankNTypes #-} - -module Gargantext.Database.Query.Node.Update (Update(..), update) +module Gargantext.Database.Action.Query.Node.Update (Update(..), update) where import qualified Data.Text as DT @@ -24,8 +23,8 @@ import Database.PostgreSQL.Simple import Gargantext.Prelude import Gargantext.Core.Types (Name) -import Gargantext.Database.Utils -import Gargantext.Database.Types.Node (NodeId, ParentId) +import Gargantext.Database.Admin.Utils +import Gargantext.Database.Admin.Types.Node (NodeId, ParentId) -- import Data.ByteString --rename :: NodeId -> Text -> IO ByteString diff --git a/src/Gargantext/Database/Query/Node/UpdateOpaleye.hs b/src/Gargantext/Database/Action/Query/Node/UpdateOpaleye.hs similarity index 87% rename from src/Gargantext/Database/Query/Node/UpdateOpaleye.hs rename to src/Gargantext/Database/Action/Query/Node/UpdateOpaleye.hs index 85545079..55bfb5a3 100644 --- a/src/Gargantext/Database/Query/Node/UpdateOpaleye.hs +++ b/src/Gargantext/Database/Action/Query/Node/UpdateOpaleye.hs @@ -16,15 +16,16 @@ Portability : POSIX {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Query.Node.UpdateOpaleye where +module Gargantext.Database.Action.Query.Node.UpdateOpaleye + where import Opaleye import Data.Aeson (encode, ToJSON) import Gargantext.Prelude import Gargantext.Database.Schema.Node -import Gargantext.Database.Types.Node -import Gargantext.Database.Utils (Cmd, mkCmd) +import Gargantext.Database.Admin.Types.Node +import Gargantext.Database.Admin.Utils (Cmd, mkCmd) updateHyperdata :: ToJSON a => NodeId -> a -> Cmd err Int64 updateHyperdata i h = mkCmd $ \c -> runUpdate_ c (updateHyperdataQuery i h) diff --git a/src/Gargantext/Database/Query/Node/User.hs b/src/Gargantext/Database/Action/Query/Node/User.hs similarity index 93% rename from src/Gargantext/Database/Query/Node/User.hs rename to src/Gargantext/Database/Action/Query/Node/User.hs index 21b78b65..656a89a8 100644 --- a/src/Gargantext/Database/Query/Node/User.hs +++ b/src/Gargantext/Database/Action/Query/Node/User.hs @@ -17,7 +17,7 @@ Portability : POSIX {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} -module Gargantext.Database.Query.Node.User +module Gargantext.Database.Action.Query.Node.User where import Control.Lens (makeLenses) @@ -27,13 +27,13 @@ import Data.Text (Text) import Database.PostgreSQL.Simple.FromField (FromField, fromField) import GHC.Generics (Generic) import Gargantext.Core (Lang(..)) +import Gargantext.Core.Types.Individu (Username, arbitraryUsername, User(..), UserId) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) -import Gargantext.Database.Node.Contact (HyperdataContact, fake_HyperdataContact) -import Gargantext.Database.Types.Node (Node,Hyperdata, DocumentId, NodeId(..)) -import Gargantext.Database.Utils (fromField') -import Gargantext.Database.Tools.Node (getNode) +import Gargantext.Database.Action.Query.Node (getNode) +import Gargantext.Database.Action.Query.Node.Contact (HyperdataContact, fake_HyperdataContact) +import Gargantext.Database.Admin.Types.Node (Node,Hyperdata, DocumentId, NodeId(..)) +import Gargantext.Database.Admin.Utils (fromField') import Gargantext.Database.Schema.Node (Node(..)) -import Gargantext.Core.Types.Individu (Username, arbitraryUsername, User(..), UserId) import Gargantext.Prelude import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn) import Test.QuickCheck (elements) diff --git a/src/Gargantext/Database/Query/Tree.hs b/src/Gargantext/Database/Action/Query/Tree.hs similarity index 95% rename from src/Gargantext/Database/Query/Tree.hs rename to src/Gargantext/Database/Action/Query/Tree.hs index 1ae08e63..471597e3 100644 --- a/src/Gargantext/Database/Query/Tree.hs +++ b/src/Gargantext/Database/Action/Query/Tree.hs @@ -17,7 +17,7 @@ Let a Root Node, return the Tree of the Node as a directed acyclic graph {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Query.Tree +module Gargantext.Database.Action.Query.Tree ( treeDB , TreeError(..) , HasTreeError(..) @@ -38,10 +38,10 @@ import Database.PostgreSQL.Simple.SqlQQ import Gargantext.Prelude import Gargantext.Core.Types.Main (NodeTree(..), Tree(..)) import Gargantext.Database.Config (fromNodeTypeId, nodeTypeId) -import Gargantext.Database.Types.Node (NodeId, NodeType, DocId, allNodeTypes) -import Gargantext.Database.Utils (Cmd, runPGSQuery) -import Gargantext.Database.Tools.Node -import Gargantext.Database.Tools.User +import Gargantext.Database.Admin.Types.Node (NodeId, NodeType, DocId, allNodeTypes) +import Gargantext.Database.Admin.Utils (Cmd, runPGSQuery) +import Gargantext.Database.Admin.Tools.Node +import Gargantext.Database.Admin.Tools.User ------------------------------------------------------------------------ -- import Gargantext.Database.Utils (runCmdDev) diff --git a/src/Gargantext/Database/Query/Tree/Root.hs b/src/Gargantext/Database/Action/Query/Tree/Root.hs similarity index 85% rename from src/Gargantext/Database/Query/Tree/Root.hs rename to src/Gargantext/Database/Action/Query/Tree/Root.hs index 78f32cdb..83b706d1 100644 --- a/src/Gargantext/Database/Query/Tree/Root.hs +++ b/src/Gargantext/Database/Action/Query/Tree/Root.hs @@ -24,17 +24,18 @@ Portability : POSIX {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} -module Gargantext.Database.Query.Tree.Root where +module Gargantext.Database.Action.Query.Tree.Root + where import Control.Arrow (returnA) import Gargantext.Core.Types.Individu (User(..)) -import Gargantext.Database.Config (nodeTypeId) -import Gargantext.Database.Node.User (HyperdataUser) +import Gargantext.Database.Admin.Config (nodeTypeId) +import Gargantext.Database.Action.Node.User (HyperdataUser) import Gargantext.Database.Schema.Node (NodeRead) import Gargantext.Database.Schema.Node (queryNodeTable) import Gargantext.Database.Schema.User (queryUserTable, UserPoly(..)) -import Gargantext.Database.Types.Node (Node, NodePoly(..), NodeType(NodeUser)) -import Gargantext.Database.Utils (Cmd, runOpaQuery) +import Gargantext.Database.Admin.Types.Node (Node, NodePoly(..), NodeType(NodeUser)) +import Gargantext.Database.Admin.Utils (Cmd, runOpaQuery) import Gargantext.Prelude import Opaleye (restrict, (.==), Query) import Opaleye.PGTypes (pgStrictText, pgInt4) diff --git a/src/Gargantext/Database/Query/User.hs b/src/Gargantext/Database/Action/Query/User.hs similarity index 96% rename from src/Gargantext/Database/Query/User.hs rename to src/Gargantext/Database/Action/Query/User.hs index 85bb5845..23df22b6 100644 --- a/src/Gargantext/Database/Query/User.hs +++ b/src/Gargantext/Database/Action/Query/User.hs @@ -23,7 +23,7 @@ Functions to deal with users, database side. {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Query.Tools.User +module Gargantext.Database.Action.Query.User where import Control.Arrow (returnA) @@ -36,9 +36,9 @@ import Data.Text (Text) import Data.Time (UTCTime) import GHC.Show(Show(..)) import Gargantext.Core.Types.Individu (Username, arbitraryUsername, User(..), UserId) -import Gargantext.Database.Types.Errors +import Gargantext.Database.Admin.Types.Errors import Gargantext.Database.Schema.User -import Gargantext.Database.Utils +import Gargantext.Database.Admin.Utils import Gargantext.Prelude import Opaleye diff --git a/src/Gargantext/Database/Action/Search.hs b/src/Gargantext/Database/Action/Search.hs index 46f35d25..73394554 100644 --- a/src/Gargantext/Database/Action/Search.hs +++ b/src/Gargantext/Database/Action/Search.hs @@ -16,32 +16,32 @@ Portability : POSIX module Gargantext.Database.Action.Search where +--import Gargantext.Database.Node.Contact +import Control.Arrow (returnA) +import Control.Lens ((^.)) import Data.Aeson +import Data.List (intersperse, take, drop) import Data.Map.Strict hiding (map, drop, take) import Data.Maybe -import Control.Lens ((^.)) -import Data.List (intersperse, take, drop) import Data.String (IsString(..)) import Data.Text (Text, words, unpack, intercalate) import Data.Time (UTCTime) import Database.PostgreSQL.Simple (Query) import Database.PostgreSQL.Simple.ToField -import Gargantext.Database.Config (nodeTypeId) -import Gargantext.Database.Types.Node (NodeType(..)) -import Gargantext.Prelude ---import Gargantext.Database.Node.Contact -import Gargantext.Database.Facet -import Gargantext.Database.Schema.Node +import Gargantext.Core.Types +import Gargantext.Database.Action.Facet +import Gargantext.Database.Action.Query.Join (leftJoin6) +import Gargantext.Database.Admin.Config (nodeTypeId) +import Gargantext.Database.Admin.Types.Node (NodeType(..)) +import Gargantext.Database.Admin.Utils (Cmd, runPGSQuery, runOpaQuery, runCountOpaQuery) import Gargantext.Database.Schema.Ngrams +import Gargantext.Database.Schema.Node import Gargantext.Database.Schema.NodeNode hiding (joinInCorpus) import Gargantext.Database.Schema.NodeNodeNgrams -import Gargantext.Database.Query.Join (leftJoin6) -import Gargantext.Database.Utils (Cmd, runPGSQuery, runOpaQuery, runCountOpaQuery) +import Gargantext.Prelude import Gargantext.Text.Terms.Mono.Stem.En (stemIt) -import Gargantext.Core.Types -import Control.Arrow (returnA) -import qualified Opaleye as O hiding (Order) import Opaleye hiding (Query, Order) +import qualified Opaleye as O hiding (Order) ------------------------------------------------------------------------ diff --git a/src/Gargantext/Database/Admin/Bashql.hs b/src/Gargantext/Database/Admin/Bashql.hs index 1bab0511..4834e4a4 100644 --- a/src/Gargantext/Database/Admin/Bashql.hs +++ b/src/Gargantext/Database/Admin/Bashql.hs @@ -83,9 +83,9 @@ import Data.Text (Text) import Data.List (concat, last) import Gargantext.Core.Types -import Gargantext.Database.Utils (runOpaQuery, Cmd) +import Gargantext.Database.Admin.Utils (runOpaQuery, Cmd) import Gargantext.Database.Schema.Node -import qualified Gargantext.Database.Node.Update as U (Update(..), update) +import qualified Gargantext.Database.Action.Query.Node.Update as U (Update(..), update) import Gargantext.Prelude diff --git a/src/Gargantext/Database/Admin/Config.hs b/src/Gargantext/Database/Admin/Config.hs index 48670c2b..28fb4a01 100644 --- a/src/Gargantext/Database/Admin/Config.hs +++ b/src/Gargantext/Database/Admin/Config.hs @@ -19,13 +19,11 @@ TODO: configure nodes table in Haskell (Config typenames etc.) module Gargantext.Database.Admin.Config where - +import Data.List (lookup) +import Data.Maybe (fromMaybe) import Data.Text (Text,pack) import Data.Tuple.Extra (swap) -import Data.Maybe (fromMaybe) -import Data.List (lookup) - -import Gargantext.Database.Types.Node +import Gargantext.Database.Admin.Types.Node import Gargantext.Prelude -- TODO put this in config.ini file diff --git a/src/Gargantext/Database/Admin/Trigger/Init.hs b/src/Gargantext/Database/Admin/Trigger/Init.hs index 15a4c055..7bfe9721 100644 --- a/src/Gargantext/Database/Admin/Trigger/Init.hs +++ b/src/Gargantext/Database/Admin/Trigger/Init.hs @@ -20,12 +20,12 @@ Ngrams by node enable contextual metrics. module Gargantext.Database.Admin.Trigger.Init where --- import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) -import Gargantext.Database.Utils (Cmd) +import Gargantext.Database.Admin.Triggers.NodeNodeNgrams (triggerCountInsert, triggerCountInsert2) +import Gargantext.Database.Admin.Triggers.Nodes (triggerSearchUpdate) +import Gargantext.Database.Admin.Triggers.NodesNodes (triggerDeleteCount, triggerInsertCount, triggerUpdateAdd, triggerUpdateDel, MasterListId) -- , triggerCoocInsert) +import Gargantext.Database.Admin.Utils (Cmd) import Gargantext.Prelude -import Gargantext.Database.Triggers.Nodes (triggerSearchUpdate) -import Gargantext.Database.Triggers.NodesNodes (triggerDeleteCount, triggerInsertCount, triggerUpdateAdd, triggerUpdateDel, MasterListId) -- , triggerCoocInsert) -import Gargantext.Database.Triggers.NodeNodeNgrams (triggerCountInsert, triggerCountInsert2) + ------------------------------------------------------------------------ initTriggers :: MasterListId -> Cmd err [Int64] diff --git a/src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs b/src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs index 3cc6d563..a21d15cf 100644 --- a/src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs +++ b/src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs @@ -21,11 +21,10 @@ module Gargantext.Database.Admin.Trigger.NodeNodeNgrams where import Database.PostgreSQL.Simple.SqlQQ (sql) --- import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) -import Gargantext.Database.Config (nodeTypeId) -import Gargantext.Database.Types.Node -- (ListId, CorpusId, NodeId) import Gargantext.Core.Types.Main (listTypeId, ListType(CandidateTerm)) -import Gargantext.Database.Utils (Cmd, execPGSQuery) +import Gargantext.Database.Admin.Config (nodeTypeId) +import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId) +import Gargantext.Database.Admin.Utils (Cmd, execPGSQuery) import Gargantext.Prelude import qualified Database.PostgreSQL.Simple as DPS diff --git a/src/Gargantext/Database/Admin/Trigger/Nodes.hs b/src/Gargantext/Database/Admin/Trigger/Nodes.hs index 30e7ce3c..9b86ce38 100644 --- a/src/Gargantext/Database/Admin/Trigger/Nodes.hs +++ b/src/Gargantext/Database/Admin/Trigger/Nodes.hs @@ -21,10 +21,9 @@ module Gargantext.Database.Admin.Trigger.Nodes where import Database.PostgreSQL.Simple.SqlQQ (sql) --- import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) -import Gargantext.Database.Config (nodeTypeId) -import Gargantext.Database.Types.Node -- (ListId, CorpusId, NodeId) -import Gargantext.Database.Utils (Cmd, execPGSQuery) +import Gargantext.Database.Admin.Config (nodeTypeId) +import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId) +import Gargantext.Database.Admin.Utils (Cmd, execPGSQuery) import Gargantext.Prelude import qualified Database.PostgreSQL.Simple as DPS diff --git a/src/Gargantext/Database/Admin/Trigger/NodesNodes.hs b/src/Gargantext/Database/Admin/Trigger/NodesNodes.hs index 675c29f0..9408cbd2 100644 --- a/src/Gargantext/Database/Admin/Trigger/NodesNodes.hs +++ b/src/Gargantext/Database/Admin/Trigger/NodesNodes.hs @@ -22,10 +22,10 @@ module Gargantext.Database.Admin.Trigger.NodesNodes import Database.PostgreSQL.Simple.SqlQQ (sql) -- import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) -import Gargantext.Database.Config (nodeTypeId) -import Gargantext.Database.Types.Node -- (ListId, CorpusId, NodeId) +import Gargantext.Database.Admin.Config (nodeTypeId) +import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId) import Gargantext.Core.Types.Main (listTypeId, ListType(CandidateTerm)) -import Gargantext.Database.Utils (Cmd, execPGSQuery) +import Gargantext.Database.Admin.Utils (Cmd, execPGSQuery) import Gargantext.Prelude import qualified Database.PostgreSQL.Simple as DPS diff --git a/src/Gargantext/Database/Admin/Types/Node.hs b/src/Gargantext/Database/Admin/Types/Node.hs index 2d559a93..7997e4d5 100644 --- a/src/Gargantext/Database/Admin/Types/Node.hs +++ b/src/Gargantext/Database/Admin/Types/Node.hs @@ -25,42 +25,35 @@ Portability : POSIX module Gargantext.Database.Admin.Types.Node where -import Prelude (Enum, Bounded, minBound, maxBound) - -import GHC.Generics (Generic) - -import Control.Lens hiding (elements, (&)) -import Control.Applicative ((<*>)) -import Control.Monad (mzero) - -import Data.Aeson -import Data.Aeson.Types (emptyObject) -import Data.Aeson (Object, toJSON) -import Data.Aeson.TH (deriveJSON) -import Data.ByteString.Lazy (ByteString) -import Data.Either -import Data.Eq (Eq) -import Data.Monoid (mempty) -import Data.Text (Text, unpack) -import Data.Time (UTCTime) -import Data.Swagger - -import Text.Read (read) -import Text.Show (Show()) - -import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField) +import Control.Applicative ((<*>)) +import Control.Lens hiding (elements, (&)) +import Control.Monad (mzero) +import Data.Aeson +import Data.Aeson (Object, toJSON) +import Data.Aeson.TH (deriveJSON) +import Data.Aeson.Types (emptyObject) +import Data.ByteString.Lazy (ByteString) +import Data.Either +import Data.Eq (Eq) +import Data.Monoid (mempty) +import Data.Swagger +import Data.Text (Text, unpack) +import Data.Time (UTCTime) import Database.PostgreSQL.Simple.FromField (FromField, fromField) -import Servant - -import Test.QuickCheck.Arbitrary -import Test.QuickCheck (elements) -import Test.QuickCheck.Instances.Time () -import Test.QuickCheck.Instances.Text () +import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField) +import GHC.Generics (Generic) +import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) +import Gargantext.Prelude +import Gargantext.Viz.Phylo (Phylo) +import Prelude (Enum, Bounded, minBound, maxBound) +import Servant +import Test.QuickCheck (elements) +import Test.QuickCheck.Arbitrary +import Test.QuickCheck.Instances.Text () +import Test.QuickCheck.Instances.Time () +import Text.Read (read) +import Text.Show (Show()) -import Gargantext.Prelude -import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) -import Gargantext.Viz.Phylo (Phylo) ---import Gargantext.Database.Utils ------------------------------------------------------------------------ newtype NodeId = NodeId Int diff --git a/src/Gargantext/Database/Admin/Utils.hs b/src/Gargantext/Database/Admin/Utils.hs index 37726911..35e5c128 100644 --- a/src/Gargantext/Database/Admin/Utils.hs +++ b/src/Gargantext/Database/Admin/Utils.hs @@ -21,18 +21,16 @@ commentary with @some markup@. module Gargantext.Database.Admin.Utils where -import Data.ByteString.Char8 (hPutStrLn) -import System.IO (stderr) import Control.Exception -import Control.Monad.Error.Class -- (MonadError(..), Error) import Control.Lens (Getter, view) +import Control.Monad.Error.Class -- (MonadError(..), Error) +import Control.Monad.Except import Control.Monad.Reader import Control.Monad.Trans.Control (MonadBaseControl) -import Control.Monad.Except import Data.Aeson (Result(Error,Success), fromJSON, FromJSON) +import Data.ByteString.Char8 (hPutStrLn) import Data.Either.Extra (Either(Left, Right)) import Data.Ini (readIniFile, lookupValue) -import qualified Data.List as DL import Data.Maybe (maybe) import Data.Monoid ((<>)) import Data.Pool (Pool, withResource) @@ -40,7 +38,6 @@ import Data.Profunctor.Product.Default (Default) import Data.Text (unpack, pack) import Data.Typeable (Typeable) import Data.Word (Word16) ---import Database.PostgreSQL.Simple (Connection, Pool, connect, withPoolConnection) import Database.PostgreSQL.Simple (Connection, connect) import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(ConversionFailed), fromField, returnError) import Database.PostgreSQL.Simple.Internal (Field) @@ -48,8 +45,10 @@ import Gargantext.Prelude import Opaleye (Query, Unpackspec, showSqlForPostgres, FromFields, Select, runQuery) import Opaleye.Aggregate (countRows) import System.IO (FilePath) +import System.IO (stderr) import Text.Read (read) import qualified Data.ByteString as DB +import qualified Data.List as DL import qualified Database.PostgreSQL.Simple as PGS class HasConnectionPool env where diff --git a/src/Gargantext/Database/Admin/Schema/Ngrams.hs b/src/Gargantext/Database/Schema/Ngrams.hs similarity index 98% rename from src/Gargantext/Database/Admin/Schema/Ngrams.hs rename to src/Gargantext/Database/Schema/Ngrams.hs index 2617af4b..6f7e15ad 100644 --- a/src/Gargantext/Database/Admin/Schema/Ngrams.hs +++ b/src/Gargantext/Database/Schema/Ngrams.hs @@ -24,7 +24,7 @@ Ngrams connection to the Database. {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} -module Gargantext.Database.Admin.Schema.Ngrams where +module Gargantext.Database.Schema.Ngrams where import Control.Lens (makeLenses, over) import Control.Monad (mzero) @@ -33,22 +33,22 @@ import Data.Aeson.Types (toJSONKeyText) import Data.ByteString.Internal (ByteString) import Data.Map (Map, fromList, lookup) import Data.Profunctor.Product.TH (makeAdaptorAndInstance) +import Data.Swagger (ToParamSchema, toParamSchema, ToSchema) import Data.Text (Text, splitOn, pack) +import Database.PostgreSQL.Simple.FromField (FromField, fromField) import Database.PostgreSQL.Simple.FromRow (fromRow, field) import Database.PostgreSQL.Simple.SqlQQ (sql) import Database.PostgreSQL.Simple.ToField (toField, ToField) -import Database.PostgreSQL.Simple.FromField (FromField, fromField) import Database.PostgreSQL.Simple.ToRow (toRow) import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) import GHC.Generics (Generic) -import Gargantext.Database.Utils (Cmd, runPGSQuery, runOpaQuery, formatPGSQuery) import Gargantext.Core.Types (TODO(..)) +import Gargantext.Database.Admin.Utils (Cmd, runPGSQuery, runOpaQuery, formatPGSQuery) import Gargantext.Prelude import Opaleye hiding (FromField) +import Prelude (Enum, Bounded, minBound, maxBound, Functor) import Servant (FromHttpApiData, parseUrlPiece, Proxy(..)) import Text.Read (read) -import Data.Swagger (ToParamSchema, toParamSchema, ToSchema) -import Prelude (Enum, Bounded, minBound, maxBound, Functor) import qualified Database.PostgreSQL.Simple as PGS diff --git a/src/Gargantext/Database/Admin/Schema/Node.hs b/src/Gargantext/Database/Schema/Node.hs similarity index 95% rename from src/Gargantext/Database/Admin/Schema/Node.hs rename to src/Gargantext/Database/Schema/Node.hs index bbcbeef4..52cea514 100644 --- a/src/Gargantext/Database/Admin/Schema/Node.hs +++ b/src/Gargantext/Database/Schema/Node.hs @@ -37,12 +37,12 @@ import Database.PostgreSQL.Simple.FromField (FromField, fromField) import GHC.Int (Int64) import Gargantext.Core.Types import Gargantext.Core.Types.Individu (User(..)) -import Gargantext.Database.Config (nodeTypeId) -import Gargantext.Database.Node.Contact (HyperdataContact(..), arbitraryHyperdataContact) -import Gargantext.Database.Query.Filter (limit', offset') -import Gargantext.Database.Types.Errors -import Gargantext.Database.Types.Node (NodeType(..), defaultCorpus, Hyperdata, HyperData(..)) -import Gargantext.Database.Utils +import Gargantext.Database.Action.Query.Filter (limit', offset') +import Gargantext.Database.Action.Query.Node.Contact (HyperdataContact(..), arbitraryHyperdataContact) +import Gargantext.Database.Admin.Config (nodeTypeId) +import Gargantext.Database.Admin.Types.Errors +import Gargantext.Database.Admin.Types.Node (NodeType(..), defaultCorpus, Hyperdata, HyperData(..)) +import Gargantext.Database.Admin.Utils import Gargantext.Prelude hiding (sum, head) import Gargantext.Viz.Graph (HyperdataGraph(..)) import Opaleye hiding (FromField) diff --git a/src/Gargantext/Database/Admin/Schema/NodeNgrams.hs b/src/Gargantext/Database/Schema/NodeNgrams.hs similarity index 98% rename from src/Gargantext/Database/Admin/Schema/NodeNgrams.hs rename to src/Gargantext/Database/Schema/NodeNgrams.hs index adac96ce..21e9cd0f 100644 --- a/src/Gargantext/Database/Admin/Schema/NodeNgrams.hs +++ b/src/Gargantext/Database/Schema/NodeNgrams.hs @@ -25,25 +25,24 @@ NodeNgrams register Context of Ngrams (named Cgrams then) {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} -module Gargantext.Database.Admin.Schema.NodeNgrams where +module Gargantext.Database.Schema.NodeNgrams where -import Data.Map (Map) -import qualified Data.Map as Map -import qualified Data.List as List import Data.List.Extra (nubOrd) +import Data.Map (Map) +import Data.Maybe (Maybe, fromMaybe) import Data.Text (Text) -import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..)) -import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) -import Database.PostgreSQL.Simple.FromRow (fromRow, field) -import Database.PostgreSQL.Simple.ToField (toField) import Database.PostgreSQL.Simple (FromRow) +import Database.PostgreSQL.Simple.FromRow (fromRow, field) import Database.PostgreSQL.Simple.SqlQQ (sql) --- import Control.Lens.TH (makeLenses) -import Data.Maybe (Maybe, fromMaybe) +import Database.PostgreSQL.Simple.ToField (toField) +import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) import Gargantext.Core.Types -import Gargantext.Database.Utils +import Gargantext.Database.Admin.Utils import Gargantext.Database.Schema.Ngrams (NgramsType, ngramsTypeId, fromNgramsTypeId) import Gargantext.Prelude +import qualified Data.List as List +import qualified Data.Map as Map +import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..)) type NodeNgramsId = Int diff --git a/src/Gargantext/Database/Admin/Schema/NodeNode.hs b/src/Gargantext/Database/Schema/NodeNode.hs similarity index 97% rename from src/Gargantext/Database/Admin/Schema/NodeNode.hs rename to src/Gargantext/Database/Schema/NodeNode.hs index eee91656..9dfc83dd 100644 --- a/src/Gargantext/Database/Admin/Schema/NodeNode.hs +++ b/src/Gargantext/Database/Schema/NodeNode.hs @@ -24,24 +24,24 @@ commentary with @some markup@. {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} -module Gargantext.Database.Admin.Schema.NodeNode where +module Gargantext.Database.Schema.NodeNode where +import Control.Arrow (returnA) import Control.Lens (view, (^.)) -import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..)) -import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) -import Database.PostgreSQL.Simple.SqlQQ (sql) import Control.Lens.TH (makeLenses) import Data.Maybe (Maybe, catMaybes) -import Data.Text (Text, splitOn) import Data.Profunctor.Product.TH (makeAdaptorAndInstance) -import Gargantext.Database.Tools.Node (pgNodeId) +import Data.Text (Text, splitOn) +import Database.PostgreSQL.Simple.SqlQQ (sql) +import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) import Gargantext.Core.Types -import Gargantext.Database.Utils -import Gargantext.Database.Config (nodeTypeId) -import Gargantext.Database.Types.Node (CorpusId, DocId) +import Gargantext.Database.Action.Query.Node (pgNodeId) +import Gargantext.Database.Admin.Config (nodeTypeId) +import Gargantext.Database.Admin.Types.Node (CorpusId, DocId) +import Gargantext.Database.Admin.Utils import Gargantext.Prelude import Opaleye -import Control.Arrow (returnA) +import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..)) import qualified Opaleye as O data NodeNodePoly node1_id node2_id score cat diff --git a/src/Gargantext/Database/Admin/Schema/NodeNodeNgrams.hs b/src/Gargantext/Database/Schema/NodeNodeNgrams.hs similarity index 94% rename from src/Gargantext/Database/Admin/Schema/NodeNodeNgrams.hs rename to src/Gargantext/Database/Schema/NodeNodeNgrams.hs index e9d99d76..4b8c4641 100644 --- a/src/Gargantext/Database/Admin/Schema/NodeNodeNgrams.hs +++ b/src/Gargantext/Database/Schema/NodeNodeNgrams.hs @@ -20,16 +20,16 @@ Portability : POSIX {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} -module Gargantext.Database.Admin.Schema.NodeNodeNgrams +module Gargantext.Database.Schema.NodeNodeNgrams where import Prelude import Data.Profunctor.Product.TH (makeAdaptorAndInstance) import Control.Lens.TH (makeLenses) -import Gargantext.Database.Utils (Cmd, mkCmd) +import Gargantext.Database.Admin.Utils (Cmd, mkCmd) import Gargantext.Database.Schema.Ngrams (NgramsTypeId, pgNgramsTypeId, NgramsId) -import Gargantext.Database.Tools.Node (pgNodeId) -import Gargantext.Database.Types.Node +import Gargantext.Database.Action.Query.Node (pgNodeId) +import Gargantext.Database.Admin.Types.Node import Opaleye data NodeNodeNgramsPoly n1 n2 ngrams_id ngt w diff --git a/src/Gargantext/Database/Admin/Schema/NodeNodeNgrams2.hs b/src/Gargantext/Database/Schema/NodeNodeNgrams2.hs similarity index 93% rename from src/Gargantext/Database/Admin/Schema/NodeNodeNgrams2.hs rename to src/Gargantext/Database/Schema/NodeNodeNgrams2.hs index e6e04184..661ab50d 100644 --- a/src/Gargantext/Database/Admin/Schema/NodeNodeNgrams2.hs +++ b/src/Gargantext/Database/Schema/NodeNodeNgrams2.hs @@ -20,17 +20,17 @@ Portability : POSIX {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} -module Gargantext.Database.Admin.Schema.NodeNodeNgrams2 +module Gargantext.Database.Schema.NodeNodeNgrams2 where -import Prelude -import Data.Profunctor.Product.TH (makeAdaptorAndInstance) import Control.Lens.TH (makeLenses) -import Gargantext.Database.Utils (Cmd, mkCmd) +import Data.Profunctor.Product.TH (makeAdaptorAndInstance) import Gargantext.Database.Schema.NodeNgrams (NodeNgramsId) -import Gargantext.Database.Tools.Node (pgNodeId) -import Gargantext.Database.Types.Node +import Gargantext.Database.Action.Query.Node (pgNodeId) +import Gargantext.Database.Admin.Types.Node +import Gargantext.Database.Admin.Utils (Cmd, mkCmd) import Opaleye +import Prelude data NodeNodeNgrams2Poly node_id nodengrams_id w = NodeNodeNgrams2 { _nnng2_node_id :: node_id diff --git a/src/Gargantext/Database/Admin/Schema/Node_NodeNgramsNodeNgrams.hs b/src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs similarity index 94% rename from src/Gargantext/Database/Admin/Schema/Node_NodeNgramsNodeNgrams.hs rename to src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs index 674cdb41..d8992324 100644 --- a/src/Gargantext/Database/Admin/Schema/Node_NodeNgramsNodeNgrams.hs +++ b/src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs @@ -33,15 +33,15 @@ Next Step benchmark: {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Gargantext.Database.Admin.Schema.Node_NodeNgramsNodeNgrams +module Gargantext.Database.Schema.Node_NodeNgramsNodeNgrams where import Control.Lens.TH (makeLensesWith, abbreviatedFields) import Data.Maybe (Maybe) import Data.Profunctor.Product.TH (makeAdaptorAndInstance) -import Gargantext.Database.Utils (Cmd, runOpaQuery, mkCmd) -import Gargantext.Database.Types.Node (CorpusId) -import Gargantext.Database.Tools.Node (pgNodeId) +import Gargantext.Database.Admin.Utils (Cmd, runOpaQuery, mkCmd) +import Gargantext.Database.Admin.Types.Node (CorpusId) +import Gargantext.Database.Action.Query.Node (pgNodeId) import Gargantext.Prelude import Opaleye diff --git a/src/Gargantext/Database/Admin/Schema/NodesNgramsRepo.hs b/src/Gargantext/Database/Schema/NodesNgramsRepo.hs similarity index 93% rename from src/Gargantext/Database/Admin/Schema/NodesNgramsRepo.hs rename to src/Gargantext/Database/Schema/NodesNgramsRepo.hs index 5ac37ec0..e5f28e56 100644 --- a/src/Gargantext/Database/Admin/Schema/NodesNgramsRepo.hs +++ b/src/Gargantext/Database/Schema/NodesNgramsRepo.hs @@ -25,7 +25,7 @@ Portability : POSIX {-# LANGUAGE TemplateHaskell #-} -module Gargantext.Database.Admin.Schema.NodesNgramsRepo +module Gargantext.Database.Schema.NodesNgramsRepo where import Control.Arrow (returnA) @@ -34,8 +34,8 @@ import Data.Map.Strict.Patch (PatchMap) import Data.Profunctor.Product.TH (makeAdaptorAndInstance) import Gargantext.API.Ngrams (NgramsStatePatch, NgramsTablePatch) import Gargantext.Database.Schema.Ngrams (NgramsType) -import Gargantext.Database.Types.Node (NodeId) -import Gargantext.Database.Utils (mkCmd, Cmd, runOpaQuery) +import Gargantext.Database.Admin.Types.Node (NodeId) +import Gargantext.Database.Admin.Utils (mkCmd, Cmd, runOpaQuery) import Gargantext.Prelude import Opaleye diff --git a/src/Gargantext/Database/Admin/Schema/User.hs b/src/Gargantext/Database/Schema/User.hs similarity index 97% rename from src/Gargantext/Database/Admin/Schema/User.hs rename to src/Gargantext/Database/Schema/User.hs index be93a436..ae0f34b3 100644 --- a/src/Gargantext/Database/Admin/Schema/User.hs +++ b/src/Gargantext/Database/Schema/User.hs @@ -23,7 +23,7 @@ Functions to deal with users, database side. {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.Database.Admin.Schema.User where +module Gargantext.Database.Schema.User where import Control.Arrow (returnA) import Control.Lens.TH (makeLensesWith, abbreviatedFields) @@ -35,8 +35,8 @@ import Data.Text (Text) import Data.Time (UTCTime) import GHC.Show(Show(..)) import Gargantext.Core.Types.Individu (Username, arbitraryUsername, User(..), UserId) -import Gargantext.Database.Types.Errors -import Gargantext.Database.Utils +import Gargantext.Database.Admin.Types.Errors +import Gargantext.Database.Admin.Utils import Gargantext.Prelude import Opaleye diff --git a/src/Gargantext/Ext/IMTUser.hs b/src/Gargantext/Ext/IMTUser.hs index 85741748..71d65272 100644 --- a/src/Gargantext/Ext/IMTUser.hs +++ b/src/Gargantext/Ext/IMTUser.hs @@ -27,7 +27,7 @@ import Data.Text (Text) import GHC.Generics (Generic) import Gargantext.Prelude -import Gargantext.Database.Node.Contact -- (HyperdataContact, ContactWho, ContactWhere, ContactTouch, ContactMetaData) +import Gargantext.Database.Admin.Node.Contact -- (HyperdataContact, ContactWho, ContactWhere, ContactTouch, ContactMetaData) import qualified Data.ByteString.Lazy as BSL instance Serialise IMTUser -- 2.47.0 From b28af36c495e8a0637ca84fb8f583771d1187c8d Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Sun, 12 Apr 2020 10:35:35 +0200 Subject: [PATCH 09/16] [WIP][REFACT] imports fixed --- package.yaml | 12 ++-- src/Gargantext/API.hs | 10 +-- src/Gargantext/API/Annuaire.hs | 4 +- src/Gargantext/API/Auth.hs | 17 +++--- src/Gargantext/API/Corpus/New.hs | 7 +-- src/Gargantext/API/Corpus/New/File.hs | 6 +- src/Gargantext/API/Export.hs | 16 ++--- src/Gargantext/API/Metrics.hs | 14 ++--- src/Gargantext/API/Ngrams.hs | 61 ++++++++----------- src/Gargantext/API/Ngrams/List.hs | 8 +-- src/Gargantext/API/Ngrams/Tools.hs | 1 - src/Gargantext/API/Node.hs | 20 +++--- src/Gargantext/API/Search.hs | 19 +++--- src/Gargantext/API/Settings.hs | 55 ++++++++--------- src/Gargantext/API/Table.hs | 10 +-- src/Gargantext/API/Types.hs | 6 +- src/Gargantext/Core/Flow/Types.hs | 16 ++--- src/Gargantext/Core/Types.hs | 6 +- src/Gargantext/Core/Types/Individu.hs | 4 +- src/Gargantext/Core/Types/Main.hs | 12 ++-- src/Gargantext/Database.hs | 2 +- src/Gargantext/Database/Action/Query/Node.hs | 3 +- .../Database/Action/Query/Node/Select.hs | 1 + .../Action/Query/Node/UpdateOpaleye.hs | 1 + src/Gargantext/Database/Action/Query/Tree.hs | 6 +- .../Database/Action/Query/Tree/Root.hs | 2 +- src/Gargantext/Database/Admin/Bashql.hs | 1 + src/Gargantext/Database/Admin/Trigger/Init.hs | 6 +- src/Gargantext/Ext/IMTUser.hs | 8 +-- src/Gargantext/Prelude/Utils.hs | 20 +++--- src/Gargantext/Text/Corpus/API/Hal.hs | 7 +-- src/Gargantext/Text/Corpus/API/Istex.hs | 7 +-- src/Gargantext/Text/Corpus/API/Pubmed.hs | 2 +- src/Gargantext/Text/Corpus/Parsers.hs | 5 +- src/Gargantext/Text/Corpus/Parsers/CSV.hs | 4 +- .../Text/Corpus/Parsers/GrandDebat.hs | 2 +- src/Gargantext/Text/Corpus/Parsers/Isidore.hs | 4 +- src/Gargantext/Text/List.hs | 8 +-- src/Gargantext/Text/Metrics/Hetero.purs | 22 +++---- src/Gargantext/Viz/Chart.hs | 28 ++++----- src/Gargantext/Viz/Graph.hs | 4 +- src/Gargantext/Viz/Phylo.hs | 15 ++--- src/Gargantext/Viz/Phylo/Main.hs | 2 +- 43 files changed, 215 insertions(+), 249 deletions(-) diff --git a/package.yaml b/package.yaml index 516d5624..01fa6d16 100644 --- a/package.yaml +++ b/package.yaml @@ -42,13 +42,13 @@ library: - Gargantext.Core.Types.Main - Gargantext.Core.Utils.Prefix - Gargantext.Database - - Gargantext.Database.Init - - Gargantext.Database.Config - - Gargantext.Database.Flow + - Gargantext.Database.Admin.Init + - Gargantext.Database.Admin.Config + - Gargantext.Database.Action.Flow - Gargantext.Database.Schema.Node - - Gargantext.Database.Tree - - Gargantext.Database.Types.Node - - Gargantext.Database.Utils + - Gargantext.Database.Action.Tree + - Gargantext.Database.Admin.Types.Node + - Gargantext.Database.Admin.Utils - Gargantext.Database.Schema.User - Gargantext.Prelude - Gargantext.Text diff --git a/src/Gargantext/API.hs b/src/Gargantext/API.hs index 0cf8e5e9..ac91820e 100644 --- a/src/Gargantext/API.hs +++ b/src/Gargantext/API.hs @@ -72,10 +72,10 @@ import Gargantext.API.Search (SearchPairsAPI, searchPairs) import Gargantext.API.Settings import Gargantext.API.Types import Gargantext.Core.Types.Individu (User(..)) -import Gargantext.Database.Node.Contact (HyperdataContact) -import Gargantext.Database.Types.Node -import Gargantext.Database.Types.Node (NodeId, CorpusId, AnnuaireId) -import Gargantext.Database.Utils (HasConnectionPool) +import Gargantext.Database.Action.Query.Node.Contact (HyperdataContact) +import Gargantext.Database.Admin.Types.Node +import Gargantext.Database.Admin.Types.Node (NodeId, CorpusId, AnnuaireId) +import Gargantext.Database.Admin.Utils (HasConnectionPool) import Gargantext.Prelude import Gargantext.Viz.Graph.API import Network.HTTP.Types hiding (Query) @@ -92,13 +92,13 @@ import Servant.Job.Async import Servant.Swagger import Servant.Swagger.UI import System.IO (FilePath) -import qualified Paths_gargantext as PG -- cabal magic build module import qualified Data.ByteString.Lazy.Char8 as BL8 import qualified Data.Text.IO as T import qualified Gargantext.API.Annuaire as Annuaire import qualified Gargantext.API.Corpus.New as New import qualified Gargantext.API.Export as Export import qualified Gargantext.API.Ngrams.List as List +import qualified Paths_gargantext as PG -- cabal magic build module showAsServantErr :: GargError -> ServerError showAsServantErr (GargServerError err) = err diff --git a/src/Gargantext/API/Annuaire.hs b/src/Gargantext/API/Annuaire.hs index 53e3f1a9..3d6ce1c7 100644 --- a/src/Gargantext/API/Annuaire.hs +++ b/src/Gargantext/API/Annuaire.hs @@ -29,8 +29,8 @@ import qualified Gargantext.API.Corpus.New.File as NewFile import Gargantext.API.Orchestrator.Types import Gargantext.Core (Lang(..)) import Gargantext.Core.Utils.Prefix (unPrefixSwagger) -import Gargantext.Database.Flow (FlowCmdM) -- flowAnnuaire -import Gargantext.Database.Types.Node (AnnuaireId) +import Gargantext.Database.Action.Flow (FlowCmdM) -- flowAnnuaire +import Gargantext.Database.Admin.Types.Node (AnnuaireId) import Gargantext.Prelude import Servant import Servant.API.Flatten (Flat) diff --git a/src/Gargantext/API/Auth.hs b/src/Gargantext/API/Auth.hs index 8337f9e6..3dfbf9cb 100644 --- a/src/Gargantext/API/Auth.hs +++ b/src/Gargantext/API/Auth.hs @@ -40,20 +40,19 @@ import Data.Text (Text, reverse) import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Encoding (decodeUtf8) import GHC.Generics (Generic) -import Servant -import Servant.Auth.Server -import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) import Gargantext.API.Settings import Gargantext.API.Types (HasJoseError(..), joseError, HasServerError, GargServerC) ---import Gargantext.API.Types (HasJoseError(..), joseError, HasServerError, serverError, GargServerC) -import Gargantext.Database.Root (getRoot) -import Gargantext.Database.Tree (isDescendantOf, isIn) -import Gargantext.Database.Types.Node (NodePoly(_node_id), NodeId(..), UserId, ListId, DocId) -import Gargantext.Database.Utils (Cmd', CmdM, HasConnectionPool) +import Gargantext.Core.Types.Individu (User(..), Username, Password, arbitraryUsername, arbitraryPassword) +import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) +import Gargantext.Database.Action.Root (getRoot) +import Gargantext.Database.Action.Tree (isDescendantOf, isIn) +import Gargantext.Database.Admin.Types.Node (NodePoly(_node_id), NodeId(..), UserId, ListId, DocId) +import Gargantext.Database.Admin.Utils (Cmd', CmdM, HasConnectionPool) import Gargantext.Prelude hiding (reverse) +import Servant +import Servant.Auth.Server import Test.QuickCheck (elements, oneof) import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) -import Gargantext.Core.Types.Individu (User(..), Username, Password, arbitraryUsername, arbitraryPassword) --------------------------------------------------- diff --git a/src/Gargantext/API/Corpus/New.hs b/src/Gargantext/API/Corpus/New.hs index 219b8ec3..9d4bbf49 100644 --- a/src/Gargantext/API/Corpus/New.hs +++ b/src/Gargantext/API/Corpus/New.hs @@ -25,7 +25,6 @@ New corpus means either: module Gargantext.API.Corpus.New where ---import Gargantext.Text.Corpus.Parsers (parseFile, FileFormat(..)) import Control.Lens hiding (elements) import Data.Aeson import Data.Aeson.TH (deriveJSON) @@ -38,10 +37,8 @@ import Gargantext.API.Corpus.New.File import Gargantext.API.Orchestrator.Types import Gargantext.Core (Lang(..)) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) -import Gargantext.Database.Flow (FlowCmdM, flowCorpus) -import Gargantext.Database.Flow (flowCorpusSearchInDatabase) -import Gargantext.Database.Types.Node (CorpusId) -import Gargantext.Database.Types.Node (ToHyperdataDocument(..)) +import Gargantext.Database.Action.Flow (FlowCmdM, flowCorpus, flowCorpusSearchInDatabase) +import Gargantext.Database.Admin.Types.Node (CorpusId, ToHyperdataDocument(..)) import Gargantext.Core.Types.Individu (UserId, User(..)) import Gargantext.Prelude import qualified Gargantext.Text.Corpus.Parsers as Parser (FileFormat(..), parseFormat) diff --git a/src/Gargantext/API/Corpus/New/File.hs b/src/Gargantext/API/Corpus/New/File.hs index a6508aee..62879c8d 100644 --- a/src/Gargantext/API/Corpus/New/File.hs +++ b/src/Gargantext/API/Corpus/New/File.hs @@ -27,15 +27,15 @@ module Gargantext.API.Corpus.New.File import Control.Lens ((.~), (?~)) import Control.Monad (forM) -import Data.Maybe import Data.Aeson +import Data.Maybe import Data.Monoid (mempty) import Data.Swagger import Data.Text (Text()) import GHC.Generics (Generic) import Gargantext.API.Ngrams (TODO) -import Gargantext.Database.Types.Node -import Gargantext.Database.Utils -- (Cmd, CmdM) +import Gargantext.Database.Admin.Types.Node +import Gargantext.Database.Admin.Utils -- (Cmd, CmdM) import Gargantext.Prelude import Gargantext.Prelude.Utils (sha) import Servant diff --git a/src/Gargantext/API/Export.hs b/src/Gargantext/API/Export.hs index 23a273b1..76293ceb 100644 --- a/src/Gargantext/API/Export.hs +++ b/src/Gargantext/API/Export.hs @@ -27,8 +27,8 @@ module Gargantext.API.Export import Data.Aeson.TH (deriveJSON) import Data.Map (Map) -import Data.Set (Set) import Data.Maybe (fromMaybe) +import Data.Set (Set) import Data.Swagger import Data.Text (Text) import GHC.Generics (Generic) @@ -37,21 +37,21 @@ import Gargantext.API.Ngrams.Tools (filterListWithRoot, mapTermListRoot, getRepo import Gargantext.API.Types (GargNoServer) import Gargantext.Core.Types -- import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) -import Gargantext.Database.Config (userMaster) -import Gargantext.Database.Metrics.NgramsByNode (getNgramsByNodeOnlyUser) -import Gargantext.Database.Node.Select (selectNodesWithUsername) +import Gargantext.Database.Action.Metrics.NgramsByNode (getNgramsByNodeOnlyUser) +import Gargantext.Database.Action.Query.Node.Select (selectNodesWithUsername) +import Gargantext.Database.Admin.Config (userMaster) +import Gargantext.Database.Admin.Types.Errors (HasNodeError) +import Gargantext.Database.Admin.Types.Node (Node, HyperdataDocument(..), NodeId, ListId, CorpusId) +import Gargantext.Database.Admin.Utils (Cmd) import Gargantext.Database.Schema.Ngrams (NgramsType(..)) import Gargantext.Database.Schema.Node (defaultList) -import Gargantext.Database.Types.Errors (HasNodeError) import Gargantext.Database.Schema.NodeNode (selectDocNodes) -import Gargantext.Database.Types.Node (Node, HyperdataDocument(..), NodeId, ListId, CorpusId) -import Gargantext.Database.Utils (Cmd) import Gargantext.Prelude import Gargantext.Prelude.Utils (sha) import Servant +import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Set as Set -import qualified Data.List as List -- Corpus Export diff --git a/src/Gargantext/API/Metrics.hs b/src/Gargantext/API/Metrics.hs index ac689199..0c27e509 100644 --- a/src/Gargantext/API/Metrics.hs +++ b/src/Gargantext/API/Metrics.hs @@ -27,24 +27,24 @@ module Gargantext.API.Metrics import Data.Aeson.TH (deriveJSON) import Data.Swagger -import Data.Time (UTCTime) import Data.Text (Text) +import Data.Time (UTCTime) import GHC.Generics (Generic) +import Gargantext.API.Ngrams +import Gargantext.API.Ngrams.NTree +import Gargantext.Core.Types (CorpusId, ListId, Limit) import Gargantext.Core.Types (ListType(..)) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) -import Gargantext.Database.Utils -import Gargantext.Core.Types (CorpusId, ListId, Limit) +import Gargantext.Database.Action.Flow +import Gargantext.Database.Admin.Utils import Gargantext.Prelude -import Gargantext.API.Ngrams import Gargantext.Text.Metrics (Scored(..)) -import Gargantext.API.Ngrams.NTree -import Gargantext.Database.Flow import Gargantext.Viz.Chart import Servant import Test.QuickCheck (elements) import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) import qualified Data.Map as Map -import qualified Gargantext.Database.Metrics as Metrics +import qualified Gargantext.Database.Action.Metrics as Metrics data Metrics = Metrics { metrics_data :: [Metric]} diff --git a/src/Gargantext/API/Ngrams.hs b/src/Gargantext/API/Ngrams.hs index 62064ae7..14c31ac6 100644 --- a/src/Gargantext/API/Ngrams.hs +++ b/src/Gargantext/API/Ngrams.hs @@ -96,26 +96,6 @@ module Gargantext.API.Ngrams ) where --- import Debug.Trace (trace) -import Prelude (Enum, Bounded, Semigroup(..), minBound, maxBound {-, round-}, error) --- import Gargantext.Database.Schema.User (UserId) -import Data.Patch.Class (Replace, replace, Action(act), Applicable(..), - Composable(..), Transformable(..), - PairPatch(..), Patched, ConflictResolution, - ConflictResolutionReplace, ours) -import qualified Data.Map.Strict.Patch as PM -import Data.Monoid -import Data.Ord (Down(..)) -import Data.Foldable ---import Data.Semigroup -import Data.Set (Set) -import qualified Data.Set as S -import qualified Data.List as List -import Data.Maybe (fromMaybe) --- import Data.Tuple.Extra (first) -import qualified Data.Map.Strict as Map -import Data.Map.Strict (Map) -import qualified Data.Set as Set import Control.Category ((>>>)) import Control.Concurrent import Control.Lens (makeLenses, makePrisms, Getter, Iso', iso, from, (.~), (?=), (#), to, folded, {-withIndex, ifolded,-} view, use, (^.), (^..), (^?), (+~), (%~), (.~), (%=), sumOf, at, _Just, Each(..), itraverse_, both, forOf_, (%%~), (?~), mapped) @@ -128,37 +108,46 @@ import Data.Aeson hiding ((.=)) import Data.Aeson.TH (deriveJSON) import Data.Either(Either(Left)) import Data.Either.Extra (maybeToEither) --- import Data.Map (lookup) -import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap +import Data.Foldable +import Data.Map.Strict (Map) +import Data.Maybe (fromMaybe) +import Data.Monoid +import Data.Ord (Down(..)) +import Data.Patch.Class (Replace, replace, Action(act), Applicable(..), Composable(..), Transformable(..), PairPatch(..), Patched, ConflictResolution, ConflictResolutionReplace, ours) +import Data.Set (Set) import Data.Swagger hiding (version, patch) import Data.Text (Text, isInfixOf, count) import Data.Validity +import Database.PostgreSQL.Simple.FromField (FromField, fromField) import Formatting (hprint, int, (%)) import Formatting.Clock (timeSpecs) import GHC.Generics (Generic) +import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, Limit, Offset, HasInvalidError, assertValid) +import Gargantext.Core.Types (TODO) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) --- import Gargantext.Database.Schema.Ngrams (NgramsTypeId, ngramsTypeId, NgramsTableData(..)) -import Gargantext.Database.Config (userMaster) -import Gargantext.Database.Metrics.NgramsByNode (getOccByNgramsOnlyFast') +import Gargantext.Database.Action.Metrics.NgramsByNode (getOccByNgramsOnlyFast') +import Gargantext.Database.Action.Query.Ngrams +import Gargantext.Database.Action.Query.Node.Select +import Gargantext.Database.Admin.Config (userMaster) +import Gargantext.Database.Admin.Types.Errors (HasNodeError) +import Gargantext.Database.Admin.Types.Node (NodeType(..)) +import Gargantext.Database.Admin.Utils (fromField', HasConnectionPool) import Gargantext.Database.Schema.Ngrams (NgramsType) -import Gargantext.Database.Types.Node (NodeType(..)) -import Gargantext.Database.Utils (fromField', HasConnectionPool) -import Gargantext.Database.Node.Select -import Gargantext.Database.Ngrams ---import Gargantext.Database.Lists (listsWith) -import Gargantext.Database.Types.Errors (HasNodeError) -import Database.PostgreSQL.Simple.FromField (FromField, fromField) -import qualified Gargantext.Database.Schema.Ngrams as Ngrams --- import Gargantext.Database.Schema.NodeNgram hiding (Action) import Gargantext.Prelude -import Gargantext.Core.Types (TODO) -import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, Limit, Offset, HasInvalidError, assertValid) +import Prelude (Enum, Bounded, Semigroup(..), minBound, maxBound {-, round-}, error) import Servant hiding (Patch) import System.Clock (getTime, TimeSpec, Clock(..)) import System.FileLock (FileLock) import System.IO (stderr) import Test.QuickCheck (elements) import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) +import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap +import qualified Data.List as List +import qualified Data.Map.Strict as Map +import qualified Data.Map.Strict.Patch as PM +import qualified Data.Set as S +import qualified Data.Set as Set +import qualified Gargantext.Database.Schema.Ngrams as Ngrams ------------------------------------------------------------------------ --data FacetFormat = Table | Chart diff --git a/src/Gargantext/API/Ngrams/List.hs b/src/Gargantext/API/Ngrams/List.hs index 6135a3fe..f47abda4 100644 --- a/src/Gargantext/API/Ngrams/List.hs +++ b/src/Gargantext/API/Ngrams/List.hs @@ -35,16 +35,16 @@ import Gargantext.API.Corpus.New.File (FileType(..)) import Gargantext.API.Ngrams import Gargantext.API.Orchestrator.Types import Gargantext.API.Types (GargServer) -import Gargantext.Database.Flow (FlowCmdM) -import Gargantext.Database.Schema.Ngrams (NgramsType(..), ngramsTypes) -import Gargantext.Database.Types.Node import Gargantext.Core.Utils.Prefix (unPrefixSwagger) +import Gargantext.Database.Action.Flow (FlowCmdM) +import Gargantext.Database.Admin.Types.Node +import Gargantext.Database.Schema.Ngrams (NgramsType(..), ngramsTypes) import Gargantext.Prelude import Network.HTTP.Media ((//), (/:)) import Servant import Servant.Job.Async -import Web.FormUrlEncoded (FromForm) import Servant.Job.Utils (jsonOptions) +import Web.FormUrlEncoded (FromForm) ------------------------------------------------------------------------ type NgramsList = (Map NgramsType (Versioned NgramsTableMap)) diff --git a/src/Gargantext/API/Ngrams/Tools.hs b/src/Gargantext/API/Ngrams/Tools.hs index 70f18315..045059b4 100644 --- a/src/Gargantext/API/Ngrams/Tools.hs +++ b/src/Gargantext/API/Ngrams/Tools.hs @@ -31,7 +31,6 @@ import Gargantext.Prelude import qualified Data.Map.Strict as Map import qualified Data.Set as Set - type RootTerm = Text getRepo :: RepoCmdM env err m => m NgramsRepo diff --git a/src/Gargantext/API/Node.hs b/src/Gargantext/API/Node.hs index cc7ef494..5abc64e4 100644 --- a/src/Gargantext/API/Node.hs +++ b/src/Gargantext/API/Node.hs @@ -53,18 +53,18 @@ import Gargantext.API.Table import Gargantext.API.Types import Gargantext.Core.Types (NodeTableResult) import Gargantext.Core.Types.Main (Tree, NodeTree, ListType) -import Gargantext.Database.Config (nodeTypeId) -import Gargantext.Database.Flow.Pairing (pairing) -import Gargantext.Database.Facet (FacetDoc, OrderBy(..)) -import Gargantext.Database.Node.Children (getChildren) -import Gargantext.Database.Node.User (NodeUser) +import Gargantext.Database.Action.Facet (FacetDoc, OrderBy(..)) +import Gargantext.Database.Action.Flow.Pairing (pairing) +import Gargantext.Database.Action.Query.Node.Children (getChildren) +import Gargantext.Database.Action.Query.Node.UpdateOpaleye (updateHyperdata) +import Gargantext.Database.Action.Query.Node.User (NodeUser) +import Gargantext.Database.Action.Tree (treeDB) +import Gargantext.Database.Admin.Config (nodeTypeId) +import Gargantext.Database.Admin.Types.Errors (HasNodeError(..)) +import Gargantext.Database.Admin.Types.Node +import Gargantext.Database.Admin.Utils -- (Cmd, CmdM) import Gargantext.Database.Schema.Node (getNodesWithParentId, getNodeWith, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, getNodeUser) import Gargantext.Database.Schema.NodeNode -- (nodeNodesCategory, insertNodeNode, NodeNode(..)) -import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata) -import Gargantext.Database.Tree (treeDB) -import Gargantext.Database.Types.Errors (HasNodeError(..)) -import Gargantext.Database.Types.Node -import Gargantext.Database.Utils -- (Cmd, CmdM) import Gargantext.Prelude import Gargantext.Viz.Chart import Gargantext.Viz.Phylo.API (PhyloAPI, phyloAPI) diff --git a/src/Gargantext/API/Search.hs b/src/Gargantext/API/Search.hs index 82d89f61..50230e93 100644 --- a/src/Gargantext/API/Search.hs +++ b/src/Gargantext/API/Search.hs @@ -25,21 +25,20 @@ Count API part of Gargantext. module Gargantext.API.Search where -import GHC.Generics (Generic) -import Data.Time (UTCTime) import Data.Aeson.TH (deriveJSON) import Data.Swagger import Data.Text (Text) -import Servant -import Test.QuickCheck.Arbitrary -import Test.QuickCheck (elements) --- import Control.Applicative ((<*>)) +import Data.Time (UTCTime) +import GHC.Generics (Generic) import Gargantext.API.Types (GargServer) -import Gargantext.Prelude import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) -import Gargantext.Database.Types.Node -import Gargantext.Database.TextSearch -import Gargantext.Database.Facet +import Gargantext.Database.Action.Facet +import Gargantext.Database.Action.Search +import Gargantext.Database.Admin.Types.Node +import Gargantext.Prelude +import Servant +import Test.QuickCheck (elements) +import Test.QuickCheck.Arbitrary ----------------------------------------------------------------------- data SearchQuery = SearchQuery diff --git a/src/Gargantext/API/Settings.hs b/src/Gargantext/API/Settings.hs index 39401905..f04076cf 100644 --- a/src/Gargantext/API/Settings.hs +++ b/src/Gargantext/API/Settings.hs @@ -26,45 +26,42 @@ TODO-SECURITY: Critical module Gargantext.API.Settings where -import System.Directory -import System.Log.FastLogger -import GHC.Enum -import GHC.Generics (Generic) -import Prelude (Bounded(), fail) -import System.Environment (lookupEnv) -import System.IO (FilePath, hClose) -import System.IO.Temp (withTempFile) -import System.FileLock (tryLockFile, unlockFile, SharedExclusive(Exclusive)) -import Database.PostgreSQL.Simple (Connection, connect, close, ConnectInfo) -import Network.HTTP.Client (Manager) -import Network.HTTP.Client.TLS (newTlsManager) - +import Control.Concurrent +import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceFreq, debounceAction) +import Control.Exception (finally) +import Control.Lens +import Control.Monad.Logger +import Control.Monad.Reader import Data.Aeson -import Data.Maybe (fromMaybe) +import Data.ByteString (ByteString) import Data.Either (either) +import Data.Maybe (fromMaybe) import Data.Pool (Pool, createPool) import Data.Text ---import Data.Text.Encoding (encodeUtf8) -import Data.ByteString (ByteString) -import qualified Data.ByteString.Lazy as L - +import Database.PostgreSQL.Simple (Connection, connect, close, ConnectInfo) +import GHC.Enum +import GHC.Generics (Generic) +import Gargantext.API.Ngrams (NgramsRepo, HasRepoVar(..), HasRepoSaver(..), HasRepo(..), RepoEnv(..), r_version, saveRepo, initRepo, renv_var, renv_lock) +import Gargantext.API.Orchestrator.Types +import Gargantext.Database.Admin.Utils (databaseParameters, HasConnectionPool(..), Cmd', runCmd) +import Gargantext.Prelude +import Network.HTTP.Client (Manager) +import Network.HTTP.Client.TLS (newTlsManager) +import Prelude (Bounded(), fail) import Servant import Servant.Auth.Server (defaultJWTSettings, JWTSettings, CookieSettings(..), XsrfCookieSettings(..), defaultCookieSettings, defaultXsrfCookieSettings, readKey, writeKey) import Servant.Client (BaseUrl, parseBaseUrl) -import qualified Servant.Job.Core import Servant.Job.Async (newJobEnv, defaultSettings, HasJobEnv(..), Job) +import System.Directory +import System.Environment (lookupEnv) +import System.FileLock (tryLockFile, unlockFile, SharedExclusive(Exclusive)) +import System.IO (FilePath, hClose) +import System.IO.Temp (withTempFile) +import System.Log.FastLogger import Web.HttpApiData (parseUrlPiece) +import qualified Data.ByteString.Lazy as L +import qualified Servant.Job.Core -import Control.Concurrent -import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceFreq, debounceAction) -import Control.Exception (finally) -import Control.Monad.Logger -import Control.Monad.Reader -import Control.Lens -import Gargantext.Prelude -import Gargantext.Database.Utils (databaseParameters, HasConnectionPool(..), Cmd', runCmd) -import Gargantext.API.Ngrams (NgramsRepo, HasRepoVar(..), HasRepoSaver(..), HasRepo(..), RepoEnv(..), r_version, saveRepo, initRepo, renv_var, renv_lock) -import Gargantext.API.Orchestrator.Types type PortNumber = Int diff --git a/src/Gargantext/API/Table.hs b/src/Gargantext/API/Table.hs index 5eb2e0ca..80eaa155 100644 --- a/src/Gargantext/API/Table.hs +++ b/src/Gargantext/API/Table.hs @@ -46,11 +46,11 @@ import GHC.Generics (Generic) import Gargantext.API.Ngrams (TabType(..)) import Gargantext.Core.Types (Offset, Limit, TableResult(..)) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) -import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..), runViewAuthorsDoc) -import Gargantext.Database.Learn (FavOrTrash(..), moreLike) -import Gargantext.Database.TextSearch -import Gargantext.Database.Types.Node -import Gargantext.Database.Utils -- (Cmd, CmdM) +import Gargantext.Database.Action.Facet (FacetDoc , runViewDocuments, OrderBy(..), runViewAuthorsDoc) +import Gargantext.Database.Action.Learn (FavOrTrash(..), moreLike) +import Gargantext.Database.Action.Search +import Gargantext.Database.Admin.Types.Node +import Gargantext.Database.Admin.Utils -- (Cmd, CmdM) import Gargantext.Prelude import Servant import Test.QuickCheck (elements) diff --git a/src/Gargantext/API/Types.hs b/src/Gargantext/API/Types.hs index 98d28a3b..70626911 100644 --- a/src/Gargantext/API/Types.hs +++ b/src/Gargantext/API/Types.hs @@ -41,9 +41,9 @@ import Gargantext.API.Ngrams import Gargantext.API.Orchestrator.Types import Gargantext.API.Settings import Gargantext.Core.Types -import Gargantext.Database.Tree -import Gargantext.Database.Types.Errors (NodeError(..), HasNodeError(..)) -import Gargantext.Database.Utils +import Gargantext.Database.Action.Tree +import Gargantext.Database.Admin.Types.Errors (NodeError(..), HasNodeError(..)) +import Gargantext.Database.Admin.Utils import Gargantext.Prelude import Servant import Servant.Job.Async (HasJobEnv) diff --git a/src/Gargantext/Core/Flow/Types.hs b/src/Gargantext/Core/Flow/Types.hs index 7d3f5137..c62b8fd1 100644 --- a/src/Gargantext/Core/Flow/Types.hs +++ b/src/Gargantext/Core/Flow/Types.hs @@ -19,17 +19,17 @@ module Gargantext.Core.Flow.Types where import Control.Lens (Lens') import Data.Map (Map) -import Data.Text (Text) import Data.Maybe (Maybe) -import Gargantext.Text.Terms (TermType) +import Data.Text (Text) import Gargantext.Core (Lang) -import Gargantext.Prelude -import Gargantext.Database.Schema.Ngrams (Ngrams, NgramsType) import Gargantext.Core.Types.Main (HashId) -import Gargantext.Database.Types.Node -- (HyperdataDocument(..)) -import Gargantext.Database.Node.Contact -- (HyperdataContact(..)) -import Gargantext.Database.Node.Document.Insert (AddUniqId, InsertDb) -import Gargantext.Database.Utils (Cmd) +import Gargantext.Database.Action.Query.Node.Contact -- (HyperdataContact(..)) +import Gargantext.Database.Action.Query.Node.Document.Insert (AddUniqId, InsertDb) +import Gargantext.Database.Admin.Types.Node -- (HyperdataDocument(..)) +import Gargantext.Database.Admin.Utils (Cmd) +import Gargantext.Database.Schema.Ngrams (Ngrams, NgramsType) +import Gargantext.Prelude +import Gargantext.Text.Terms (TermType) type FlowCorpus a = ( AddUniqId a , UniqId a diff --git a/src/Gargantext/Core/Types.hs b/src/Gargantext/Core/Types.hs index 13c487f0..508dd9d3 100644 --- a/src/Gargantext/Core/Types.hs +++ b/src/Gargantext/Core/Types.hs @@ -17,7 +17,7 @@ commentary with @some markup@. {-# LANGUAGE TemplateHaskell #-} module Gargantext.Core.Types ( module Gargantext.Core.Types.Main - , module Gargantext.Database.Types.Node + , module Gargantext.Database.Admin.Types.Node , Term, Terms(..) , TokenTag(..), POS(..), NER(..) , Label, Stems @@ -28,7 +28,6 @@ module Gargantext.Core.Types ( module Gargantext.Core.Types.Main , TODO(..) ) where ---import qualified Data.Set as S import Control.Lens (Prism', (#)) import Control.Monad.Error.Class (MonadError, throwError) import Data.Aeson @@ -43,11 +42,10 @@ import Data.Validity import GHC.Generics import Gargantext.Core.Types.Main import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) -import Gargantext.Database.Types.Node +import Gargantext.Database.Admin.Types.Node import Gargantext.Prelude import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) ------------------------------------------------------------------------- ------------------------------------------------------------------------ type Name = Text type Term = Text diff --git a/src/Gargantext/Core/Types/Individu.hs b/src/Gargantext/Core/Types/Individu.hs index a27d08aa..344b5145 100644 --- a/src/Gargantext/Core/Types/Individu.hs +++ b/src/Gargantext/Core/Types/Individu.hs @@ -18,9 +18,9 @@ Individu defintions module Gargantext.Core.Types.Individu where -import Gargantext.Prelude hiding (reverse) import Data.Text (Text, pack, reverse) -import Gargantext.Database.Types.Node (NodeId) +import Gargantext.Database.Admin.Types.Node (NodeId) +import Gargantext.Prelude hiding (reverse) type UserId = Int diff --git a/src/Gargantext/Core/Types/Main.hs b/src/Gargantext/Core/Types/Main.hs index 0dcd16a3..d2a23e57 100644 --- a/src/Gargantext/Core/Types/Main.hs +++ b/src/Gargantext/Core/Types/Main.hs @@ -21,21 +21,19 @@ Portability : POSIX module Gargantext.Core.Types.Main where ------------------------------------------------------------------------ -import Prelude (Enum, Bounded, minBound, maxBound) import Data.Aeson (FromJSON, ToJSON) import Data.Aeson.TH (deriveJSON) -import Data.Map (fromList, lookup) import Data.Either (Either(..)) import Data.Eq (Eq()) +import Data.Map (fromList, lookup) import Data.Monoid ((<>)) -import Data.Text (Text, unpack) import Data.Swagger - -import Gargantext.Database.Types.Node -- (NodeType(..), Node, Hyperdata(..)) +import Data.Text (Text, unpack) +import GHC.Generics (Generic) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) +import Gargantext.Database.Admin.Types.Node -- (NodeType(..), Node, Hyperdata(..)) import Gargantext.Prelude - -import GHC.Generics (Generic) +import Prelude (Enum, Bounded, minBound, maxBound) import Servant.API (FromHttpApiData(..)) import Test.QuickCheck (elements) import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) diff --git a/src/Gargantext/Database.hs b/src/Gargantext/Database.hs index 91cdd67b..f9a5d993 100644 --- a/src/Gargantext/Database.hs +++ b/src/Gargantext/Database.hs @@ -16,7 +16,7 @@ Gargantext's database. {-# LANGUAGE NoImplicitPrelude #-} -module Gargantext.Database ( module Gargantext.Database.Utils +module Gargantext.Database ( module Gargantext.Database.Admin.Utils -- , module Gargantext.Database.Bashql ) where diff --git a/src/Gargantext/Database/Action/Query/Node.hs b/src/Gargantext/Database/Action/Query/Node.hs index 0301ca6e..05283f50 100644 --- a/src/Gargantext/Database/Action/Query/Node.hs +++ b/src/Gargantext/Database/Action/Query/Node.hs @@ -43,7 +43,8 @@ import Gargantext.Database.Admin.Config (nodeTypeId) import Gargantext.Database.Admin.Types.Errors import Gargantext.Database.Admin.Types.Node (NodeType(..), defaultCorpus, Hyperdata, HyperData(..)) import Gargantext.Database.Admin.Utils -import Gargantext.Database.Node.Contact (HyperdataContact(..), arbitraryHyperdataContact) +import Gargantext.Database.Action.Query.Node.Contact (HyperdataContact(..), arbitraryHyperdataContact) +import Gargantext.Database.Action.Query.Node.User import Gargantext.Database.Schema.Node import Gargantext.Prelude hiding (sum, head) import Gargantext.Viz.Graph (HyperdataGraph(..)) diff --git a/src/Gargantext/Database/Action/Query/Node/Select.hs b/src/Gargantext/Database/Action/Query/Node/Select.hs index 211dfcec..3277a84c 100644 --- a/src/Gargantext/Database/Action/Query/Node/Select.hs +++ b/src/Gargantext/Database/Action/Query/Node/Select.hs @@ -24,6 +24,7 @@ import Gargantext.Database.Admin.Config import Gargantext.Database.Admin.Utils import Gargantext.Database.Schema.Node import Gargantext.Database.Schema.User +import Gargantext.Database.Action.Query.Node import Opaleye selectNodesWithUsername :: NodeType -> Username -> Cmd err [NodeId] diff --git a/src/Gargantext/Database/Action/Query/Node/UpdateOpaleye.hs b/src/Gargantext/Database/Action/Query/Node/UpdateOpaleye.hs index 55bfb5a3..5f33bb39 100644 --- a/src/Gargantext/Database/Action/Query/Node/UpdateOpaleye.hs +++ b/src/Gargantext/Database/Action/Query/Node/UpdateOpaleye.hs @@ -26,6 +26,7 @@ import Gargantext.Prelude import Gargantext.Database.Schema.Node import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Utils (Cmd, mkCmd) +import Gargantext.Database.Action.Query.Node (pgNodeId) updateHyperdata :: ToJSON a => NodeId -> a -> Cmd err Int64 updateHyperdata i h = mkCmd $ \c -> runUpdate_ c (updateHyperdataQuery i h) diff --git a/src/Gargantext/Database/Action/Query/Tree.hs b/src/Gargantext/Database/Action/Query/Tree.hs index 471597e3..0246bb2c 100644 --- a/src/Gargantext/Database/Action/Query/Tree.hs +++ b/src/Gargantext/Database/Action/Query/Tree.hs @@ -37,11 +37,11 @@ import Database.PostgreSQL.Simple.SqlQQ import Gargantext.Prelude import Gargantext.Core.Types.Main (NodeTree(..), Tree(..)) -import Gargantext.Database.Config (fromNodeTypeId, nodeTypeId) +import Gargantext.Database.Admin.Config (fromNodeTypeId, nodeTypeId) import Gargantext.Database.Admin.Types.Node (NodeId, NodeType, DocId, allNodeTypes) import Gargantext.Database.Admin.Utils (Cmd, runPGSQuery) -import Gargantext.Database.Admin.Tools.Node -import Gargantext.Database.Admin.Tools.User +import Gargantext.Database.Action.Query.Node +import Gargantext.Database.Action.Query.User ------------------------------------------------------------------------ -- import Gargantext.Database.Utils (runCmdDev) diff --git a/src/Gargantext/Database/Action/Query/Tree/Root.hs b/src/Gargantext/Database/Action/Query/Tree/Root.hs index 83b706d1..c583a802 100644 --- a/src/Gargantext/Database/Action/Query/Tree/Root.hs +++ b/src/Gargantext/Database/Action/Query/Tree/Root.hs @@ -30,7 +30,7 @@ module Gargantext.Database.Action.Query.Tree.Root import Control.Arrow (returnA) import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Database.Admin.Config (nodeTypeId) -import Gargantext.Database.Action.Node.User (HyperdataUser) +import Gargantext.Database.Action.Query.Node.User (HyperdataUser) import Gargantext.Database.Schema.Node (NodeRead) import Gargantext.Database.Schema.Node (queryNodeTable) import Gargantext.Database.Schema.User (queryUserTable, UserPoly(..)) diff --git a/src/Gargantext/Database/Admin/Bashql.hs b/src/Gargantext/Database/Admin/Bashql.hs index 4834e4a4..b2545dfd 100644 --- a/src/Gargantext/Database/Admin/Bashql.hs +++ b/src/Gargantext/Database/Admin/Bashql.hs @@ -85,6 +85,7 @@ import Data.List (concat, last) import Gargantext.Core.Types import Gargantext.Database.Admin.Utils (runOpaQuery, Cmd) import Gargantext.Database.Schema.Node +import Gargantext.Database.Action.Query.Node import qualified Gargantext.Database.Action.Query.Node.Update as U (Update(..), update) import Gargantext.Prelude diff --git a/src/Gargantext/Database/Admin/Trigger/Init.hs b/src/Gargantext/Database/Admin/Trigger/Init.hs index 7bfe9721..92feb2eb 100644 --- a/src/Gargantext/Database/Admin/Trigger/Init.hs +++ b/src/Gargantext/Database/Admin/Trigger/Init.hs @@ -20,9 +20,9 @@ Ngrams by node enable contextual metrics. module Gargantext.Database.Admin.Trigger.Init where -import Gargantext.Database.Admin.Triggers.NodeNodeNgrams (triggerCountInsert, triggerCountInsert2) -import Gargantext.Database.Admin.Triggers.Nodes (triggerSearchUpdate) -import Gargantext.Database.Admin.Triggers.NodesNodes (triggerDeleteCount, triggerInsertCount, triggerUpdateAdd, triggerUpdateDel, MasterListId) -- , triggerCoocInsert) +import Gargantext.Database.Admin.Trigger.NodeNodeNgrams (triggerCountInsert, triggerCountInsert2) +import Gargantext.Database.Admin.Trigger.Nodes (triggerSearchUpdate) +import Gargantext.Database.Admin.Trigger.NodesNodes (triggerDeleteCount, triggerInsertCount, triggerUpdateAdd, triggerUpdateDel, MasterListId) -- , triggerCoocInsert) import Gargantext.Database.Admin.Utils (Cmd) import Gargantext.Prelude diff --git a/src/Gargantext/Ext/IMTUser.hs b/src/Gargantext/Ext/IMTUser.hs index 71d65272..6b9da907 100644 --- a/src/Gargantext/Ext/IMTUser.hs +++ b/src/Gargantext/Ext/IMTUser.hs @@ -19,17 +19,17 @@ Here is writtent a common interface. module Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile) where - -import System.IO (FilePath) import Codec.Serialise import Data.Maybe (Maybe, catMaybes) import Data.Text (Text) import GHC.Generics (Generic) +import Gargantext.Database.Action.Query.Node.Contact -- (HyperdataContact, ContactWho, ContactWhere, ContactTouch, ContactMetaData) import Gargantext.Prelude - -import Gargantext.Database.Admin.Node.Contact -- (HyperdataContact, ContactWho, ContactWhere, ContactTouch, ContactMetaData) +import System.IO (FilePath) import qualified Data.ByteString.Lazy as BSL +------------------------------------------------------------------------ + instance Serialise IMTUser deserialiseImtUsersFromFile :: FilePath -> IO [HyperdataContact] diff --git a/src/Gargantext/Prelude/Utils.hs b/src/Gargantext/Prelude/Utils.hs index 515d60df..c35cab71 100644 --- a/src/Gargantext/Prelude/Utils.hs +++ b/src/Gargantext/Prelude/Utils.hs @@ -17,24 +17,24 @@ module Gargantext.Prelude.Utils where import Control.Lens (view) -import Control.Monad.Reader (MonadReader) import Control.Monad.Random.Class (MonadRandom) -import Data.Text (Text) +import Control.Monad.Reader (MonadReader) import Control.Monad.Reader (ask) +import Crypto.Argon2 as Crypto +import Data.ByteString (ByteString) +import Data.ByteString.Base64.URL as URL +import Data.Either +import Data.Text (Text) import GHC.IO (FilePath) -import Gargantext.Prelude import Gargantext.API.Settings -import System.Random (newStdGen) -import qualified System.Random.Shuffle as SRS +import Gargantext.Database.Admin.Types.Node (NodeId, NodeType) +import Gargantext.Prelude import System.Directory (createDirectoryIfMissing) +import System.Random (newStdGen) import qualified Data.ByteString.Lazy.Char8 as Char import qualified Data.Digest.Pure.SHA as SHA (sha256, showDigest) import qualified Data.Text as Text -import Gargantext.Database.Types.Node (NodeId, NodeType) -import Data.ByteString (ByteString) -import Crypto.Argon2 as Crypto -import Data.Either -import Data.ByteString.Base64.URL as URL +import qualified System.Random.Shuffle as SRS -------------------------------------------------------------------------- shuffle :: MonadRandom m => [a] -> m [a] diff --git a/src/Gargantext/Text/Corpus/API/Hal.hs b/src/Gargantext/Text/Corpus/API/Hal.hs index cca40cd2..703aa333 100644 --- a/src/Gargantext/Text/Corpus/API/Hal.hs +++ b/src/Gargantext/Text/Corpus/API/Hal.hs @@ -17,14 +17,13 @@ module Gargantext.Text.Corpus.API.Hal import Data.Maybe import Data.Text (Text, pack, intercalate) -import Gargantext.Prelude import Gargantext.Core (Lang(..)) +import Gargantext.Database.Admin.Types.Node (HyperdataDocument(..)) +import Gargantext.Prelude import qualified Gargantext.Text.Corpus.Parsers.Date as Date -import Gargantext.Database.Types.Node (HyperdataDocument(..)) - import qualified HAL as HAL -import qualified HAL.Doc.Corpus as HAL import qualified HAL.Client as HAL +import qualified HAL.Doc.Corpus as HAL get :: Lang -> Text -> Maybe Integer -> IO [HyperdataDocument] get la q ml = do diff --git a/src/Gargantext/Text/Corpus/API/Istex.hs b/src/Gargantext/Text/Corpus/API/Istex.hs index 41921214..565ffe88 100644 --- a/src/Gargantext/Text/Corpus/API/Istex.hs +++ b/src/Gargantext/Text/Corpus/API/Istex.hs @@ -16,15 +16,14 @@ module Gargantext.Text.Corpus.API.Istex where import Data.Either (either) -import Data.Maybe import Data.List (concat) +import Data.Maybe import Data.Maybe (catMaybes) import Data.Text (Text, pack) -import Gargantext.Prelude import Gargantext.Core (Lang(..)) +import Gargantext.Database.Admin.Types.Node (HyperdataDocument(..)) +import Gargantext.Prelude import qualified Gargantext.Text.Corpus.Parsers.Date as Date -import Gargantext.Database.Types.Node (HyperdataDocument(..)) - import qualified ISTEX as ISTEX import qualified ISTEX.Client as ISTEX diff --git a/src/Gargantext/Text/Corpus/API/Pubmed.hs b/src/Gargantext/Text/Corpus/API/Pubmed.hs index aec9b83c..8ad4ae5d 100644 --- a/src/Gargantext/Text/Corpus/API/Pubmed.hs +++ b/src/Gargantext/Text/Corpus/API/Pubmed.hs @@ -19,7 +19,7 @@ import Data.Maybe import Data.Text (Text) import Gargantext.Prelude import Gargantext.Core (Lang(..)) -import Gargantext.Database.Types.Node (HyperdataDocument(..)) +import Gargantext.Database.Admin.Types.Node (HyperdataDocument(..)) import qualified Data.Text as Text import qualified PUBMED as PubMed diff --git a/src/Gargantext/Text/Corpus/Parsers.hs b/src/Gargantext/Text/Corpus/Parsers.hs index f922a89d..cec816ac 100644 --- a/src/Gargantext/Text/Corpus/Parsers.hs +++ b/src/Gargantext/Text/Corpus/Parsers.hs @@ -25,7 +25,6 @@ please follow the types. module Gargantext.Text.Corpus.Parsers (FileFormat(..), clean, parseFile, cleanText, parseFormat) where ---import Data.ByteString (ByteString) import "zip" Codec.Archive.Zip (withArchive, getEntry, getEntries) import Control.Concurrent.Async as CCA (mapConcurrently) import Control.Monad (join) @@ -40,15 +39,15 @@ import Data.Text (Text) import Data.Text.Encoding (decodeUtf8) import Data.Tuple.Extra (both, first, second) import Gargantext.Core (Lang(..)) -import Gargantext.Database.Types.Node (HyperdataDocument(..)) +import Gargantext.Database.Admin.Types.Node (HyperdataDocument(..)) import Gargantext.Prelude import Gargantext.Text.Corpus.Parsers.CSV (parseHal, parseHal', parseCsv, parseCsv') import Gargantext.Text.Corpus.Parsers.RIS.Presse (presseEnrich) import Gargantext.Text.Learn (detectLangDefault) import System.FilePath (FilePath(), takeExtension) import qualified Data.ByteString as DB -import qualified Data.ByteString.Lazy as DBL import qualified Data.ByteString.Char8 as DBC +import qualified Data.ByteString.Lazy as DBL import qualified Data.Map as DM import qualified Data.Text as DT import qualified Gargantext.Text.Corpus.Parsers.Date as Date diff --git a/src/Gargantext/Text/Corpus/Parsers/CSV.hs b/src/Gargantext/Text/Corpus/Parsers/CSV.hs index 53524887..8e4d70e6 100644 --- a/src/Gargantext/Text/Corpus/Parsers/CSV.hs +++ b/src/Gargantext/Text/Corpus/Parsers/CSV.hs @@ -27,12 +27,12 @@ import Data.Vector (Vector) import GHC.IO (FilePath) import GHC.Real (round) import GHC.Word (Word8) -import Gargantext.Database.Types.Node -- (HyperdataDocument(..)) +import Gargantext.Database.Admin.Types.Node -- (HyperdataDocument(..)) import Gargantext.Prelude hiding (length) import Gargantext.Text import Gargantext.Text.Context -import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL import qualified Data.Vector as V --------------------------------------------------------------- diff --git a/src/Gargantext/Text/Corpus/Parsers/GrandDebat.hs b/src/Gargantext/Text/Corpus/Parsers/GrandDebat.hs index d16e52a5..0ceb844d 100644 --- a/src/Gargantext/Text/Corpus/Parsers/GrandDebat.hs +++ b/src/Gargantext/Text/Corpus/Parsers/GrandDebat.hs @@ -24,7 +24,7 @@ import Data.Maybe (Maybe()) import Data.Text (Text) import GHC.Generics (Generic) import Gargantext.Core (Lang(..)) -import Gargantext.Database.Types.Node +import Gargantext.Database.Admin.Types.Node import Gargantext.Prelude import Gargantext.Prelude.Utils import qualified Data.ByteString.Lazy as DBL diff --git a/src/Gargantext/Text/Corpus/Parsers/Isidore.hs b/src/Gargantext/Text/Corpus/Parsers/Isidore.hs index 7740712f..4499581d 100644 --- a/src/Gargantext/Text/Corpus/Parsers/Isidore.hs +++ b/src/Gargantext/Text/Corpus/Parsers/Isidore.hs @@ -27,9 +27,9 @@ import Data.RDF hiding (triple, Query) import Data.Text hiding (groupBy, map) import Database.HSparql.Connection import Database.HSparql.QueryGenerator -import Gargantext.Database.Types.Node (HyperdataDocument(..)) -import Gargantext.Prelude import Gargantext.Core (Lang) +import Gargantext.Database.Admin.Types.Node (HyperdataDocument(..)) +import Gargantext.Prelude import Network.Wreq (getWith, Response, defaults, header, param, responseStatus, responseBody) import Prelude (String) diff --git a/src/Gargantext/Text/List.hs b/src/Gargantext/Text/List.hs index 01facda8..2581ea51 100644 --- a/src/Gargantext/Text/List.hs +++ b/src/Gargantext/Text/List.hs @@ -18,7 +18,6 @@ module Gargantext.Text.List where import Data.Either (partitionEithers, Either(..)) --- import Debug.Trace (trace) import Data.Map (Map) import Data.Set (Set) import Data.Text (Text) @@ -26,13 +25,12 @@ import Gargantext.API.Ngrams (NgramsElement, mkNgramsElement, RootParent(..), mS import Gargantext.API.Ngrams.Tools (getCoocByNgrams', Diagonal(..)) import Gargantext.Core (Lang(..)) import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId, NodeId) -import Gargantext.Database.Metrics.NgramsByNode (getTficf', sortTficf, ngramsGroup, getNodesByNgramsUser, groupNodesByNgramsWith) +import Gargantext.Database.Action.Metrics.NgramsByNode (getTficf', sortTficf, ngramsGroup, getNodesByNgramsUser, groupNodesByNgramsWith) +import Gargantext.Database.Admin.Utils (Cmd) import Gargantext.Database.Schema.Ngrams (NgramsType(..)) -import Gargantext.Database.Utils (Cmd) +import Gargantext.Prelude import Gargantext.Text.List.Learn (Model(..)) import Gargantext.Text.Metrics (takeScored) -import Gargantext.Prelude ---import Gargantext.Text.Terms (TermType(..)) import qualified Data.Char as Char import qualified Data.List as List import qualified Data.Map as Map diff --git a/src/Gargantext/Text/Metrics/Hetero.purs b/src/Gargantext/Text/Metrics/Hetero.purs index b6504d52..ee10a4ac 100644 --- a/src/Gargantext/Text/Metrics/Hetero.purs +++ b/src/Gargantext/Text/Metrics/Hetero.purs @@ -13,22 +13,18 @@ commentary with @some markup@. module Gargantext.Text.Hetero where -import GHC.Real as R -import Data.Set as S -import Data.Map as M import Data.List.Split as S +import Data.Map as M +import Data.Set as S import Database.PostgreSQL.Simple as PGS -import Opaleye.PGTypes (PGInt4) -import Opaleye.Internal.Column (Column) - -import Gargantext.Database.Gargandb -import Gargantext.Database.Private ---import Gargantext.Utils.Chronos - -import Gargantext.Text.Words (cleanText) -import Gargantext.Text.Count (occurrences) - +import GHC.Real as R +import Gargantext.Database.Admin.Gargandb +import Gargantext.Database.Admin.Private import Gargantext.Database.Simple +import Gargantext.Text.Count (occurrences) +import Gargantext.Text.Words (cleanText) +import Opaleye.Internal.Column (Column) +import Opaleye.PGTypes (PGInt4) --main = do -- t <- getTextquery diff --git a/src/Gargantext/Viz/Chart.hs b/src/Gargantext/Viz/Chart.hs index 28eb2209..f77aec3e 100644 --- a/src/Gargantext/Viz/Chart.hs +++ b/src/Gargantext/Viz/Chart.hs @@ -18,33 +18,31 @@ Portability : POSIX module Gargantext.Viz.Chart where - -import Data.Text (Text) import Data.List (unzip, sortOn) import Data.Map (toList) +import Data.Text (Text) import GHC.Generics (Generic) -import Gargantext.Prelude -import Gargantext.Database.Config +import Gargantext.Core.Types.Main +import Gargantext.Database.Action.Query.Node.Select +import Gargantext.Database.Admin.Config +import Gargantext.Database.Admin.Types.Node (CorpusId) +import Gargantext.Database.Admin.Utils import Gargantext.Database.Schema.NodeNode (selectDocsDates) -import Gargantext.Database.Utils -import Gargantext.Database.Types.Node (CorpusId) -import Gargantext.Database.Node.Select +import Gargantext.Prelude import Gargantext.Text.Metrics.Count (occurrencesWith) -import Gargantext.Core.Types.Main -- Pie Chart import Data.Maybe (catMaybes) -import qualified Data.Map as Map -import qualified Data.List as List -import Gargantext.API.Ngrams.Tools import Gargantext.API.Ngrams.NTree -import Gargantext.Database.Metrics.NgramsByNode +import Gargantext.API.Ngrams.Tools +import Gargantext.Core.Types +import Gargantext.Database.Action.Flow +import Gargantext.Database.Action.Metrics.NgramsByNode import Gargantext.Database.Schema.Ngrams import Gargantext.Database.Schema.Node -import Gargantext.Core.Types -import Gargantext.Database.Flow - import Servant +import qualified Data.List as List +import qualified Data.Map as Map data Chart = ChartHisto | ChartScatter | ChartPie diff --git a/src/Gargantext/Viz/Graph.hs b/src/Gargantext/Viz/Graph.hs index 5b83f8c7..d107a6a3 100644 --- a/src/Gargantext/Viz/Graph.hs +++ b/src/Gargantext/Viz/Graph.hs @@ -25,9 +25,9 @@ import Data.Swagger import Data.Text (Text, pack) import GHC.Generics (Generic) import GHC.IO (FilePath) -import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) import Gargantext.Core.Types (ListId) -import Gargantext.Database.Types.Node (NodeId, Hyperdata) +import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) +import Gargantext.Database.Admin.Types.Node (NodeId, Hyperdata) import Gargantext.Prelude import Test.QuickCheck (elements) import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) diff --git a/src/Gargantext/Viz/Phylo.hs b/src/Gargantext/Viz/Phylo.hs index 9e9e0e39..55690700 100644 --- a/src/Gargantext/Viz/Phylo.hs +++ b/src/Gargantext/Viz/Phylo.hs @@ -29,23 +29,20 @@ one 8, e54847. module Gargantext.Viz.Phylo where -import Prelude (Bounded) +import Control.DeepSeq import Control.Lens (makeLenses) import Data.Aeson.TH (deriveJSON,defaultOptions) +import Data.Map (Map) import Data.Maybe (Maybe) -import Data.Text (Text) import Data.Set (Set) -import Data.Map (Map) -import Data.Vector (Vector) import Data.Swagger ---import Data.Time.Clock.POSIX (POSIXTime) +import Data.Text (Text) +import Data.Vector (Vector) import GHC.Generics (Generic) ---import Gargantext.Database.Schema.Ngrams (NgramsId) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) -import Gargantext.Text.Context (TermList) import Gargantext.Prelude - -import Control.DeepSeq +import Gargantext.Text.Context (TermList) +import Prelude (Bounded) -------------------- -- | PhyloParam | -- diff --git a/src/Gargantext/Viz/Phylo/Main.hs b/src/Gargantext/Viz/Phylo/Main.hs index e8458672..77a3ba63 100644 --- a/src/Gargantext/Viz/Phylo/Main.hs +++ b/src/Gargantext/Viz/Phylo/Main.hs @@ -26,7 +26,7 @@ import Debug.Trace (trace) import GHC.IO (FilePath) import Gargantext.API.Ngrams.Tools (getTermsWith) import Gargantext.Core.Types -import Gargantext.Database.Flow +import Gargantext.Database.Action.Flow import Gargantext.Database.Schema.Ngrams (NgramsType(..)) import Gargantext.Database.Schema.Node (defaultList) import Gargantext.Database.Schema.NodeNode (selectDocs) -- 2.47.0 From f7186aaab8ba682b20b97ad7d950d8dcabf45588 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Mon, 13 Apr 2020 08:17:37 +0200 Subject: [PATCH 10/16] [DB|WIP] fix imports and cycles --- src/Gargantext/Database/Action/Flow/Utils.hs | 18 ++++ src/Gargantext/Database/Action/Query.hs | 88 +++++++++++++++++++ .../Database/Action/Query/Ngrams.hs | 2 + src/Gargantext/Database/Action/Query/Node.hs | 59 ------------- .../Database/Action/Query/Node/Children.hs | 3 +- .../Database/Action/Query/Node/User.hs | 34 +++---- src/Gargantext/Database/Action/Query/Tree.hs | 1 + src/Gargantext/Database/Action/Search.hs | 2 +- src/Gargantext/Database/Admin/Types/Node.hs | 12 ++- src/Gargantext/Database/Admin/Utils.hs | 1 + src/Gargantext/Database/Schema/NodeNode.hs | 3 +- .../Database/Schema/NodeNodeNgrams.hs | 2 +- .../Database/Schema/NodeNodeNgrams2.hs | 2 +- .../Schema/Node_NodeNgramsNodeNgrams.hs | 4 +- 14 files changed, 140 insertions(+), 91 deletions(-) create mode 100644 src/Gargantext/Database/Action/Query.hs diff --git a/src/Gargantext/Database/Action/Flow/Utils.hs b/src/Gargantext/Database/Action/Flow/Utils.hs index 718c5a4f..91258f30 100644 --- a/src/Gargantext/Database/Action/Flow/Utils.hs +++ b/src/Gargantext/Database/Action/Flow/Utils.hs @@ -23,9 +23,27 @@ import Gargantext.Database.Admin.Types.Node (NodeId, Node, NodePoly(..), Hyperda import Gargantext.Database.Admin.Utils (Cmd) import Gargantext.Database.Schema.Ngrams import Gargantext.Database.Schema.NodeNodeNgrams +import Gargantext.Database.Action.Query.Node (getNode) import Gargantext.Prelude import qualified Data.Map as DM + +getUserId :: HasNodeError err + => User + -> Cmd err UserId +getUserId (UserDBId uid) = pure uid +getUserId (RootId rid) = do + n <- getNode rid + pure $ _node_userId n +getUserId (UserName u ) = do + muser <- getUser u + case muser of + Just user -> pure $ userLight_id user + Nothing -> nodeError NoUserFound + + + + toMaps :: Hyperdata a => (a -> Map (NgramsT Ngrams) Int) -> [Node a] diff --git a/src/Gargantext/Database/Action/Query.hs b/src/Gargantext/Database/Action/Query.hs new file mode 100644 index 00000000..b4b8bfde --- /dev/null +++ b/src/Gargantext/Database/Action/Query.hs @@ -0,0 +1,88 @@ +{-| +Module : Gargantext.Database.Action.Query +Description : Main Tools of Node to the database +Copyright : (c) CNRS, 2017-Present +License : AGPL + CECILL v3 +Maintainer : team@gargantext.org +Stability : experimental +Portability : POSIX +-} + +{-# OPTIONS_GHC -fno-warn-name-shadowing #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +{-# LANGUAGE Arrows #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Gargantext.Database.Action.Query + where + +import Gargantext.Database.Action.Query.Node +import Gargantext.Database.Action.Query.User +import Opaleye hiding (FromField) +import Prelude hiding (null, id, map, sum) + + +------------------------------------------------------------------------ +-- | TODO mk all others nodes +mkNodeWithParent :: HasNodeError err + => NodeType + -> Maybe ParentId + -> UserId + -> Name + -> Cmd err [NodeId] +mkNodeWithParent NodeUser (Just _) _ _ = nodeError UserNoParent + +------------------------------------------------------------------------ +mkNodeWithParent NodeUser Nothing uId name = + insertNodesWithParentR Nothing [node NodeUser name fake_HyperdataUser Nothing uId] + +mkNodeWithParent _ Nothing _ _ = nodeError HasParent +------------------------------------------------------------------------ +mkNodeWithParent NodeFolder (Just i) uId name = + insertNodesWithParentR (Just i) [node NodeFolder name hd Nothing uId] + where + hd = defaultFolder + +mkNodeWithParent NodeFolderPrivate (Just i) uId _ = + insertNodesWithParentR (Just i) [node NodeFolderPrivate "Private" hd Nothing uId] + where + hd = defaultFolder + +mkNodeWithParent NodeFolderShared (Just i) uId _ = + insertNodesWithParentR (Just i) [node NodeFolderShared "Shared" hd Nothing uId] + where + hd = defaultFolder + +mkNodeWithParent NodeFolderPublic (Just i) uId _ = + insertNodesWithParentR (Just i) [node NodeFolderPublic "Public" hd Nothing uId] + where + hd = defaultFolder + +mkNodeWithParent NodeTeam (Just i) uId _ = + insertNodesWithParentR (Just i) [node NodeTeam "Team" hd Nothing uId] + where + hd = defaultFolder +------------------------------------------------------------------------ +mkNodeWithParent NodeCorpus (Just i) uId name = + insertNodesWithParentR (Just i) [node NodeCorpus name hd Nothing uId] + where + hd = defaultCorpus + +mkNodeWithParent NodeAnnuaire (Just i) uId name = + insertNodesWithParentR (Just i) [node NodeAnnuaire name hd Nothing uId] + where + hd = defaultAnnuaire + +mkNodeWithParent _ _ _ _ = nodeError NotImplYet + diff --git a/src/Gargantext/Database/Action/Query/Ngrams.hs b/src/Gargantext/Database/Action/Query/Ngrams.hs index 1dd0e0ce..bd7896e9 100644 --- a/src/Gargantext/Database/Action/Query/Ngrams.hs +++ b/src/Gargantext/Database/Action/Query/Ngrams.hs @@ -21,6 +21,8 @@ import Control.Arrow (returnA) import Control.Lens ((^.)) import Data.Text (Text) import Gargantext.Core.Types +import Gargantext.Database.Admin.Types.Node +import Gargantext.Database.Admin.Types.Node (pgNodeId) import Gargantext.Database.Admin.Utils (runOpaQuery, Cmd) import Gargantext.Database.Schema.Ngrams import Gargantext.Database.Schema.Node diff --git a/src/Gargantext/Database/Action/Query/Node.hs b/src/Gargantext/Database/Action/Query/Node.hs index 05283f50..5e4b4891 100644 --- a/src/Gargantext/Database/Action/Query/Node.hs +++ b/src/Gargantext/Database/Action/Query/Node.hs @@ -44,7 +44,6 @@ import Gargantext.Database.Admin.Types.Errors import Gargantext.Database.Admin.Types.Node (NodeType(..), defaultCorpus, Hyperdata, HyperData(..)) import Gargantext.Database.Admin.Utils import Gargantext.Database.Action.Query.Node.Contact (HyperdataContact(..), arbitraryHyperdataContact) -import Gargantext.Database.Action.Query.Node.User import Gargantext.Database.Schema.Node import Gargantext.Prelude hiding (sum, head) import Gargantext.Viz.Graph (HyperdataGraph(..)) @@ -53,9 +52,6 @@ import Opaleye.Internal.QueryArr (Query) import Prelude hiding (null, id, map, sum) -pgNodeId :: NodeId -> Column PGInt4 -pgNodeId = pgInt4 . id2int - queryNodeSearchTable :: Query NodeSearchRead queryNodeSearchTable = queryTable nodeTableSearch @@ -66,7 +62,6 @@ selectNode id = proc () -> do returnA -< row - runGetNodes :: Query NodeRead -> Cmd err [Node HyperdataAny] runGetNodes = runOpaQuery @@ -405,60 +400,6 @@ childWith uId pId (Node' NodeContact txt v []) = node2table uId (Just pId) (Nod childWith _ _ (Node' _ _ _ _) = panic "This NodeType can not be a child" --- =================================================================== -- ------------------------------------------------------------------------- --- | TODO mk all others nodes -mkNodeWithParent :: HasNodeError err - => NodeType - -> Maybe ParentId - -> UserId - -> Name - -> Cmd err [NodeId] -mkNodeWithParent NodeUser (Just _) _ _ = nodeError UserNoParent - ------------------------------------------------------------------------- -mkNodeWithParent NodeUser Nothing uId name = - insertNodesWithParentR Nothing [node NodeUser name fake_HyperdataUser Nothing uId] - -mkNodeWithParent _ Nothing _ _ = nodeError HasParent ------------------------------------------------------------------------- -mkNodeWithParent NodeFolder (Just i) uId name = - insertNodesWithParentR (Just i) [node NodeFolder name hd Nothing uId] - where - hd = defaultFolder - -mkNodeWithParent NodeFolderPrivate (Just i) uId _ = - insertNodesWithParentR (Just i) [node NodeFolderPrivate "Private" hd Nothing uId] - where - hd = defaultFolder - -mkNodeWithParent NodeFolderShared (Just i) uId _ = - insertNodesWithParentR (Just i) [node NodeFolderShared "Shared" hd Nothing uId] - where - hd = defaultFolder - -mkNodeWithParent NodeFolderPublic (Just i) uId _ = - insertNodesWithParentR (Just i) [node NodeFolderPublic "Public" hd Nothing uId] - where - hd = defaultFolder - -mkNodeWithParent NodeTeam (Just i) uId _ = - insertNodesWithParentR (Just i) [node NodeTeam "Team" hd Nothing uId] - where - hd = defaultFolder ------------------------------------------------------------------------- -mkNodeWithParent NodeCorpus (Just i) uId name = - insertNodesWithParentR (Just i) [node NodeCorpus name hd Nothing uId] - where - hd = defaultCorpus - -mkNodeWithParent NodeAnnuaire (Just i) uId name = - insertNodesWithParentR (Just i) [node NodeAnnuaire name hd Nothing uId] - where - hd = defaultAnnuaire - -mkNodeWithParent _ _ _ _ = nodeError NotImplYet ------------------------------------------------------------------------- -- =================================================================== -- -- | -- CorpusDocument is a corpus made from a set of documents diff --git a/src/Gargantext/Database/Action/Query/Node/Children.hs b/src/Gargantext/Database/Action/Query/Node/Children.hs index 3ccee5ec..eb072183 100644 --- a/src/Gargantext/Database/Action/Query/Node/Children.hs +++ b/src/Gargantext/Database/Action/Query/Node/Children.hs @@ -23,11 +23,12 @@ import Control.Arrow (returnA) import Data.Proxy import Gargantext.Core.Types import Gargantext.Database.Action.Query.Filter +import Gargantext.Database.Action.Query.Node import Gargantext.Database.Action.Query.Node.Contact (HyperdataContact) import Gargantext.Database.Admin.Config (nodeTypeId) +import Gargantext.Database.Admin.Types.Node (pgNodeId) import Gargantext.Database.Admin.Utils import Gargantext.Database.Schema.Node -import Gargantext.Database.Schema.Node (pgNodeId) import Gargantext.Database.Schema.NodeNode import Opaleye diff --git a/src/Gargantext/Database/Action/Query/Node/User.hs b/src/Gargantext/Database/Action/Query/Node/User.hs index 656a89a8..03cfa388 100644 --- a/src/Gargantext/Database/Action/Query/Node/User.hs +++ b/src/Gargantext/Database/Action/Query/Node/User.hs @@ -10,11 +10,13 @@ Portability : POSIX -} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} module Gargantext.Database.Action.Query.Node.User @@ -22,20 +24,22 @@ module Gargantext.Database.Action.Query.Node.User import Control.Lens (makeLenses) import Data.Aeson.TH (deriveJSON) +import Data.Maybe (fromMaybe) import Data.Swagger (ToSchema(..), genericDeclareNamedSchema) import Data.Text (Text) import Database.PostgreSQL.Simple.FromField (FromField, fromField) import GHC.Generics (Generic) import Gargantext.Core (Lang(..)) +import Gargantext.Core.Types (Name) import Gargantext.Core.Types.Individu (Username, arbitraryUsername, User(..), UserId) +import Gargantext.Database.Action.Query.Node import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) -import Gargantext.Database.Action.Query.Node (getNode) import Gargantext.Database.Action.Query.Node.Contact (HyperdataContact, fake_HyperdataContact) import Gargantext.Database.Admin.Types.Node (Node,Hyperdata, DocumentId, NodeId(..)) -import Gargantext.Database.Admin.Utils (fromField') -import Gargantext.Database.Schema.Node (Node(..)) +import Gargantext.Database.Admin.Utils -- (fromField', Cmd) +import Gargantext.Database.Schema.Node -- (Node(..)) import Gargantext.Prelude -import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn) +import Opaleye hiding (FromField) import Test.QuickCheck (elements) import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) @@ -130,23 +134,9 @@ $(deriveJSON (unPrefix "_hpu_") ''HyperdataPublic) ----------------------------------------------------------------- -getUserId :: HasNodeError err - => User - -> Cmd err UserId -getUserId (UserDBId uid) = pure uid -getUserId (RootId rid) = do - n <- getNode rid - pure $ _node_userId n -getUserId (UserName u ) = do - muser <- getUser u - case muser of - Just user -> pure $ userLight_id user - Nothing -> nodeError NoUserFound - - getNodeUser :: NodeId -> Cmd err (Node HyperdataUser) getNodeUser nId = do - fromMaybe (error $ "Node does not exist: " <> show nId) . headMay + fromMaybe (panic $ "Node does not exist: " <> show nId) . headMay <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId)) diff --git a/src/Gargantext/Database/Action/Query/Tree.hs b/src/Gargantext/Database/Action/Query/Tree.hs index 0246bb2c..5796b8c7 100644 --- a/src/Gargantext/Database/Action/Query/Tree.hs +++ b/src/Gargantext/Database/Action/Query/Tree.hs @@ -39,6 +39,7 @@ import Gargantext.Prelude import Gargantext.Core.Types.Main (NodeTree(..), Tree(..)) import Gargantext.Database.Admin.Config (fromNodeTypeId, nodeTypeId) import Gargantext.Database.Admin.Types.Node (NodeId, NodeType, DocId, allNodeTypes) +import Gargantext.Database.Admin.Types.Errors import Gargantext.Database.Admin.Utils (Cmd, runPGSQuery) import Gargantext.Database.Action.Query.Node import Gargantext.Database.Action.Query.User diff --git a/src/Gargantext/Database/Action/Search.hs b/src/Gargantext/Database/Action/Search.hs index 73394554..77a3ddfd 100644 --- a/src/Gargantext/Database/Action/Search.hs +++ b/src/Gargantext/Database/Action/Search.hs @@ -29,7 +29,7 @@ import Data.Time (UTCTime) import Database.PostgreSQL.Simple (Query) import Database.PostgreSQL.Simple.ToField import Gargantext.Core.Types -import Gargantext.Database.Action.Facet +import Gargantext.Database.Action.Query.Facet import Gargantext.Database.Action.Query.Join (leftJoin6) import Gargantext.Database.Admin.Config (nodeTypeId) import Gargantext.Database.Admin.Types.Node (NodeType(..)) diff --git a/src/Gargantext/Database/Admin/Types/Node.hs b/src/Gargantext/Database/Admin/Types/Node.hs index 7997e4d5..4fb00600 100644 --- a/src/Gargantext/Database/Admin/Types/Node.hs +++ b/src/Gargantext/Database/Admin/Types/Node.hs @@ -53,9 +53,18 @@ import Test.QuickCheck.Instances.Text () import Test.QuickCheck.Instances.Time () import Text.Read (read) import Text.Show (Show()) +import qualified Opaleye as O + +------------------------------------------------------------------------ +pgNodeId :: NodeId -> O.Column O.PGInt4 +pgNodeId = O.pgInt4 . id2int + where + id2int :: NodeId -> Int + id2int (NodeId n) = n ------------------------------------------------------------------------ + newtype NodeId = NodeId Int deriving (Show, Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON) @@ -123,9 +132,6 @@ type ContactId = NodeId type UserId = Int type MasterUserId = UserId -id2int :: NodeId -> Int -id2int (NodeId n) = n - ------------------------------------------------------------------------ data Status = Status { status_failed :: !Int , status_succeeded :: !Int diff --git a/src/Gargantext/Database/Admin/Utils.hs b/src/Gargantext/Database/Admin/Utils.hs index 35e5c128..3d98ced0 100644 --- a/src/Gargantext/Database/Admin/Utils.hs +++ b/src/Gargantext/Database/Admin/Utils.hs @@ -51,6 +51,7 @@ import qualified Data.ByteString as DB import qualified Data.List as DL import qualified Database.PostgreSQL.Simple as PGS + class HasConnectionPool env where connPool :: Getter env (Pool Connection) diff --git a/src/Gargantext/Database/Schema/NodeNode.hs b/src/Gargantext/Database/Schema/NodeNode.hs index 9dfc83dd..5e192fe9 100644 --- a/src/Gargantext/Database/Schema/NodeNode.hs +++ b/src/Gargantext/Database/Schema/NodeNode.hs @@ -35,10 +35,11 @@ import Data.Text (Text, splitOn) import Database.PostgreSQL.Simple.SqlQQ (sql) import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..)) import Gargantext.Core.Types -import Gargantext.Database.Action.Query.Node (pgNodeId) +import Gargantext.Database.Admin.Types.Node (pgNodeId) import Gargantext.Database.Admin.Config (nodeTypeId) import Gargantext.Database.Admin.Types.Node (CorpusId, DocId) import Gargantext.Database.Admin.Utils +import Gargantext.Database.Schema.Node import Gargantext.Prelude import Opaleye import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..)) diff --git a/src/Gargantext/Database/Schema/NodeNodeNgrams.hs b/src/Gargantext/Database/Schema/NodeNodeNgrams.hs index 4b8c4641..4ed7730f 100644 --- a/src/Gargantext/Database/Schema/NodeNodeNgrams.hs +++ b/src/Gargantext/Database/Schema/NodeNodeNgrams.hs @@ -28,7 +28,7 @@ import Data.Profunctor.Product.TH (makeAdaptorAndInstance) import Control.Lens.TH (makeLenses) import Gargantext.Database.Admin.Utils (Cmd, mkCmd) import Gargantext.Database.Schema.Ngrams (NgramsTypeId, pgNgramsTypeId, NgramsId) -import Gargantext.Database.Action.Query.Node (pgNodeId) +import Gargantext.Database.Admin.Types.Node (pgNodeId) import Gargantext.Database.Admin.Types.Node import Opaleye diff --git a/src/Gargantext/Database/Schema/NodeNodeNgrams2.hs b/src/Gargantext/Database/Schema/NodeNodeNgrams2.hs index 661ab50d..be67444a 100644 --- a/src/Gargantext/Database/Schema/NodeNodeNgrams2.hs +++ b/src/Gargantext/Database/Schema/NodeNodeNgrams2.hs @@ -26,7 +26,7 @@ module Gargantext.Database.Schema.NodeNodeNgrams2 import Control.Lens.TH (makeLenses) import Data.Profunctor.Product.TH (makeAdaptorAndInstance) import Gargantext.Database.Schema.NodeNgrams (NodeNgramsId) -import Gargantext.Database.Action.Query.Node (pgNodeId) +import Gargantext.Database.Admin.Types.Node (pgNodeId) import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Utils (Cmd, mkCmd) import Opaleye diff --git a/src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs b/src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs index d8992324..f2eb09b0 100644 --- a/src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs +++ b/src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs @@ -40,8 +40,8 @@ import Control.Lens.TH (makeLensesWith, abbreviatedFields) import Data.Maybe (Maybe) import Data.Profunctor.Product.TH (makeAdaptorAndInstance) import Gargantext.Database.Admin.Utils (Cmd, runOpaQuery, mkCmd) -import Gargantext.Database.Admin.Types.Node (CorpusId) -import Gargantext.Database.Action.Query.Node (pgNodeId) +import Gargantext.Database.Admin.Types.Node (CorpusId, pgNodeId) +import Gargantext.Database.Schema.Node import Gargantext.Prelude import Opaleye -- 2.47.0 From 113248ddc60af7e8651463db42148a6904d52313 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Mon, 13 Apr 2020 10:50:09 +0200 Subject: [PATCH 11/16] [DB|WIP] fixing imports still. --- src/Gargantext/API/Auth.hs | 4 +-- src/Gargantext/API/Export.hs | 2 +- src/Gargantext/API/Node.hs | 16 ++++++------ src/Gargantext/API/Search.hs | 2 +- src/Gargantext/API/Table.hs | 2 +- src/Gargantext/API/Types.hs | 2 +- src/Gargantext/Database/Action/Flow.hs | 8 +++--- .../Database/Action/Flow/Pairing.hs | 4 +-- src/Gargantext/Database/Action/Flow/Utils.hs | 12 +++++---- src/Gargantext/Database/Action/Learn.hs | 2 +- src/Gargantext/Database/Action/Metrics.hs | 2 +- src/Gargantext/Database/Action/Query.hs | 7 +++++- .../Database/Action/Query/Node/Select.hs | 1 + .../Action/Query/Node/UpdateOpaleye.hs | 2 +- .../Database/Action/Query/Node/User.hs | 12 +++------ src/Gargantext/Database/Action/Query/Tree.hs | 25 +++++++------------ .../Database/Action/Query/Tree/Root.hs | 3 ++- src/Gargantext/Database/Action/Search.hs | 3 +-- src/Gargantext/Database/Admin/Types/Node.hs | 4 +-- src/Gargantext/Text/Corpus/API.hs | 2 +- src/Gargantext/Text/Corpus/API/Isidore.hs | 2 +- src/Gargantext/Viz/Chart.hs | 1 + src/Gargantext/Viz/Graph/API.hs | 18 +++++++------ src/Gargantext/Viz/Phylo/API.hs | 5 ++-- src/Gargantext/Viz/Phylo/Main.hs | 2 +- 25 files changed, 72 insertions(+), 71 deletions(-) diff --git a/src/Gargantext/API/Auth.hs b/src/Gargantext/API/Auth.hs index 3dfbf9cb..ed4f946e 100644 --- a/src/Gargantext/API/Auth.hs +++ b/src/Gargantext/API/Auth.hs @@ -44,8 +44,8 @@ import Gargantext.API.Settings import Gargantext.API.Types (HasJoseError(..), joseError, HasServerError, GargServerC) import Gargantext.Core.Types.Individu (User(..), Username, Password, arbitraryUsername, arbitraryPassword) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) -import Gargantext.Database.Action.Root (getRoot) -import Gargantext.Database.Action.Tree (isDescendantOf, isIn) +import Gargantext.Database.Action.Query.Tree.Root (getRoot) +import Gargantext.Database.Action.Query.Tree (isDescendantOf, isIn) import Gargantext.Database.Admin.Types.Node (NodePoly(_node_id), NodeId(..), UserId, ListId, DocId) import Gargantext.Database.Admin.Utils (Cmd', CmdM, HasConnectionPool) import Gargantext.Prelude hiding (reverse) diff --git a/src/Gargantext/API/Export.hs b/src/Gargantext/API/Export.hs index 76293ceb..f3e603c5 100644 --- a/src/Gargantext/API/Export.hs +++ b/src/Gargantext/API/Export.hs @@ -38,13 +38,13 @@ import Gargantext.API.Types (GargNoServer) import Gargantext.Core.Types -- import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) import Gargantext.Database.Action.Metrics.NgramsByNode (getNgramsByNodeOnlyUser) +import Gargantext.Database.Action.Query.Node import Gargantext.Database.Action.Query.Node.Select (selectNodesWithUsername) import Gargantext.Database.Admin.Config (userMaster) import Gargantext.Database.Admin.Types.Errors (HasNodeError) import Gargantext.Database.Admin.Types.Node (Node, HyperdataDocument(..), NodeId, ListId, CorpusId) import Gargantext.Database.Admin.Utils (Cmd) import Gargantext.Database.Schema.Ngrams (NgramsType(..)) -import Gargantext.Database.Schema.Node (defaultList) import Gargantext.Database.Schema.NodeNode (selectDocNodes) import Gargantext.Prelude import Gargantext.Prelude.Utils (sha) diff --git a/src/Gargantext/API/Node.hs b/src/Gargantext/API/Node.hs index 5abc64e4..12f6d737 100644 --- a/src/Gargantext/API/Node.hs +++ b/src/Gargantext/API/Node.hs @@ -53,25 +53,27 @@ import Gargantext.API.Table import Gargantext.API.Types import Gargantext.Core.Types (NodeTableResult) import Gargantext.Core.Types.Main (Tree, NodeTree, ListType) -import Gargantext.Database.Action.Facet (FacetDoc, OrderBy(..)) +import Gargantext.Database.Action.Query.Facet (FacetDoc, OrderBy(..)) import Gargantext.Database.Action.Flow.Pairing (pairing) import Gargantext.Database.Action.Query.Node.Children (getChildren) import Gargantext.Database.Action.Query.Node.UpdateOpaleye (updateHyperdata) -import Gargantext.Database.Action.Query.Node.User (NodeUser) -import Gargantext.Database.Action.Tree (treeDB) +import Gargantext.Database.Action.Query.Node.User +import Gargantext.Database.Action.Query.Node hiding (postNode) +import Gargantext.Database.Action.Query +import Gargantext.Database.Action.Query.Tree (treeDB) import Gargantext.Database.Admin.Config (nodeTypeId) import Gargantext.Database.Admin.Types.Errors (HasNodeError(..)) import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Utils -- (Cmd, CmdM) -import Gargantext.Database.Schema.Node (getNodesWithParentId, getNodeWith, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, getNodeUser) -import Gargantext.Database.Schema.NodeNode -- (nodeNodesCategory, insertNodeNode, NodeNode(..)) +import Gargantext.Database.Schema.Node +import Gargantext.Database.Schema.NodeNode import Gargantext.Prelude import Gargantext.Viz.Chart import Gargantext.Viz.Phylo.API (PhyloAPI, phyloAPI) import Servant import Test.QuickCheck (elements) import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) -import qualified Gargantext.Database.Node.Update as U (update, Update(..)) +import qualified Gargantext.Database.Action.Query.Node.Update as U (update, Update(..)) {- import qualified Gargantext.Text.List.Learn as Learn @@ -94,7 +96,7 @@ nodesAPI ids = deleteNodes ids -- TODO-EVENTS: -- PutNode ? -- TODO needs design discussion. -type Roots = Get '[JSON] [NodeUser] +type Roots = Get '[JSON] [Node HyperdataUser] :<|> Put '[JSON] Int -- TODO -- | TODO: access by admin only diff --git a/src/Gargantext/API/Search.hs b/src/Gargantext/API/Search.hs index 50230e93..9d48fa02 100644 --- a/src/Gargantext/API/Search.hs +++ b/src/Gargantext/API/Search.hs @@ -32,7 +32,7 @@ import Data.Time (UTCTime) import GHC.Generics (Generic) import Gargantext.API.Types (GargServer) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) -import Gargantext.Database.Action.Facet +import Gargantext.Database.Action.Query.Facet import Gargantext.Database.Action.Search import Gargantext.Database.Admin.Types.Node import Gargantext.Prelude diff --git a/src/Gargantext/API/Table.hs b/src/Gargantext/API/Table.hs index 80eaa155..682cd774 100644 --- a/src/Gargantext/API/Table.hs +++ b/src/Gargantext/API/Table.hs @@ -46,7 +46,7 @@ import GHC.Generics (Generic) import Gargantext.API.Ngrams (TabType(..)) import Gargantext.Core.Types (Offset, Limit, TableResult(..)) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) -import Gargantext.Database.Action.Facet (FacetDoc , runViewDocuments, OrderBy(..), runViewAuthorsDoc) +import Gargantext.Database.Action.Query.Facet (FacetDoc , runViewDocuments, OrderBy(..), runViewAuthorsDoc) import Gargantext.Database.Action.Learn (FavOrTrash(..), moreLike) import Gargantext.Database.Action.Search import Gargantext.Database.Admin.Types.Node diff --git a/src/Gargantext/API/Types.hs b/src/Gargantext/API/Types.hs index 70626911..659e4a76 100644 --- a/src/Gargantext/API/Types.hs +++ b/src/Gargantext/API/Types.hs @@ -41,7 +41,7 @@ import Gargantext.API.Ngrams import Gargantext.API.Orchestrator.Types import Gargantext.API.Settings import Gargantext.Core.Types -import Gargantext.Database.Action.Tree +import Gargantext.Database.Action.Query.Tree import Gargantext.Database.Admin.Types.Errors (NodeError(..), HasNodeError(..)) import Gargantext.Database.Admin.Utils import Gargantext.Prelude diff --git a/src/Gargantext/Database/Action/Flow.hs b/src/Gargantext/Database/Action/Flow.hs index 9cf8a115..b474e3ed 100644 --- a/src/Gargantext/Database/Action/Flow.hs +++ b/src/Gargantext/Database/Action/Flow.hs @@ -55,10 +55,13 @@ import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Core.Types.Main import Gargantext.Database.Action.Flow.List import Gargantext.Database.Action.Flow.Types -import Gargantext.Database.Action.Flow.Utils (insertDocNgrams) +import Gargantext.Database.Action.Flow.Utils (insertDocNgrams, getUserId) +import Gargantext.Database.Action.Query.Node +import Gargantext.Database.Action.Query.User import Gargantext.Database.Action.Query.Node.Contact -- (HyperdataContact(..), ContactWho(..)) import Gargantext.Database.Action.Query.Node.Document.Insert -- (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..)) -import Gargantext.Database.Action.Root (getRoot) +import Gargantext.Database.Action.Query.Tree.Root (getRoot) +import Gargantext.Database.Action.Query.Tree (mkRoot) import Gargantext.Database.Action.Search (searchInDatabase) import Gargantext.Database.Admin.Config (userMaster, corpusMasterName) import Gargantext.Database.Admin.Types.Errors (HasNodeError(..), NodeError(..), nodeError) @@ -68,7 +71,6 @@ import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsInd import Gargantext.Database.Schema.Node -- (mkRoot, mkCorpus, getOrMkList, mkGraph, {-mkPhylo,-} mkDashboard, mkAnnuaire, getCorporaWithParentId, HasNodeError, NodeError(..), nodeError) import Gargantext.Database.Schema.NodeNgrams (listInsertDb , getCgramsId) import Gargantext.Database.Schema.NodeNodeNgrams2 -- (NodeNodeNgrams2, insertNodeNodeNgrams2) -import Gargantext.Database.Schema.User (getUserId) import Gargantext.Ext.IMT (toSchoolName) import Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile) import Gargantext.Prelude diff --git a/src/Gargantext/Database/Action/Flow/Pairing.hs b/src/Gargantext/Database/Action/Flow/Pairing.hs index 39d89171..d0a6edee 100644 --- a/src/Gargantext/Database/Action/Flow/Pairing.hs +++ b/src/Gargantext/Database/Action/Flow/Pairing.hs @@ -29,8 +29,8 @@ import Gargantext.Core.Types (TableResult(..)) import Gargantext.Database.Action.Flow.Utils import Gargantext.Database.Admin.Types.Node (AnnuaireId, CorpusId, ListId{-, DocId, ContactId-}) import Gargantext.Database.Admin.Utils (Cmd, runPGSQuery) -import Gargantext.Database.Node.Children (getAllContacts) -import Gargantext.Database.Node.Contact -- (HyperdataContact(..)) +import Gargantext.Database.Action.Query.Node.Children (getAllContacts) +import Gargantext.Database.Action.Query.Node.Contact -- (HyperdataContact(..)) import Gargantext.Database.Schema.Ngrams -- (NgramsType(..)) import Gargantext.Prelude hiding (sum) import Safe (lastMay) diff --git a/src/Gargantext/Database/Action/Flow/Utils.hs b/src/Gargantext/Database/Action/Flow/Utils.hs index 91258f30..8dd87fb8 100644 --- a/src/Gargantext/Database/Action/Flow/Utils.hs +++ b/src/Gargantext/Database/Action/Flow/Utils.hs @@ -18,16 +18,20 @@ module Gargantext.Database.Action.Flow.Utils where import Data.Map (Map) +import Gargantext.Core.Types (Name) +import Gargantext.Core.Types.Individu (User(..)) +import Gargantext.Database.Action.Query.Node +import Gargantext.Database.Action.Query.User +import Gargantext.Database.Admin.Types.Errors import Gargantext.Database.Admin.Types.Node -import Gargantext.Database.Admin.Types.Node (NodeId, Node, NodePoly(..), Hyperdata) import Gargantext.Database.Admin.Utils (Cmd) import Gargantext.Database.Schema.Ngrams +import Gargantext.Database.Schema.Node +import Gargantext.Database.Schema.User import Gargantext.Database.Schema.NodeNodeNgrams -import Gargantext.Database.Action.Query.Node (getNode) import Gargantext.Prelude import qualified Data.Map as DM - getUserId :: HasNodeError err => User -> Cmd err UserId @@ -42,8 +46,6 @@ getUserId (UserName u ) = do Nothing -> nodeError NoUserFound - - toMaps :: Hyperdata a => (a -> Map (NgramsT Ngrams) Int) -> [Node a] diff --git a/src/Gargantext/Database/Action/Learn.hs b/src/Gargantext/Database/Action/Learn.hs index 4087b4c7..07dee57b 100644 --- a/src/Gargantext/Database/Action/Learn.hs +++ b/src/Gargantext/Database/Action/Learn.hs @@ -23,7 +23,7 @@ import Data.Maybe import Data.Text (Text) import Data.Tuple (snd) import Gargantext.Core.Types (Offset, Limit) -import Gargantext.Database.Action.Facet +import Gargantext.Database.Action.Query.Facet import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Utils (Cmd) import Gargantext.Prelude diff --git a/src/Gargantext/Database/Action/Metrics.hs b/src/Gargantext/Database/Action/Metrics.hs index c10dff13..18a3c07b 100644 --- a/src/Gargantext/Database/Action/Metrics.hs +++ b/src/Gargantext/Database/Action/Metrics.hs @@ -28,7 +28,7 @@ import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsOnlyUser import Gargantext.Database.Action.Query.Node.Select import Gargantext.Database.Admin.Config (userMaster) import Gargantext.Database.Admin.Types.Node (ListId, CorpusId{-, HyperdataCorpus-}) -import Gargantext.Database.Schema.Node (defaultList) +import Gargantext.Database.Action.Query.Node (defaultList) import Gargantext.Prelude import Gargantext.Text.Metrics (scored, Scored(..), {-localMetrics, toScored-}) import qualified Data.Map as Map diff --git a/src/Gargantext/Database/Action/Query.hs b/src/Gargantext/Database/Action/Query.hs index b4b8bfde..a9bb2ad0 100644 --- a/src/Gargantext/Database/Action/Query.hs +++ b/src/Gargantext/Database/Action/Query.hs @@ -27,12 +27,17 @@ Portability : POSIX module Gargantext.Database.Action.Query where +import Gargantext.Core.Types (Name) import Gargantext.Database.Action.Query.Node +import Gargantext.Database.Action.Query.Node.User import Gargantext.Database.Action.Query.User +import Gargantext.Database.Admin.Types.Errors +import Gargantext.Database.Admin.Types.Node +import Gargantext.Database.Admin.Utils (Cmd) +import Gargantext.Database.Schema.Node import Opaleye hiding (FromField) import Prelude hiding (null, id, map, sum) - ------------------------------------------------------------------------ -- | TODO mk all others nodes mkNodeWithParent :: HasNodeError err diff --git a/src/Gargantext/Database/Action/Query/Node/Select.hs b/src/Gargantext/Database/Action/Query/Node/Select.hs index 3277a84c..ffef3910 100644 --- a/src/Gargantext/Database/Action/Query/Node/Select.hs +++ b/src/Gargantext/Database/Action/Query/Node/Select.hs @@ -24,6 +24,7 @@ import Gargantext.Database.Admin.Config import Gargantext.Database.Admin.Utils import Gargantext.Database.Schema.Node import Gargantext.Database.Schema.User +import Gargantext.Database.Action.Query.User import Gargantext.Database.Action.Query.Node import Opaleye diff --git a/src/Gargantext/Database/Action/Query/Node/UpdateOpaleye.hs b/src/Gargantext/Database/Action/Query/Node/UpdateOpaleye.hs index 5f33bb39..1f994f7b 100644 --- a/src/Gargantext/Database/Action/Query/Node/UpdateOpaleye.hs +++ b/src/Gargantext/Database/Action/Query/Node/UpdateOpaleye.hs @@ -26,7 +26,7 @@ import Gargantext.Prelude import Gargantext.Database.Schema.Node import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Utils (Cmd, mkCmd) -import Gargantext.Database.Action.Query.Node (pgNodeId) +import Gargantext.Database.Admin.Types.Node (pgNodeId) updateHyperdata :: ToJSON a => NodeId -> a -> Cmd err Int64 updateHyperdata i h = mkCmd $ \c -> runUpdate_ c (updateHyperdataQuery i h) diff --git a/src/Gargantext/Database/Action/Query/Node/User.hs b/src/Gargantext/Database/Action/Query/Node/User.hs index 03cfa388..274813ee 100644 --- a/src/Gargantext/Database/Action/Query/Node/User.hs +++ b/src/Gargantext/Database/Action/Query/Node/User.hs @@ -1,5 +1,5 @@ {-| -Module : Gargantext.Database.Node.User +Module : Gargantext.Database.Action.Query.Node.User Description : User Node in Gargantext Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 @@ -15,7 +15,6 @@ Portability : POSIX {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} @@ -32,8 +31,10 @@ import GHC.Generics (Generic) import Gargantext.Core (Lang(..)) import Gargantext.Core.Types (Name) import Gargantext.Core.Types.Individu (Username, arbitraryUsername, User(..), UserId) +import Gargantext.Database.Admin.Types.Node (NodeType(..)) import Gargantext.Database.Action.Query.Node import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) +import Gargantext.Database.Admin.Types.Node (pgNodeId) import Gargantext.Database.Action.Query.Node.Contact (HyperdataContact, fake_HyperdataContact) import Gargantext.Database.Admin.Types.Node (Node,Hyperdata, DocumentId, NodeId(..)) import Gargantext.Database.Admin.Utils -- (fromField', Cmd) @@ -44,8 +45,6 @@ import Test.QuickCheck (elements) import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) ------------------------------------------------------------------------ -type NodeUser = Node HyperdataUser - data HyperdataUser = HyperdataUser { _hu_private :: !(Maybe HyperdataPrivate) , _hu_shared :: !(Maybe HyperdataContact) @@ -136,7 +135,7 @@ $(deriveJSON (unPrefix "_hpu_") ''HyperdataPublic) ----------------------------------------------------------------- getNodeUser :: NodeId -> Cmd err (Node HyperdataUser) getNodeUser nId = do - fromMaybe (panic $ "Node does not exist: " <> show nId) . headMay + fromMaybe (panic $ "Node does not exist: " <> (cs $ show nId)) . headMay <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId)) @@ -145,6 +144,3 @@ nodeUserW maybeName maybeHyperdata = node NodeUser name user Nothing where name = maybe "User" identity maybeName user = maybe fake_HyperdataUser identity maybeHyperdata - - - diff --git a/src/Gargantext/Database/Action/Query/Tree.hs b/src/Gargantext/Database/Action/Query/Tree.hs index 5796b8c7..c1614148 100644 --- a/src/Gargantext/Database/Action/Query/Tree.hs +++ b/src/Gargantext/Database/Action/Query/Tree.hs @@ -18,15 +18,7 @@ Let a Root Node, return the Tree of the Node as a directed acyclic graph {-# LANGUAGE RankNTypes #-} module Gargantext.Database.Action.Query.Tree - ( treeDB - , TreeError(..) - , HasTreeError(..) - , dbTree - , toNodeTree - , DbTreeNode - , isDescendantOf - , isIn - ) where + where import Control.Lens (Prism', (#), (^..), at, each, _Just, to) import Control.Monad.Error.Class (MonadError(throwError)) @@ -34,15 +26,18 @@ import Data.Map (Map, fromListWith, lookup) import Data.Text (Text) import Database.PostgreSQL.Simple import Database.PostgreSQL.Simple.SqlQQ - -import Gargantext.Prelude +import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Main (NodeTree(..), Tree(..)) +import Gargantext.Database.Action.Query.Node +import Gargantext.Database.Admin.Types.Node -- (pgNodeId, NodeType(..)) +import Gargantext.Database.Action.Query.User +import Gargantext.Database.Action.Query +import Gargantext.Database.Action.Flow.Utils (getUserId) import Gargantext.Database.Admin.Config (fromNodeTypeId, nodeTypeId) -import Gargantext.Database.Admin.Types.Node (NodeId, NodeType, DocId, allNodeTypes) import Gargantext.Database.Admin.Types.Errors +import Gargantext.Database.Admin.Types.Node (NodeId, NodeType, DocId, allNodeTypes) import Gargantext.Database.Admin.Utils (Cmd, runPGSQuery) -import Gargantext.Database.Action.Query.Node -import Gargantext.Database.Action.Query.User +import Gargantext.Prelude ------------------------------------------------------------------------ -- import Gargantext.Database.Utils (runCmdDev) @@ -87,8 +82,6 @@ treeError te = throwError $ _TreeError # te treeDB :: HasTreeError err => RootId -> [NodeType] -> Cmd err (Tree NodeTree) treeDB r nodeTypes = toTree =<< (toTreeParent <$> dbTree r nodeTypes) -type RootId = NodeId -type ParentId = NodeId ------------------------------------------------------------------------ toTree :: (MonadError e m, HasTreeError e) => Map (Maybe ParentId) [DbTreeNode] -> m (Tree NodeTree) diff --git a/src/Gargantext/Database/Action/Query/Tree/Root.hs b/src/Gargantext/Database/Action/Query/Tree/Root.hs index c583a802..58ad18f7 100644 --- a/src/Gargantext/Database/Action/Query/Tree/Root.hs +++ b/src/Gargantext/Database/Action/Query/Tree/Root.hs @@ -33,7 +33,8 @@ import Gargantext.Database.Admin.Config (nodeTypeId) import Gargantext.Database.Action.Query.Node.User (HyperdataUser) import Gargantext.Database.Schema.Node (NodeRead) import Gargantext.Database.Schema.Node (queryNodeTable) -import Gargantext.Database.Schema.User (queryUserTable, UserPoly(..)) +import Gargantext.Database.Schema.User (UserPoly(..)) +import Gargantext.Database.Action.Query.User (queryUserTable) import Gargantext.Database.Admin.Types.Node (Node, NodePoly(..), NodeType(NodeUser)) import Gargantext.Database.Admin.Utils (Cmd, runOpaQuery) import Gargantext.Prelude diff --git a/src/Gargantext/Database/Action/Search.hs b/src/Gargantext/Database/Action/Search.hs index 77a3ddfd..f965dc88 100644 --- a/src/Gargantext/Database/Action/Search.hs +++ b/src/Gargantext/Database/Action/Search.hs @@ -16,7 +16,6 @@ Portability : POSIX module Gargantext.Database.Action.Search where ---import Gargantext.Database.Node.Contact import Control.Arrow (returnA) import Control.Lens ((^.)) import Data.Aeson @@ -31,6 +30,7 @@ import Database.PostgreSQL.Simple.ToField import Gargantext.Core.Types import Gargantext.Database.Action.Query.Facet import Gargantext.Database.Action.Query.Join (leftJoin6) +import Gargantext.Database.Action.Query.Node import Gargantext.Database.Admin.Config (nodeTypeId) import Gargantext.Database.Admin.Types.Node (NodeType(..)) import Gargantext.Database.Admin.Utils (Cmd, runPGSQuery, runOpaQuery, runCountOpaQuery) @@ -43,7 +43,6 @@ import Gargantext.Text.Terms.Mono.Stem.En (stemIt) import Opaleye hiding (Query, Order) import qualified Opaleye as O hiding (Order) - ------------------------------------------------------------------------ searchInDatabase :: ParentId -> Text diff --git a/src/Gargantext/Database/Admin/Types/Node.hs b/src/Gargantext/Database/Admin/Types/Node.hs index 4fb00600..71c760bc 100644 --- a/src/Gargantext/Database/Admin/Types/Node.hs +++ b/src/Gargantext/Database/Admin/Types/Node.hs @@ -63,8 +63,6 @@ pgNodeId = O.pgInt4 . id2int id2int (NodeId n) = n ------------------------------------------------------------------------ - - newtype NodeId = NodeId Int deriving (Show, Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON) @@ -120,7 +118,7 @@ type CorpusId = NodeId type ListId = NodeId type DocumentId = NodeId type DocId = NodeId -type RootId = NodeId +type RootId = NodeId type MasterCorpusId = CorpusId type UserCorpusId = CorpusId diff --git a/src/Gargantext/Text/Corpus/API.hs b/src/Gargantext/Text/Corpus/API.hs index 6c59896f..6b17c93f 100644 --- a/src/Gargantext/Text/Corpus/API.hs +++ b/src/Gargantext/Text/Corpus/API.hs @@ -27,7 +27,7 @@ import Data.Maybe import Gargantext.Prelude import Gargantext.Core (Lang(..)) import Gargantext.API.Orchestrator.Types (ExternalAPIs(..), externalAPIs) -import Gargantext.Database.Types.Node (HyperdataDocument(..)) +import Gargantext.Database.Admin.Types.Node (HyperdataDocument(..)) import qualified Gargantext.Text.Corpus.API.Pubmed as PUBMED import qualified Gargantext.Text.Corpus.API.Isidore as ISIDORE diff --git a/src/Gargantext/Text/Corpus/API/Isidore.hs b/src/Gargantext/Text/Corpus/API/Isidore.hs index 81467119..da89cc9b 100644 --- a/src/Gargantext/Text/Corpus/API/Isidore.hs +++ b/src/Gargantext/Text/Corpus/API/Isidore.hs @@ -18,7 +18,7 @@ module Gargantext.Text.Corpus.API.Isidore where import System.FilePath (FilePath()) import Data.Text (Text) import Gargantext.Core (Lang(..)) -import Gargantext.Database.Types.Node (HyperdataDocument(..)) +import Gargantext.Database.Admin.Types.Node (HyperdataDocument(..)) import Gargantext.Prelude import Isidore.Client import Servant.Client diff --git a/src/Gargantext/Viz/Chart.hs b/src/Gargantext/Viz/Chart.hs index f77aec3e..3d4457d7 100644 --- a/src/Gargantext/Viz/Chart.hs +++ b/src/Gargantext/Viz/Chart.hs @@ -24,6 +24,7 @@ import Data.Text (Text) import GHC.Generics (Generic) import Gargantext.Core.Types.Main import Gargantext.Database.Action.Query.Node.Select +import Gargantext.Database.Action.Query.Node import Gargantext.Database.Admin.Config import Gargantext.Database.Admin.Types.Node (CorpusId) import Gargantext.Database.Admin.Utils diff --git a/src/Gargantext/Viz/Graph/API.hs b/src/Gargantext/Viz/Graph/API.hs index 79d23924..03819f56 100644 --- a/src/Gargantext/Viz/Graph/API.hs +++ b/src/Gargantext/Viz/Graph/API.hs @@ -44,15 +44,17 @@ import Gargantext.API.Ngrams.Tools import Gargantext.API.Orchestrator.Types import Gargantext.API.Types import Gargantext.Core.Types.Main -import Gargantext.Database.Config -import Gargantext.Database.Metrics.NgramsByNode (getNodesByNgramsOnlyUser) +import Gargantext.Database.Admin.Config +import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsOnlyUser) import Gargantext.Database.Schema.Ngrams -import Gargantext.Database.Node.Select -import Gargantext.Database.Schema.Node (getNodeWith, getNodeUser, defaultList, insertGraph) -import Gargantext.Database.Types.Errors (HasNodeError) -import Gargantext.Database.Types.Node hiding (node_id) -- (GraphId, ListId, CorpusId, NodeId) -import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata) -import Gargantext.Database.Utils (Cmd) +import Gargantext.Database.Action.Query.Node.Select +import Gargantext.Database.Action.Query.Node +import Gargantext.Database.Action.Query.Node.User +import Gargantext.Database.Schema.Node -- (getNodeWith, getNodeUser, defaultList, insertGraph) +import Gargantext.Database.Admin.Types.Errors (HasNodeError) +import Gargantext.Database.Admin.Types.Node hiding (node_id) -- (GraphId, ListId, CorpusId, NodeId) +import Gargantext.Database.Action.Query.Node.UpdateOpaleye (updateHyperdata) +import Gargantext.Database.Admin.Utils (Cmd) import Gargantext.Prelude import qualified Gargantext.Prelude as P import Gargantext.Viz.Graph diff --git a/src/Gargantext/Viz/Phylo/API.hs b/src/Gargantext/Viz/Phylo/API.hs index ff7c08f5..6c8ccaa0 100644 --- a/src/Gargantext/Viz/Phylo/API.hs +++ b/src/Gargantext/Viz/Phylo/API.hs @@ -30,9 +30,8 @@ import qualified Data.ByteString as DB import qualified Data.ByteString.Lazy as DBL import Data.Swagger import Gargantext.API.Types -import Gargantext.Database.Types.Node (PhyloId, ListId, CorpusId) -import Gargantext.Database.Schema.Node (insertNodes, nodePhyloW, getNodePhylo) -import Gargantext.Database.Types.Node -- (NodePhylo(..)) +import Gargantext.Database.Action.Query.Node (insertNodes, nodePhyloW, getNodePhylo) +import Gargantext.Database.Admin.Types.Node -- (PhyloId, ListId, CorpusId, UserId, NodeId(..)) import Gargantext.Prelude import Gargantext.Viz.Phylo import Gargantext.Viz.Phylo.Main diff --git a/src/Gargantext/Viz/Phylo/Main.hs b/src/Gargantext/Viz/Phylo/Main.hs index 77a3ba63..e8a1b81c 100644 --- a/src/Gargantext/Viz/Phylo/Main.hs +++ b/src/Gargantext/Viz/Phylo/Main.hs @@ -28,7 +28,7 @@ import Gargantext.API.Ngrams.Tools (getTermsWith) import Gargantext.Core.Types import Gargantext.Database.Action.Flow import Gargantext.Database.Schema.Ngrams (NgramsType(..)) -import Gargantext.Database.Schema.Node (defaultList) +import Gargantext.Database.Action.Query.Node(defaultList) import Gargantext.Database.Schema.NodeNode (selectDocs) import Gargantext.Prelude import Gargantext.Text.Context (TermList) -- 2.47.0 From f904ea9f39332f26631f4addde9faafed2b68872 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Mon, 13 Apr 2020 10:57:22 +0200 Subject: [PATCH 12/16] [DB|WIP] fix Tree RootId --- src/Gargantext/API.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Gargantext/API.hs b/src/Gargantext/API.hs index ac91820e..cc892b13 100644 --- a/src/Gargantext/API.hs +++ b/src/Gargantext/API.hs @@ -407,7 +407,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid)) -- :<|> addUpload -- :<|> (\corpus -> addWithQuery corpus :<|> addWithFile corpus) :<|> addCorpusWithForm (UserDBId uid) - :<|> addCorpusWithQuery (RootId uid) + :<|> addCorpusWithQuery (RootId (NodeId uid)) :<|> addAnnuaireWithForm -- :<|> New.api uid -- TODO-SECURITY -- 2.47.0 From 775d6dc28f0db46974675f1ff48c72fb80251217 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Mon, 13 Apr 2020 12:56:24 +0200 Subject: [PATCH 13/16] [DB|FACT|WIP] fix all imports and warnings. ready for tests --- bin/gargantext-adaptative-phylo/Main.hs | 4 +- bin/gargantext-import/Main.hs | 25 ++++---- bin/gargantext-init/Main.hs | 23 ++++---- bin/gargantext-phylo/Main.hs | 37 +++++------- package.yaml | 13 ++--- src/Gargantext/API/Node.hs | 57 +++++++++---------- src/Gargantext/Database/Action/Flow.hs | 2 - src/Gargantext/Database/Action/Flow/Utils.hs | 2 - src/Gargantext/Database/Action/Query.hs | 3 - .../Database/Action/Query/Ngrams.hs | 2 - src/Gargantext/Database/Action/Query/Node.hs | 4 -- .../Database/Action/Query/Node/Select.hs | 1 - .../Database/Action/Query/Node/User.hs | 3 +- src/Gargantext/Database/Action/Query/Tree.hs | 3 +- .../Database/Action/Query/Tree/Root.hs | 11 +++- src/Gargantext/Database/Action/Query/User.hs | 6 +- src/Gargantext/Database/Schema/Node.hs | 13 +---- .../Schema/Node_NodeNgramsNodeNgrams.hs | 2 +- src/Gargantext/Database/Schema/User.hs | 6 -- src/Gargantext/Viz/Chart.hs | 1 - src/Gargantext/Viz/Graph/API.hs | 8 +-- 21 files changed, 94 insertions(+), 132 deletions(-) diff --git a/bin/gargantext-adaptative-phylo/Main.hs b/bin/gargantext-adaptative-phylo/Main.hs index 00f024f7..c730a46c 100644 --- a/bin/gargantext-adaptative-phylo/Main.hs +++ b/bin/gargantext-adaptative-phylo/Main.hs @@ -29,7 +29,7 @@ import Data.String (String) import Data.Text (Text, unwords, unpack) import Gargantext.Prelude -import Gargantext.Database.Types.Node (HyperdataDocument(..)) +import Gargantext.Database.Admin.Types.Node (HyperdataDocument(..)) import Gargantext.Text.Context (TermList) import Gargantext.Text.Corpus.Parsers.CSV (csv_title, csv_abstract, csv_publication_year) import Gargantext.Text.Corpus.Parsers (FileFormat(..),parseFile) @@ -173,4 +173,4 @@ main = do <> (unpack $ phyloName config) <> "_V2.dot" - dotToFile output dot \ No newline at end of file + dotToFile output dot diff --git a/bin/gargantext-import/Main.hs b/bin/gargantext-import/Main.hs index c4a49548..e488f929 100644 --- a/bin/gargantext-import/Main.hs +++ b/bin/gargantext-import/Main.hs @@ -19,24 +19,23 @@ Import a corpus binary. module Main where -import Data.Either -import Prelude (read) import Control.Exception (finally) +import Data.Either +import Data.Text (Text) +import Gargantext.API.Node () -- instances +import Gargantext.API.Settings (withDevEnv, runCmdDev, DevEnv) +import Gargantext.API.Types (GargError) +import Gargantext.Core (Lang(..)) +import Gargantext.Core.Types.Individu (User(..)) +import Gargantext.Database.Action.Flow (FlowCmdM, flowCorpusFile, flowAnnuaire) +import Gargantext.Database.Action.Query.User (insertUsersDemo) +import Gargantext.Database.Admin.Types.Node (CorpusId, toHyperdataDocument) +import Gargantext.Database.Admin.Utils (Cmd, ) import Gargantext.Prelude -import Gargantext.Database.Flow (FlowCmdM, flowCorpusFile, flowAnnuaire) import Gargantext.Text.Corpus.Parsers (FileFormat(..)) -import Gargantext.Database.Utils (Cmd, ) -import Gargantext.Database.Types.Node (CorpusId, toHyperdataDocument) -import Gargantext.Database.Schema.User (insertUsersDemo) -import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Text.Terms (TermType(..)) -import Gargantext.Core (Lang(..)) -import Gargantext.API.Types (GargError) -import Gargantext.API.Node () -- instances -import Gargantext.API.Settings (withDevEnv, runCmdDev, DevEnv) +import Prelude (read) import System.Environment (getArgs) ---import Gargantext.Text.Corpus.Parsers.GrandDebat (readFile, GrandDebatReference(..)) -import Data.Text (Text) import qualified Data.Text as Text main :: IO () diff --git a/bin/gargantext-init/Main.hs b/bin/gargantext-init/Main.hs index 1755bab2..7edcde86 100644 --- a/bin/gargantext-init/Main.hs +++ b/bin/gargantext-init/Main.hs @@ -21,19 +21,20 @@ module Main where import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) -import System.Environment (getArgs) -import Gargantext.Prelude -import Gargantext.Core.Types.Individu (UserId, User(..)) -import Gargantext.Database.Flow (getOrMkRoot, getOrMk_RootWithCorpus) -import Gargantext.Database.Schema.Node (getOrMkList) -import Gargantext.Database.Utils (Cmd, ) -import Gargantext.Database.Types.Node (CorpusId, RootId, HyperdataCorpus, ListId) -import Gargantext.Database.Schema.User (insertUsersDemo) -import Gargantext.API.Types (GargError) import Gargantext.API.Node () -- instances import Gargantext.API.Settings (withDevEnv, runCmdDev) -import Gargantext.Database.Config (userMaster, corpusMasterName) -import Gargantext.Database.Init (initTriggers) +import Gargantext.API.Types (GargError) +import Gargantext.Core.Types.Individu (UserId, User(..)) +import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMk_RootWithCorpus) +import Gargantext.Database.Admin.Config (userMaster, corpusMasterName) +import Gargantext.Database.Admin.Trigger.Init (initTriggers) +import Gargantext.Database.Admin.Types.Node (CorpusId, RootId, HyperdataCorpus, ListId) +import Gargantext.Database.Admin.Utils (Cmd, ) +import Gargantext.Database.Action.Query.Node (getOrMkList) +import Gargantext.Database.Action.Query.User (insertUsersDemo) +import Gargantext.Prelude +import System.Environment (getArgs) + main :: IO () main = do [iniPath] <- getArgs diff --git a/bin/gargantext-phylo/Main.hs b/bin/gargantext-phylo/Main.hs index dcf2b555..89ef0a9c 100644 --- a/bin/gargantext-phylo/Main.hs +++ b/bin/gargantext-phylo/Main.hs @@ -22,42 +22,35 @@ Phylo binaries module Main where -import System.Directory (doesFileExist) - +import Control.Concurrent.Async as CCA (mapConcurrently) +import Control.Monad (mapM) import Data.Aeson -import Data.Text (Text, unwords, unlines) import Data.List ((++),concat) +import Data.Maybe +import Data.Text (Text, unwords, unlines) import GHC.Generics import GHC.IO (FilePath) +import Gargantext.Database.Admin.Types.Node import Gargantext.Prelude -import Gargantext.Text.List.CSV (csvGraphTermList) -import Gargantext.Text.Corpus.Parsers.CSV (csv_title, csv_abstract, csv_publication_year) -import qualified Gargantext.Text.Corpus.Parsers.CSV as CSV +import Gargantext.Text.Context (TermList) import Gargantext.Text.Corpus.Parsers (FileFormat(..),parseFile) +import Gargantext.Text.Corpus.Parsers.CSV (csv_title, csv_abstract, csv_publication_year) +import Gargantext.Text.List.CSV (csvGraphTermList) import Gargantext.Text.Terms.WithList -import Gargantext.Text.Context (TermList) - -import Control.Monad (mapM) - -import System.Environment - import Gargantext.Viz.Phylo -import Gargantext.Viz.Phylo.Tools import Gargantext.Viz.Phylo.LevelMaker +import Gargantext.Viz.Phylo.Tools import Gargantext.Viz.Phylo.View.Export import Gargantext.Viz.Phylo.View.ViewMaker - -import Gargantext.Database.Types.Node -import Data.Maybe - -import Control.Concurrent.Async as CCA (mapConcurrently) - -import qualified Data.Map as DM -import qualified Data.Vector as DV +import System.Directory (doesFileExist) +import System.Environment +import qualified Data.ByteString.Lazy as L import qualified Data.List as DL +import qualified Data.Map as DM import qualified Data.Text as DT +import qualified Data.Vector as DV +import qualified Gargantext.Text.Corpus.Parsers.CSV as CSV import qualified Prelude as P -import qualified Data.ByteString.Lazy as L -------------- diff --git a/package.yaml b/package.yaml index 01fa6d16..8d3315ea 100644 --- a/package.yaml +++ b/package.yaml @@ -32,7 +32,6 @@ library: - Gargantext.API.FrontEnd - Gargantext.API.Ngrams - Gargantext.API.Node - # - Gargantext.API.Orchestrator - Gargantext.API.Search - Gargantext.API.Settings - Gargantext.API.Types @@ -41,15 +40,13 @@ library: - Gargantext.Core.Types.Individu - Gargantext.Core.Types.Main - Gargantext.Core.Utils.Prefix - - Gargantext.Database - - Gargantext.Database.Admin.Init - - Gargantext.Database.Admin.Config - Gargantext.Database.Action.Flow - - Gargantext.Database.Schema.Node - - Gargantext.Database.Action.Tree - - Gargantext.Database.Admin.Types.Node + - Gargantext.Database.Action.Query.User + - Gargantext.Database.Action.Query.Node - Gargantext.Database.Admin.Utils - - Gargantext.Database.Schema.User + - Gargantext.Database.Admin.Trigger.Init + - Gargantext.Database.Admin.Config + - Gargantext.Database.Admin.Types.Node - Gargantext.Prelude - Gargantext.Text - Gargantext.Text.Context diff --git a/src/Gargantext/API/Node.hs b/src/Gargantext/API/Node.hs index 12f6d737..8e47e943 100644 --- a/src/Gargantext/API/Node.hs +++ b/src/Gargantext/API/Node.hs @@ -65,7 +65,6 @@ import Gargantext.Database.Admin.Config (nodeTypeId) import Gargantext.Database.Admin.Types.Errors (HasNodeError(..)) import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Utils -- (Cmd, CmdM) -import Gargantext.Database.Schema.Node import Gargantext.Database.Schema.NodeNode import Gargantext.Prelude import Gargantext.Viz.Chart @@ -181,42 +180,42 @@ nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uI ------------------------------------------------------------------------ -- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy. nodeAPI :: forall proxy a. (JSONB a, FromJSON a, ToJSON a) => proxy a -> UserId -> NodeId -> GargServer (NodeAPI a) -nodeAPI p uId id = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode id) nodeAPI' +nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode id') nodeAPI' where nodeAPI' :: GargServer (NodeAPI a) - nodeAPI' = getNodeWith id p - :<|> rename id - :<|> postNode uId id - :<|> putNode id - :<|> deleteNodeApi id - :<|> getChildren id p + nodeAPI' = getNodeWith id' p + :<|> rename id' + :<|> postNode uId id' + :<|> putNode id' + :<|> deleteNodeApi id' + :<|> getChildren id' p -- TODO gather it - :<|> tableApi id - :<|> apiNgramsTableCorpus id + :<|> tableApi id' + :<|> apiNgramsTableCorpus id' - :<|> catApi id + :<|> catApi id' - :<|> searchDocs id + :<|> searchDocs id' -- Pairing Tools - :<|> pairWith id - :<|> pairs id - :<|> getPair id - :<|> searchPairs id - - :<|> getScatter id - :<|> getChart id - :<|> getPie id - :<|> getTree id - :<|> phyloAPI id uId - -- :<|> nodeAddAPI id - -- :<|> postUpload id - - deleteNodeApi id' = do - node <- getNode id' - if _node_typename node == nodeTypeId NodeUser + :<|> pairWith id' + :<|> pairs id' + :<|> getPair id' + :<|> searchPairs id' + + :<|> getScatter id' + :<|> getChart id' + :<|> getPie id' + :<|> getTree id' + :<|> phyloAPI id' uId + -- :<|> nodeAddAPI id' + -- :<|> postUpload id' + + deleteNodeApi id'' = do + node' <- getNode id'' + if _node_typename node' == nodeTypeId NodeUser then panic "not allowed" -- TODO add proper Right Management Type - else deleteNode id' + else deleteNode id'' ------------------------------------------------------------------------ data RenameNode = RenameNode { r_name :: Text } diff --git a/src/Gargantext/Database/Action/Flow.hs b/src/Gargantext/Database/Action/Flow.hs index b474e3ed..da568d90 100644 --- a/src/Gargantext/Database/Action/Flow.hs +++ b/src/Gargantext/Database/Action/Flow.hs @@ -57,7 +57,6 @@ import Gargantext.Database.Action.Flow.List import Gargantext.Database.Action.Flow.Types import Gargantext.Database.Action.Flow.Utils (insertDocNgrams, getUserId) import Gargantext.Database.Action.Query.Node -import Gargantext.Database.Action.Query.User import Gargantext.Database.Action.Query.Node.Contact -- (HyperdataContact(..), ContactWho(..)) import Gargantext.Database.Action.Query.Node.Document.Insert -- (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..)) import Gargantext.Database.Action.Query.Tree.Root (getRoot) @@ -68,7 +67,6 @@ import Gargantext.Database.Admin.Types.Errors (HasNodeError(..), NodeError(..), import Gargantext.Database.Admin.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId) import Gargantext.Database.Admin.Utils (Cmd) import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams, NgramsType(..), text2ngrams, ngramsTypeId) -import Gargantext.Database.Schema.Node -- (mkRoot, mkCorpus, getOrMkList, mkGraph, {-mkPhylo,-} mkDashboard, mkAnnuaire, getCorporaWithParentId, HasNodeError, NodeError(..), nodeError) import Gargantext.Database.Schema.NodeNgrams (listInsertDb , getCgramsId) import Gargantext.Database.Schema.NodeNodeNgrams2 -- (NodeNodeNgrams2, insertNodeNodeNgrams2) import Gargantext.Ext.IMT (toSchoolName) diff --git a/src/Gargantext/Database/Action/Flow/Utils.hs b/src/Gargantext/Database/Action/Flow/Utils.hs index 8dd87fb8..b1f87565 100644 --- a/src/Gargantext/Database/Action/Flow/Utils.hs +++ b/src/Gargantext/Database/Action/Flow/Utils.hs @@ -18,7 +18,6 @@ module Gargantext.Database.Action.Flow.Utils where import Data.Map (Map) -import Gargantext.Core.Types (Name) import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Database.Action.Query.Node import Gargantext.Database.Action.Query.User @@ -26,7 +25,6 @@ import Gargantext.Database.Admin.Types.Errors import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Utils (Cmd) import Gargantext.Database.Schema.Ngrams -import Gargantext.Database.Schema.Node import Gargantext.Database.Schema.User import Gargantext.Database.Schema.NodeNodeNgrams import Gargantext.Prelude diff --git a/src/Gargantext/Database/Action/Query.hs b/src/Gargantext/Database/Action/Query.hs index a9bb2ad0..b5d20e9f 100644 --- a/src/Gargantext/Database/Action/Query.hs +++ b/src/Gargantext/Database/Action/Query.hs @@ -30,12 +30,9 @@ module Gargantext.Database.Action.Query import Gargantext.Core.Types (Name) import Gargantext.Database.Action.Query.Node import Gargantext.Database.Action.Query.Node.User -import Gargantext.Database.Action.Query.User import Gargantext.Database.Admin.Types.Errors import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Utils (Cmd) -import Gargantext.Database.Schema.Node -import Opaleye hiding (FromField) import Prelude hiding (null, id, map, sum) ------------------------------------------------------------------------ diff --git a/src/Gargantext/Database/Action/Query/Ngrams.hs b/src/Gargantext/Database/Action/Query/Ngrams.hs index bd7896e9..f5119579 100644 --- a/src/Gargantext/Database/Action/Query/Ngrams.hs +++ b/src/Gargantext/Database/Action/Query/Ngrams.hs @@ -21,11 +21,9 @@ import Control.Arrow (returnA) import Control.Lens ((^.)) import Data.Text (Text) import Gargantext.Core.Types -import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node (pgNodeId) import Gargantext.Database.Admin.Utils (runOpaQuery, Cmd) import Gargantext.Database.Schema.Ngrams -import Gargantext.Database.Schema.Node import Gargantext.Database.Schema.NodeNodeNgrams import Gargantext.Prelude import Opaleye diff --git a/src/Gargantext/Database/Action/Query/Node.hs b/src/Gargantext/Database/Action/Query/Node.hs index 5e4b4891..b079577b 100644 --- a/src/Gargantext/Database/Action/Query/Node.hs +++ b/src/Gargantext/Database/Action/Query/Node.hs @@ -29,15 +29,11 @@ module Gargantext.Database.Action.Query.Node import Control.Arrow (returnA) import Control.Lens (set, view) -import Control.Lens.TH (makeLensesWith, abbreviatedFields) import Data.Aeson import Data.Maybe (Maybe(..), fromMaybe) -import Data.Profunctor.Product.TH (makeAdaptorAndInstance) import Data.Text (Text) -import Database.PostgreSQL.Simple.FromField (FromField, fromField) import GHC.Int (Int64) import Gargantext.Core.Types -import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Database.Action.Query.Filter (limit', offset') import Gargantext.Database.Admin.Config (nodeTypeId) import Gargantext.Database.Admin.Types.Errors diff --git a/src/Gargantext/Database/Action/Query/Node/Select.hs b/src/Gargantext/Database/Action/Query/Node/Select.hs index ffef3910..40671150 100644 --- a/src/Gargantext/Database/Action/Query/Node/Select.hs +++ b/src/Gargantext/Database/Action/Query/Node/Select.hs @@ -25,7 +25,6 @@ import Gargantext.Database.Admin.Utils import Gargantext.Database.Schema.Node import Gargantext.Database.Schema.User import Gargantext.Database.Action.Query.User -import Gargantext.Database.Action.Query.Node import Opaleye selectNodesWithUsername :: NodeType -> Username -> Cmd err [NodeId] diff --git a/src/Gargantext/Database/Action/Query/Node/User.hs b/src/Gargantext/Database/Action/Query/Node/User.hs index 274813ee..c46256eb 100644 --- a/src/Gargantext/Database/Action/Query/Node/User.hs +++ b/src/Gargantext/Database/Action/Query/Node/User.hs @@ -15,6 +15,7 @@ Portability : POSIX {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} @@ -30,7 +31,7 @@ import Database.PostgreSQL.Simple.FromField (FromField, fromField) import GHC.Generics (Generic) import Gargantext.Core (Lang(..)) import Gargantext.Core.Types (Name) -import Gargantext.Core.Types.Individu (Username, arbitraryUsername, User(..), UserId) +import Gargantext.Core.Types.Individu import Gargantext.Database.Admin.Types.Node (NodeType(..)) import Gargantext.Database.Action.Query.Node import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) diff --git a/src/Gargantext/Database/Action/Query/Tree.hs b/src/Gargantext/Database/Action/Query/Tree.hs index c1614148..6ccb6665 100644 --- a/src/Gargantext/Database/Action/Query/Tree.hs +++ b/src/Gargantext/Database/Action/Query/Tree.hs @@ -14,6 +14,7 @@ Let a Root Node, return the Tree of the Node as a directed acyclic graph {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RankNTypes #-} @@ -28,9 +29,7 @@ import Database.PostgreSQL.Simple import Database.PostgreSQL.Simple.SqlQQ import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Main (NodeTree(..), Tree(..)) -import Gargantext.Database.Action.Query.Node import Gargantext.Database.Admin.Types.Node -- (pgNodeId, NodeType(..)) -import Gargantext.Database.Action.Query.User import Gargantext.Database.Action.Query import Gargantext.Database.Action.Flow.Utils (getUserId) import Gargantext.Database.Admin.Config (fromNodeTypeId, nodeTypeId) diff --git a/src/Gargantext/Database/Action/Query/Tree/Root.hs b/src/Gargantext/Database/Action/Query/Tree/Root.hs index 58ad18f7..f7b8e7c9 100644 --- a/src/Gargantext/Database/Action/Query/Tree/Root.hs +++ b/src/Gargantext/Database/Action/Query/Tree/Root.hs @@ -35,7 +35,7 @@ import Gargantext.Database.Schema.Node (NodeRead) import Gargantext.Database.Schema.Node (queryNodeTable) import Gargantext.Database.Schema.User (UserPoly(..)) import Gargantext.Database.Action.Query.User (queryUserTable) -import Gargantext.Database.Admin.Types.Node (Node, NodePoly(..), NodeType(NodeUser)) +import Gargantext.Database.Admin.Types.Node (Node, NodePoly(..), NodeType(NodeUser), pgNodeId) import Gargantext.Database.Admin.Utils (Cmd, runOpaQuery) import Gargantext.Prelude import Opaleye (restrict, (.==), Query) @@ -59,3 +59,12 @@ selectRoot (UserDBId uid) = proc () -> do restrict -< _node_userId row .== (pgInt4 uid) returnA -< row +selectRoot (RootId nid) = + proc () -> do + row <- queryNodeTable -< () + restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser) + restrict -< _node_id row .== (pgNodeId nid) + returnA -< row + + + diff --git a/src/Gargantext/Database/Action/Query/User.hs b/src/Gargantext/Database/Action/Query/User.hs index 23df22b6..d3363d77 100644 --- a/src/Gargantext/Database/Action/Query/User.hs +++ b/src/Gargantext/Database/Action/Query/User.hs @@ -27,16 +27,12 @@ module Gargantext.Database.Action.Query.User where import Control.Arrow (returnA) -import Control.Lens.TH (makeLensesWith, abbreviatedFields) import Data.Eq(Eq(..)) import Data.List (find) import Data.Maybe (Maybe) -import Data.Profunctor.Product.TH (makeAdaptorAndInstance) import Data.Text (Text) import Data.Time (UTCTime) -import GHC.Show(Show(..)) -import Gargantext.Core.Types.Individu (Username, arbitraryUsername, User(..), UserId) -import Gargantext.Database.Admin.Types.Errors +import Gargantext.Core.Types.Individu import Gargantext.Database.Schema.User import Gargantext.Database.Admin.Utils import Gargantext.Prelude diff --git a/src/Gargantext/Database/Schema/Node.hs b/src/Gargantext/Database/Schema/Node.hs index 52cea514..af9747ea 100644 --- a/src/Gargantext/Database/Schema/Node.hs +++ b/src/Gargantext/Database/Schema/Node.hs @@ -26,24 +26,13 @@ Portability : POSIX module Gargantext.Database.Schema.Node where -import Control.Arrow (returnA) -import Control.Lens (set, view) import Control.Lens.TH (makeLensesWith, abbreviatedFields) -import Data.Aeson -import Data.Maybe (Maybe(..), fromMaybe) +import Data.Maybe (Maybe(..)) import Data.Profunctor.Product.TH (makeAdaptorAndInstance) import Data.Text (Text) import Database.PostgreSQL.Simple.FromField (FromField, fromField) -import GHC.Int (Int64) import Gargantext.Core.Types -import Gargantext.Core.Types.Individu (User(..)) -import Gargantext.Database.Action.Query.Filter (limit', offset') -import Gargantext.Database.Action.Query.Node.Contact (HyperdataContact(..), arbitraryHyperdataContact) -import Gargantext.Database.Admin.Config (nodeTypeId) -import Gargantext.Database.Admin.Types.Errors -import Gargantext.Database.Admin.Types.Node (NodeType(..), defaultCorpus, Hyperdata, HyperData(..)) import Gargantext.Database.Admin.Utils -import Gargantext.Prelude hiding (sum, head) import Gargantext.Viz.Graph (HyperdataGraph(..)) import Opaleye hiding (FromField) import Opaleye.Internal.QueryArr (Query) diff --git a/src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs b/src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs index f2eb09b0..d8a4ac41 100644 --- a/src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs +++ b/src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs @@ -41,7 +41,7 @@ import Data.Maybe (Maybe) import Data.Profunctor.Product.TH (makeAdaptorAndInstance) import Gargantext.Database.Admin.Utils (Cmd, runOpaQuery, mkCmd) import Gargantext.Database.Admin.Types.Node (CorpusId, pgNodeId) -import Gargantext.Database.Schema.Node +import Gargantext.Database.Schema.Node() import Gargantext.Prelude import Opaleye diff --git a/src/Gargantext/Database/Schema/User.hs b/src/Gargantext/Database/Schema/User.hs index ae0f34b3..dcff70df 100644 --- a/src/Gargantext/Database/Schema/User.hs +++ b/src/Gargantext/Database/Schema/User.hs @@ -25,18 +25,12 @@ Functions to deal with users, database side. module Gargantext.Database.Schema.User where -import Control.Arrow (returnA) import Control.Lens.TH (makeLensesWith, abbreviatedFields) -import Data.Eq(Eq(..)) -import Data.List (find) import Data.Maybe (Maybe) import Data.Profunctor.Product.TH (makeAdaptorAndInstance) import Data.Text (Text) import Data.Time (UTCTime) import GHC.Show(Show(..)) -import Gargantext.Core.Types.Individu (Username, arbitraryUsername, User(..), UserId) -import Gargantext.Database.Admin.Types.Errors -import Gargantext.Database.Admin.Utils import Gargantext.Prelude import Opaleye diff --git a/src/Gargantext/Viz/Chart.hs b/src/Gargantext/Viz/Chart.hs index 3d4457d7..333f7eb4 100644 --- a/src/Gargantext/Viz/Chart.hs +++ b/src/Gargantext/Viz/Chart.hs @@ -40,7 +40,6 @@ import Gargantext.Core.Types import Gargantext.Database.Action.Flow import Gargantext.Database.Action.Metrics.NgramsByNode import Gargantext.Database.Schema.Ngrams -import Gargantext.Database.Schema.Node import Servant import qualified Data.List as List import qualified Data.Map as Map diff --git a/src/Gargantext/Viz/Graph/API.hs b/src/Gargantext/Viz/Graph/API.hs index 03819f56..f9849c85 100644 --- a/src/Gargantext/Viz/Graph/API.hs +++ b/src/Gargantext/Viz/Graph/API.hs @@ -50,7 +50,6 @@ import Gargantext.Database.Schema.Ngrams import Gargantext.Database.Action.Query.Node.Select import Gargantext.Database.Action.Query.Node import Gargantext.Database.Action.Query.Node.User -import Gargantext.Database.Schema.Node -- (getNodeWith, getNodeUser, defaultList, insertGraph) import Gargantext.Database.Admin.Types.Errors (HasNodeError) import Gargantext.Database.Admin.Types.Node hiding (node_id) -- (GraphId, ListId, CorpusId, NodeId) import Gargantext.Database.Action.Query.Node.UpdateOpaleye (updateHyperdata) @@ -84,9 +83,10 @@ instance Xmlbf.ToXml Graph where params = HashMap.fromList [ ("mode", "static") , ("defaultedgetype", "directed") ] nodes :: [G.Node] -> [Xmlbf.Node] - nodes gn = Xmlbf.element "nodes" HashMap.empty $ P.concatMap node gn - node :: G.Node -> [Xmlbf.Node] - node (G.Node { node_id = nId, node_label = l }) = + nodes gn = Xmlbf.element "nodes" HashMap.empty $ P.concatMap node' gn + + node' :: G.Node -> [Xmlbf.Node] + node' (G.Node { node_id = nId, node_label = l }) = Xmlbf.element "node" params [] where params = HashMap.fromList [ ("id", nId) -- 2.47.0 From 303860574402477e0deeb80dee9132a4f0a154d3 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Mon, 13 Apr 2020 15:47:50 +0200 Subject: [PATCH 14/16] [DB|Query] clean Root funs --- src/Gargantext/Core/Types/Main.hs | 5 +- src/Gargantext/Database/Action/Flow.hs | 57 +----------- src/Gargantext/Database/Action/Query/Tree.hs | 63 +++++-------- .../Database/Action/Query/Tree/Root.hs | 88 ++++++++++++++++++- 4 files changed, 114 insertions(+), 99 deletions(-) diff --git a/src/Gargantext/Core/Types/Main.hs b/src/Gargantext/Core/Types/Main.hs index d2a23e57..9fd77126 100644 --- a/src/Gargantext/Core/Types/Main.hs +++ b/src/Gargantext/Core/Types/Main.hs @@ -39,6 +39,7 @@ import Test.QuickCheck (elements) import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) import Text.Read (read) +type CorpusName = Text ------------------------------------------------------------------------ data NodeTree = NodeTree { _nt_name :: Text , _nt_type :: NodeType @@ -74,7 +75,7 @@ type ListTypeId = Int listTypeId :: ListType -> ListTypeId listTypeId StopTerm = 0 listTypeId CandidateTerm = 1 -listTypeId GraphTerm = 2 +listTypeId GraphTerm = 2 fromListTypeId :: ListTypeId -> Maybe ListType fromListTypeId i = lookup i $ fromList [ (listTypeId l, l) | l <- [minBound..maxBound]] @@ -95,7 +96,7 @@ type Offset = Int type IsTrash = Bool ------------------------------------------------------------------------ --- All the Database is structred like a hierarchical Tree +-- All the Database is structured as a hierarchical Tree data Tree a = TreeN { _tn_node :: a, _tn_children :: [Tree a] } deriving (Show, Read, Eq, Generic, Ord) diff --git a/src/Gargantext/Database/Action/Flow.hs b/src/Gargantext/Database/Action/Flow.hs index da568d90..e1127285 100644 --- a/src/Gargantext/Database/Action/Flow.hs +++ b/src/Gargantext/Database/Action/Flow.hs @@ -50,20 +50,19 @@ import Data.Tuple.Extra (first, second) import Debug.Trace (trace) import Gargantext.Core (Lang(..)) import Gargantext.Core.Flow.Types -import Gargantext.Core.Types (NodePoly(..), Terms(..)) +import Gargantext.Core.Types (Terms(..)) import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Core.Types.Main import Gargantext.Database.Action.Flow.List import Gargantext.Database.Action.Flow.Types -import Gargantext.Database.Action.Flow.Utils (insertDocNgrams, getUserId) +import Gargantext.Database.Action.Flow.Utils (insertDocNgrams) import Gargantext.Database.Action.Query.Node import Gargantext.Database.Action.Query.Node.Contact -- (HyperdataContact(..), ContactWho(..)) import Gargantext.Database.Action.Query.Node.Document.Insert -- (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..)) -import Gargantext.Database.Action.Query.Tree.Root (getRoot) -import Gargantext.Database.Action.Query.Tree (mkRoot) +import Gargantext.Database.Action.Query.Tree.Root (getOrMkRoot, getOrMk_RootWithCorpus) import Gargantext.Database.Action.Search (searchInDatabase) import Gargantext.Database.Admin.Config (userMaster, corpusMasterName) -import Gargantext.Database.Admin.Types.Errors (HasNodeError(..), NodeError(..), nodeError) +import Gargantext.Database.Admin.Types.Errors (HasNodeError(..)) import Gargantext.Database.Admin.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId) import Gargantext.Database.Admin.Utils (Cmd) import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams, NgramsType(..), text2ngrams, ngramsTypeId) @@ -311,54 +310,6 @@ withLang (Unsupervised l n s m) ns = Unsupervised l n s m' withLang l _ = l - -type CorpusName = Text - -getOrMkRoot :: (HasNodeError err) - => User - -> Cmd err (UserId, RootId) -getOrMkRoot user = do - userId <- getUserId user - - rootId' <- map _node_id <$> getRoot user - - rootId'' <- case rootId' of - [] -> mkRoot user - n -> case length n >= 2 of - True -> nodeError ManyNodeUsers - False -> pure rootId' - - rootId <- maybe (nodeError NoRootFound) pure (head rootId'') - pure (userId, rootId) - - -getOrMk_RootWithCorpus :: (HasNodeError err, MkCorpus a) - => User - -> Either CorpusName [CorpusId] - -> Maybe a - -> Cmd err (UserId, RootId, CorpusId) -getOrMk_RootWithCorpus user cName 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 -> pure [0] - Just c'' -> mkNode NodeTexts c'' userId - pure c' - - corpusId <- maybe (nodeError NoCorpusFound) pure (head corpusId') - pure (userId, rootId, corpusId) - - ------------------------------------------------------------------------ viewUniqId' :: UniqId a => a diff --git a/src/Gargantext/Database/Action/Query/Tree.hs b/src/Gargantext/Database/Action/Query/Tree.hs index 6ccb6665..ebce9d02 100644 --- a/src/Gargantext/Database/Action/Query/Tree.hs +++ b/src/Gargantext/Database/Action/Query/Tree.hs @@ -27,46 +27,13 @@ import Data.Map (Map, fromListWith, lookup) import Data.Text (Text) import Database.PostgreSQL.Simple import Database.PostgreSQL.Simple.SqlQQ -import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Main (NodeTree(..), Tree(..)) import Gargantext.Database.Admin.Types.Node -- (pgNodeId, NodeType(..)) -import Gargantext.Database.Action.Query -import Gargantext.Database.Action.Flow.Utils (getUserId) import Gargantext.Database.Admin.Config (fromNodeTypeId, nodeTypeId) -import Gargantext.Database.Admin.Types.Errors import Gargantext.Database.Admin.Types.Node (NodeId, NodeType, DocId, allNodeTypes) import Gargantext.Database.Admin.Utils (Cmd, runPGSQuery) import Gargantext.Prelude ------------------------------------------------------------------------- --- import Gargantext.Database.Utils (runCmdDev) --- treeTest :: IO (Tree NodeTree) --- treeTest = runCmdDev $ treeDB 347474 ------------------------------------------------------------------------- - -mkRoot :: HasNodeError err - => User - -> Cmd err [RootId] -mkRoot user = do - - uid <- getUserId user - - let una = "username" - - case uid > 0 of - False -> nodeError NegativeId - True -> do - rs <- mkNodeWithParent NodeUser Nothing uid una - _ <- case rs of - [r] -> do - _ <- mkNodeWithParent NodeFolderPrivate (Just r) uid una - _ <- mkNodeWithParent NodeFolderShared (Just r) uid una - _ <- mkNodeWithParent NodeFolderPublic (Just r) uid una - pure rs - _ -> pure rs - pure rs - - ------------------------------------------------------------------------ data TreeError = NoRoot | EmptyRoot | TooManyRoots deriving (Show) @@ -74,16 +41,24 @@ data TreeError = NoRoot | EmptyRoot | TooManyRoots class HasTreeError e where _TreeError :: Prism' e TreeError -treeError :: (MonadError e m, HasTreeError e) => TreeError -> m a +treeError :: ( MonadError e m + , HasTreeError e) + => TreeError + -> m a treeError te = throwError $ _TreeError # te -- | Returns the Tree of Nodes in Database -treeDB :: HasTreeError err => RootId -> [NodeType] -> Cmd err (Tree NodeTree) +treeDB :: HasTreeError err + => RootId + -> [NodeType] + -> Cmd err (Tree NodeTree) treeDB r nodeTypes = toTree =<< (toTreeParent <$> dbTree r nodeTypes) ------------------------------------------------------------------------ -toTree :: (MonadError e m, HasTreeError e) - => Map (Maybe ParentId) [DbTreeNode] -> m (Tree NodeTree) +toTree :: ( MonadError e m + , HasTreeError e) + => Map (Maybe ParentId) [DbTreeNode] + -> m (Tree NodeTree) toTree m = case lookup Nothing m of Just [n] -> pure $ toTree' m n @@ -91,18 +66,22 @@ toTree m = Just [] -> treeError EmptyRoot Just _ -> treeError TooManyRoots -toTree' :: Map (Maybe ParentId) [DbTreeNode] -> DbTreeNode -> Tree NodeTree +toTree' :: Map (Maybe ParentId) [DbTreeNode] + -> DbTreeNode + -> Tree NodeTree toTree' m n = TreeN (toNodeTree n) $ m ^.. at (Just $ dt_nodeId n) . _Just . each . to (toTree' m) ------------------------------------------------------------------------ -toNodeTree :: DbTreeNode -> NodeTree +toNodeTree :: DbTreeNode + -> NodeTree toNodeTree (DbTreeNode nId tId _ n) = NodeTree n nodeType nId where nodeType = fromNodeTypeId tId ------------------------------------------------------------------------ -toTreeParent :: [DbTreeNode] -> Map (Maybe ParentId) [DbTreeNode] +toTreeParent :: [DbTreeNode] + -> Map (Maybe ParentId) [DbTreeNode] toTreeParent = fromListWith (<>) . map (\n -> (dt_parentId n, [n])) ------------------------------------------------------------------------ data DbTreeNode = DbTreeNode { dt_nodeId :: NodeId @@ -113,7 +92,9 @@ data DbTreeNode = DbTreeNode { dt_nodeId :: NodeId -- | Main DB Tree function -- TODO add typenames as parameters -dbTree :: RootId -> [NodeType] -> Cmd err [DbTreeNode] +dbTree :: RootId + -> [NodeType] + -> Cmd err [DbTreeNode] dbTree rootId nodeTypes = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n) <$> runPGSQuery [sql| WITH RECURSIVE diff --git a/src/Gargantext/Database/Action/Query/Tree/Root.hs b/src/Gargantext/Database/Action/Query/Tree/Root.hs index f7b8e7c9..425b920e 100644 --- a/src/Gargantext/Database/Action/Query/Tree/Root.hs +++ b/src/Gargantext/Database/Action/Query/Tree/Root.hs @@ -27,12 +27,19 @@ Portability : POSIX module Gargantext.Database.Action.Query.Tree.Root where +import Data.Either (Either, fromLeft, fromRight) import Control.Arrow (returnA) +import Gargantext.Core.Types.Main (CorpusName) import Gargantext.Core.Types.Individu (User(..)) -import Gargantext.Database.Admin.Config (nodeTypeId) +import Gargantext.Database.Admin.Config (nodeTypeId, userMaster) +import Gargantext.Database.Admin.Types.Errors +import Gargantext.Database.Admin.Types.Node +import Gargantext.Database.Action.Query.Node import Gargantext.Database.Action.Query.Node.User (HyperdataUser) +import Gargantext.Database.Action.Flow.Utils (getUserId) import Gargantext.Database.Schema.Node (NodeRead) import Gargantext.Database.Schema.Node (queryNodeTable) +import Gargantext.Database.Action.Query import Gargantext.Database.Schema.User (UserPoly(..)) import Gargantext.Database.Action.Query.User (queryUserTable) import Gargantext.Database.Admin.Types.Node (Node, NodePoly(..), NodeType(NodeUser), pgNodeId) @@ -41,6 +48,83 @@ import Gargantext.Prelude import Opaleye (restrict, (.==), Query) import Opaleye.PGTypes (pgStrictText, pgInt4) + + +getOrMkRoot :: (HasNodeError err) + => User + -> Cmd err (UserId, RootId) +getOrMkRoot user = do + userId <- getUserId user + + rootId' <- map _node_id <$> getRoot user + + rootId'' <- case rootId' of + [] -> mkRoot user + n -> case length n >= 2 of + True -> nodeError ManyNodeUsers + False -> pure rootId' + + rootId <- maybe (nodeError NoRootFound) pure (head rootId'') + pure (userId, rootId) + + +getOrMk_RootWithCorpus :: (HasNodeError err, MkCorpus a) + => User + -> Either CorpusName [CorpusId] + -> Maybe a + -> Cmd err (UserId, RootId, CorpusId) +getOrMk_RootWithCorpus user cName 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 -> pure [0] + Just c'' -> mkNode NodeTexts c'' userId + pure c' + + corpusId <- maybe (nodeError NoCorpusFound) pure (head corpusId') + pure (userId, rootId, corpusId) + + + + + + +mkRoot :: HasNodeError err + => User + -> Cmd err [RootId] +mkRoot user = do + + -- TODO + -- udb <- getUserDb user + -- let uid = user_id udb + uid <- getUserId user + + -- TODO ? Which name for user Node ? + let una = "username" + + case uid > 0 of + False -> nodeError NegativeId + True -> do + rs <- mkNodeWithParent NodeUser Nothing uid una + _ <- case rs of + [r] -> do + _ <- mkNodeWithParent NodeFolderPrivate (Just r) uid una + _ <- mkNodeWithParent NodeFolderShared (Just r) uid una + _ <- mkNodeWithParent NodeFolderPublic (Just r) uid una + pure rs + _ -> pure rs + pure rs + getRoot :: User -> Cmd err [Node HyperdataUser] getRoot = runOpaQuery . selectRoot @@ -66,5 +150,3 @@ selectRoot (RootId nid) = restrict -< _node_id row .== (pgNodeId nid) returnA -< row - - -- 2.47.0 From 6dcedcdc013e9bc2bdd4fc2066223982198992ae Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Tue, 14 Apr 2020 22:08:31 +0200 Subject: [PATCH 15/16] [Clean] before factoring --- src/Gargantext/API/Corpus/New.hs | 48 +++++++------------ src/Gargantext/Database/Action/Flow.hs | 17 +------ src/Gargantext/Database/Action/Learn.hs | 6 +-- src/Gargantext/Database/Action/Query/Tree.hs | 10 ++++ .../Text/Corpus/Parsers/GrandDebat.hs | 13 ++++- 5 files changed, 44 insertions(+), 50 deletions(-) diff --git a/src/Gargantext/API/Corpus/New.hs b/src/Gargantext/API/Corpus/New.hs index 9d4bbf49..b045019d 100644 --- a/src/Gargantext/API/Corpus/New.hs +++ b/src/Gargantext/API/Corpus/New.hs @@ -54,6 +54,7 @@ import Test.QuickCheck.Arbitrary import Web.FormUrlEncoded (FromForm) import qualified Gargantext.Text.Corpus.API as API +------------------------------------------------------------------------ data Query = Query { query_query :: Text , query_corpus_id :: Int , query_databases :: [API.ExternalAPIs] @@ -64,7 +65,8 @@ deriveJSON (unPrefix "query_") 'Query instance Arbitrary Query where arbitrary = elements [ Query q n fs - | q <- ["a","b"] + | q <- ["honeybee* AND collopase" + ,"covid 19"] , n <- [0..10] , fs <- take 3 $ repeat API.externalAPIs ] @@ -85,6 +87,7 @@ type GetApi = Get '[JSON] ApiInfo -- | TODO manage several apis -- TODO-ACCESS -- TODO this is only the POST +{- api :: (FlowCmdM env err m) => UserId -> Query -> m CorpusId api uid (Query q _ as) = do cId <- case head as of @@ -96,8 +99,10 @@ api uid (Query q _ as) = do pure cId' pure cId +-} ------------------------------------------------ +-- TODO use this route for Client implementation data ApiInfo = ApiInfo { api_info :: [API.ExternalAPIs]} deriving (Generic) instance Arbitrary ApiInfo where @@ -147,35 +152,35 @@ type AsyncJobs event ctI input output = type Upload = Summary "Corpus Upload endpoint" :> "corpus" - :> Capture "corpus_id" CorpusId - :<|> "addWithquery" :> AsyncJobsAPI ScraperStatus WithQuery ScraperStatus - :<|> "addWithfile" :> AsyncJobs ScraperStatus '[FormUrlEncoded] WithForm ScraperStatus + :> Capture "corpus_id" CorpusId + :<|> "addWithquery" :> AsyncJobsAPI ScraperStatus WithQuery ScraperStatus + :<|> "addWithfile" :> AsyncJobs ScraperStatus '[FormUrlEncoded] WithForm ScraperStatus type AddWithQuery = Summary "Add with Query to corpus endpoint" :> "corpus" - :> Capture "corpus_id" CorpusId + :> Capture "corpus_id" CorpusId :> "add" :> "query" :> "async" - :> AsyncJobsAPI ScraperStatus WithQuery ScraperStatus + :> AsyncJobsAPI ScraperStatus WithQuery ScraperStatus type AddWithFile = Summary "Add with MultipartData to corpus endpoint" :> "corpus" - :> Capture "corpus_id" CorpusId - :> "add" + :> Capture "corpus_id" CorpusId + :> "add" :> "file" - :> MultipartForm Mem (MultipartData Mem) - :> QueryParam "fileType" FileType + :> MultipartForm Mem (MultipartData Mem) + :> QueryParam "fileType" FileType :> "async" - :> AsyncJobs ScraperStatus '[JSON] () ScraperStatus + :> AsyncJobs ScraperStatus '[JSON] () ScraperStatus type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint" :> "corpus" - :> Capture "corpus_id" CorpusId + :> Capture "corpus_id" CorpusId :> "add" :> "form" :> "async" - :> AsyncJobs ScraperStatus '[FormUrlEncoded] WithForm ScraperStatus + :> AsyncJobs ScraperStatus '[FormUrlEncoded] WithForm ScraperStatus ------------------------------------------------------------------------ -- TODO WithQuery also has a corpus id @@ -227,23 +232,6 @@ addToCorpusWithFile cid input filetype logStatus = do , _scst_events = Just [] } -{- | Model to fork the flow --- This is not really optimized since it increases the need RAM --- and freezes the whole system --- This is mainly for documentation (see a better solution in the function below) --- Each process has to be tailored -addToCorpusWithForm' :: FlowCmdM env err m - => CorpusId - -> WithForm - -> (ScraperStatus -> m ()) - -> m ScraperStatus -addToCorpusWithForm' cid (WithForm ft d l) logStatus = do - newStatus <- liftBase newEmptyMVar - s <- addToCorpusWithForm cid (WithForm ft d l) logStatus - _ <- liftBase $ forkIO $ putMVar newStatus s - s' <- liftBase $ takeMVar newStatus - pure s' --} addToCorpusWithForm :: FlowCmdM env err m => User -> CorpusId diff --git a/src/Gargantext/Database/Action/Flow.hs b/src/Gargantext/Database/Action/Flow.hs index e1127285..15ab7f9c 100644 --- a/src/Gargantext/Database/Action/Flow.hs +++ b/src/Gargantext/Database/Action/Flow.hs @@ -71,7 +71,6 @@ import Gargantext.Database.Schema.NodeNodeNgrams2 -- (NodeNodeNgrams2, insertNod import Gargantext.Ext.IMT (toSchoolName) import Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile) import Gargantext.Prelude -import Gargantext.Prelude.Utils hiding (sha) import Gargantext.Text.Corpus.Parsers (parseFile, FileFormat) import Gargantext.Text.List (buildNgramsLists,StopSize(..)) import Gargantext.Text.Terms (TermType(..), tt_lang, extractTerms, uniText) @@ -84,7 +83,6 @@ import qualified Data.Map as Map import qualified Data.Text as Text import qualified Gargantext.Database.Action.Query.Node.Document.Add as Doc (add) import qualified Gargantext.Text.Corpus.API.Isidore as Isidore -import qualified Gargantext.Text.Corpus.Parsers.GrandDebat as GD ------------------------------------------------------------------------ @@ -111,7 +109,6 @@ _flowCorpusApi u n tt l q = do flowCorpus u n tt docs ------------------------------------------------------------------------ - flowAnnuaire :: FlowCmdM env err m => User -> Either CorpusName [CorpusId] @@ -121,19 +118,7 @@ flowAnnuaire :: FlowCmdM env err m flowAnnuaire u n l filePath = do docs <- liftBase $ (( splitEvery 500 <$> deserialiseImtUsersFromFile filePath) :: IO [[HyperdataContact]]) flow (Nothing :: Maybe HyperdataAnnuaire) u n l docs - --- UNUSED -_flowCorpusDebat :: FlowCmdM env err m - => User -> Either CorpusName [CorpusId] - -> Limit -> FilePath - -> m CorpusId -_flowCorpusDebat u n l fp = do - docs <- liftBase ( splitEvery 500 - <$> take l - <$> readFile' fp - :: IO [[GD.GrandDebatReference ]] - ) - flowCorpus u n (Multi FR) (map (map toHyperdataDocument) docs) +------------------------------------------------------------------------ flowCorpusFile :: FlowCmdM env err m => User -> Either CorpusName [CorpusId] diff --git a/src/Gargantext/Database/Action/Learn.hs b/src/Gargantext/Database/Action/Learn.hs index 07dee57b..15eb3841 100644 --- a/src/Gargantext/Database/Action/Learn.hs +++ b/src/Gargantext/Database/Action/Learn.hs @@ -44,13 +44,13 @@ moreLike cId o l order ft = do --------------------------------------------------------------------------- getPriors :: FavOrTrash -> CorpusId -> Cmd err (Events Bool) getPriors ft cId = do - + docs_fav <- filter (\(FacetDoc _ _ _ _ f _) -> f == Just 2) <$> runViewDocuments cId False Nothing Nothing Nothing - + docs_trash <- List.take (List.length docs_fav) <$> runViewDocuments cId True Nothing Nothing Nothing - + let priors = priorEventsWith text (fav2bool ft) ( List.zip (repeat False) docs_fav <> List.zip (repeat True ) docs_trash diff --git a/src/Gargantext/Database/Action/Query/Tree.hs b/src/Gargantext/Database/Action/Query/Tree.hs index ebce9d02..5ef1ce90 100644 --- a/src/Gargantext/Database/Action/Query/Tree.hs +++ b/src/Gargantext/Database/Action/Query/Tree.hs @@ -34,6 +34,16 @@ import Gargantext.Database.Admin.Types.Node (NodeId, NodeType, DocId, allNodeTyp import Gargantext.Database.Admin.Utils (Cmd, runPGSQuery) import Gargantext.Prelude +------------------------------------------------------------------------ + +findCorpus :: RootId -> Cmd err (Maybe CorpusId) +findCorpus r = do + _mapNodes <- toTreeParent <$> dbTree r [] + pure Nothing + + + + ------------------------------------------------------------------------ data TreeError = NoRoot | EmptyRoot | TooManyRoots deriving (Show) diff --git a/src/Gargantext/Text/Corpus/Parsers/GrandDebat.hs b/src/Gargantext/Text/Corpus/Parsers/GrandDebat.hs index 0ceb844d..d61690b3 100644 --- a/src/Gargantext/Text/Corpus/Parsers/GrandDebat.hs +++ b/src/Gargantext/Text/Corpus/Parsers/GrandDebat.hs @@ -7,7 +7,18 @@ Maintainer : team@gargantext.org Stability : experimental Portability : POSIX -TODO: create a separate Lib. +_flowCorpusDebat :: FlowCmdM env err m + => User -> Either CorpusName [CorpusId] + -> Limit -> FilePath + -> m CorpusId +_flowCorpusDebat u n l fp = do + docs <- liftBase ( splitEvery 500 + <$> take l + <$> readFile' fp + :: IO [[GD.GrandDebatReference ]] + ) + flowCorpus u n (Multi FR) (map (map toHyperdataDocument) docs) + -} -- 2.47.0 From 639912889a08eae10ef92d39de1fce1438e2a129 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Alexandre=20Delano=C3=AB?= Date: Wed, 15 Apr 2020 09:13:15 +0200 Subject: [PATCH 16/16] [API] Facto and mkdir Admin --- bin/gargantext-import/Main.hs | 4 ++-- bin/gargantext-init/Main.hs | 4 ++-- package.yaml | 9 ++------ src/Gargantext/API.hs | 20 ++++++++--------- src/Gargantext/API/{ => Admin}/Auth.hs | 10 ++++----- src/Gargantext/API/{ => Admin}/FrontEnd.hs | 4 ++-- .../API/{ => Admin}/Orchestrator.hs | 19 ++++++++++++---- .../Orchestrator/Scrapy/Schedule.hs | 21 +++++++++++++++--- .../API/{ => Admin}/Orchestrator/Types.hs | 12 ++++++---- src/Gargantext/API/{ => Admin}/Settings.hs | 6 ++--- src/Gargantext/API/{ => Admin}/Types.hs | 10 ++++----- src/Gargantext/API/{ => Admin}/Utils.hs | 4 ++-- src/Gargantext/API/Application.hs | 22 ------------------- src/Gargantext/API/{ => Corpus}/Annuaire.hs | 10 ++++----- src/Gargantext/API/{ => Corpus}/Export.hs | 6 ++--- src/Gargantext/API/Corpus/New.hs | 14 +++++++----- src/Gargantext/API/Ngrams/List.hs | 4 ++-- src/Gargantext/API/Node.hs | 10 ++++----- src/Gargantext/API/Search.hs | 2 +- src/Gargantext/Prelude/Utils.hs | 2 +- src/Gargantext/Text/Corpus/API.hs | 9 ++++---- src/Gargantext/Text/List/Learn.hs | 3 ++- src/Gargantext/Viz/Graph/API.hs | 4 ++-- src/Gargantext/Viz/Phylo/API.hs | 2 +- 24 files changed, 108 insertions(+), 103 deletions(-) rename src/Gargantext/API/{ => Admin}/Auth.hs (97%) rename src/Gargantext/API/{ => Admin}/FrontEnd.hs (87%) rename src/Gargantext/API/{ => Admin}/Orchestrator.hs (86%) rename src/Gargantext/API/{ => Admin}/Orchestrator/Scrapy/Schedule.hs (76%) rename src/Gargantext/API/{ => Admin}/Orchestrator/Types.hs (96%) rename src/Gargantext/API/{ => Admin}/Settings.hs (98%) rename src/Gargantext/API/{ => Admin}/Types.hs (95%) rename src/Gargantext/API/{ => Admin}/Utils.hs (90%) delete mode 100644 src/Gargantext/API/Application.hs rename src/Gargantext/API/{ => Corpus}/Annuaire.hs (95%) rename src/Gargantext/API/{ => Corpus}/Export.hs (97%) diff --git a/bin/gargantext-import/Main.hs b/bin/gargantext-import/Main.hs index e488f929..5191c691 100644 --- a/bin/gargantext-import/Main.hs +++ b/bin/gargantext-import/Main.hs @@ -23,8 +23,8 @@ import Control.Exception (finally) import Data.Either import Data.Text (Text) import Gargantext.API.Node () -- instances -import Gargantext.API.Settings (withDevEnv, runCmdDev, DevEnv) -import Gargantext.API.Types (GargError) +import Gargantext.API.Admin.Settings (withDevEnv, runCmdDev, DevEnv) +import Gargantext.API.Admin.Types (GargError) import Gargantext.Core (Lang(..)) import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Database.Action.Flow (FlowCmdM, flowCorpusFile, flowAnnuaire) diff --git a/bin/gargantext-init/Main.hs b/bin/gargantext-init/Main.hs index 7edcde86..a9ad81c8 100644 --- a/bin/gargantext-init/Main.hs +++ b/bin/gargantext-init/Main.hs @@ -22,8 +22,8 @@ module Main where import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Gargantext.API.Node () -- instances -import Gargantext.API.Settings (withDevEnv, runCmdDev) -import Gargantext.API.Types (GargError) +import Gargantext.API.Admin.Settings (withDevEnv, runCmdDev) +import Gargantext.API.Admin.Types (GargError) import Gargantext.Core.Types.Individu (UserId, User(..)) import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMk_RootWithCorpus) import Gargantext.Database.Admin.Config (userMaster, corpusMasterName) diff --git a/package.yaml b/package.yaml index 8d3315ea..6a4bcc4d 100644 --- a/package.yaml +++ b/package.yaml @@ -27,14 +27,9 @@ library: exposed-modules: - Gargantext - Gargantext.API - - Gargantext.API.Auth - - Gargantext.API.Count - - Gargantext.API.FrontEnd - - Gargantext.API.Ngrams - Gargantext.API.Node - - Gargantext.API.Search - - Gargantext.API.Settings - - Gargantext.API.Types + - Gargantext.API.Admin.Settings + - Gargantext.API.Admin.Types - Gargantext.Core - Gargantext.Core.Types - Gargantext.Core.Types.Individu diff --git a/src/Gargantext/API.hs b/src/Gargantext/API.hs index cc892b13..9bd95ff8 100644 --- a/src/Gargantext/API.hs +++ b/src/Gargantext/API.hs @@ -62,15 +62,15 @@ import Data.Version (showVersion) import GHC.Base (Applicative) import GHC.Generics (D1, Meta (..), Rep) import GHC.TypeLits (AppendSymbol, Symbol) -import Gargantext.API.Auth (AuthRequest, AuthResponse, AuthenticatedUser(..), AuthContext, auth, withAccess, PathId(..)) +import Gargantext.API.Admin.Auth (AuthRequest, AuthResponse, AuthenticatedUser(..), AuthContext, auth, withAccess, PathId(..)) +import Gargantext.API.Admin.FrontEnd (FrontEndAPI, frontEndServer) +import Gargantext.API.Admin.Orchestrator.Types +import Gargantext.API.Admin.Settings +import Gargantext.API.Admin.Types import Gargantext.API.Count ( CountAPI, count, Query) -import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer) import Gargantext.API.Ngrams (HasRepo(..), HasRepoSaver(..), saveRepo, TableNgramsApi, apiNgramsTableDoc) import Gargantext.API.Node -import Gargantext.API.Orchestrator.Types import Gargantext.API.Search (SearchPairsAPI, searchPairs) -import Gargantext.API.Settings -import Gargantext.API.Types import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Database.Action.Query.Node.Contact (HyperdataContact) import Gargantext.Database.Admin.Types.Node @@ -94,11 +94,11 @@ import Servant.Swagger.UI import System.IO (FilePath) import qualified Data.ByteString.Lazy.Char8 as BL8 import qualified Data.Text.IO as T -import qualified Gargantext.API.Annuaire as Annuaire -import qualified Gargantext.API.Corpus.New as New -import qualified Gargantext.API.Export as Export -import qualified Gargantext.API.Ngrams.List as List -import qualified Paths_gargantext as PG -- cabal magic build module +import qualified Gargantext.API.Corpus.Annuaire as Annuaire +import qualified Gargantext.API.Corpus.Export as Export +import qualified Gargantext.API.Corpus.New as New +import qualified Gargantext.API.Ngrams.List as List +import qualified Paths_gargantext as PG -- cabal magic build module showAsServantErr :: GargError -> ServerError showAsServantErr (GargServerError err) = err diff --git a/src/Gargantext/API/Auth.hs b/src/Gargantext/API/Admin/Auth.hs similarity index 97% rename from src/Gargantext/API/Auth.hs rename to src/Gargantext/API/Admin/Auth.hs index ed4f946e..0ea83759 100644 --- a/src/Gargantext/API/Auth.hs +++ b/src/Gargantext/API/Admin/Auth.hs @@ -1,5 +1,5 @@ {-| -Module : Gargantext.API.Auth +Module : Gargantext.API.Admin.Auth Description : Server API Auth Module Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 @@ -29,7 +29,7 @@ TODO-ACCESS Critical {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} -module Gargantext.API.Auth +module Gargantext.API.Admin.Auth where import Control.Lens (view) @@ -40,12 +40,12 @@ import Data.Text (Text, reverse) import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Encoding (decodeUtf8) import GHC.Generics (Generic) -import Gargantext.API.Settings -import Gargantext.API.Types (HasJoseError(..), joseError, HasServerError, GargServerC) +import Gargantext.API.Admin.Settings +import Gargantext.API.Admin.Types (HasJoseError(..), joseError, HasServerError, GargServerC) import Gargantext.Core.Types.Individu (User(..), Username, Password, arbitraryUsername, arbitraryPassword) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) -import Gargantext.Database.Action.Query.Tree.Root (getRoot) import Gargantext.Database.Action.Query.Tree (isDescendantOf, isIn) +import Gargantext.Database.Action.Query.Tree.Root (getRoot) import Gargantext.Database.Admin.Types.Node (NodePoly(_node_id), NodeId(..), UserId, ListId, DocId) import Gargantext.Database.Admin.Utils (Cmd', CmdM, HasConnectionPool) import Gargantext.Prelude hiding (reverse) diff --git a/src/Gargantext/API/FrontEnd.hs b/src/Gargantext/API/Admin/FrontEnd.hs similarity index 87% rename from src/Gargantext/API/FrontEnd.hs rename to src/Gargantext/API/Admin/FrontEnd.hs index b309634a..522a0545 100644 --- a/src/Gargantext/API/FrontEnd.hs +++ b/src/Gargantext/API/Admin/FrontEnd.hs @@ -1,5 +1,5 @@ {-| -Module : Gargantext.API.FrontEnd +Module : Gargantext.API.Admin.FrontEnd Description : Server FrontEnd API Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 @@ -16,7 +16,7 @@ Loads all static file for the front-end. {-# LANGUAGE TypeOperators #-} --------------------------------------------------------------------- -module Gargantext.API.FrontEnd where +module Gargantext.API.Admin.FrontEnd where import Servant import Servant.Server.StaticFiles (serveDirectoryFileServer) diff --git a/src/Gargantext/API/Orchestrator.hs b/src/Gargantext/API/Admin/Orchestrator.hs similarity index 86% rename from src/Gargantext/API/Orchestrator.hs rename to src/Gargantext/API/Admin/Orchestrator.hs index 522cfa42..8f7be5f3 100644 --- a/src/Gargantext/API/Orchestrator.hs +++ b/src/Gargantext/API/Admin/Orchestrator.hs @@ -1,3 +1,14 @@ +{-| +Module : Gargantext.API.Admin.Orchestrator +Description : Jobs Orchestrator +Copyright : (c) CNRS, 2017-Present +License : AGPL + CECILL v3 +Maintainer : team@gargantext.org +Stability : experimental +Portability : POSIX + +-} + {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} @@ -7,12 +18,12 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} -module Gargantext.API.Orchestrator where +module Gargantext.API.Admin.Orchestrator where import Gargantext.Prelude -import Gargantext.API.Settings -import Gargantext.API.Orchestrator.Types -import Gargantext.API.Orchestrator.Scrapy.Schedule +import Gargantext.API.Admin.Settings +import Gargantext.API.Admin.Orchestrator.Types +import Gargantext.API.Admin.Orchestrator.Scrapy.Schedule import Control.Lens hiding (elements) import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as LBS diff --git a/src/Gargantext/API/Orchestrator/Scrapy/Schedule.hs b/src/Gargantext/API/Admin/Orchestrator/Scrapy/Schedule.hs similarity index 76% rename from src/Gargantext/API/Orchestrator/Scrapy/Schedule.hs rename to src/Gargantext/API/Admin/Orchestrator/Scrapy/Schedule.hs index e3c88685..94d20043 100644 --- a/src/Gargantext/API/Orchestrator/Scrapy/Schedule.hs +++ b/src/Gargantext/API/Admin/Orchestrator/Scrapy/Schedule.hs @@ -1,18 +1,33 @@ +{-| +Module : Gargantext.API.Admin.Orchestartor.Scrapy.Schedule +Description : Server API Auth Module +Copyright : (c) CNRS, 2017-Present +License : AGPL + CECILL v3 +Maintainer : team@gargantext.org +Stability : experimental +Portability : POSIX + +-} + {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} -module Gargantext.API.Orchestrator.Scrapy.Schedule where + +module Gargantext.API.Admin.Orchestrator.Scrapy.Schedule + where import Control.Lens import Data.Aeson -import qualified Data.HashMap.Strict as H import Data.Text (Text) import GHC.Generics import Servant -import Servant.Job.Utils (jsonOptions) import Servant.Client +import Servant.Job.Utils (jsonOptions) import Web.FormUrlEncoded hiding (parseMaybe) +import qualified Data.HashMap.Strict as H + +------------------------------------------------------------------------ data Schedule = Schedule { s_project :: !Text diff --git a/src/Gargantext/API/Orchestrator/Types.hs b/src/Gargantext/API/Admin/Orchestrator/Types.hs similarity index 96% rename from src/Gargantext/API/Orchestrator/Types.hs rename to src/Gargantext/API/Admin/Orchestrator/Types.hs index 97a64554..46735d56 100644 --- a/src/Gargantext/API/Orchestrator/Types.hs +++ b/src/Gargantext/API/Admin/Orchestrator/Types.hs @@ -8,21 +8,25 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} -module Gargantext.API.Orchestrator.Types where +module Gargantext.API.Admin.Orchestrator.Types + where -import Gargantext.Prelude import Control.Lens hiding (elements) import Data.Aeson import Data.Proxy -import Data.Text (Text) import Data.Swagger hiding (URL, url, port) +import Data.Text (Text) import GHC.Generics hiding (to) +import Gargantext.Core.Types (TODO(..)) +import Gargantext.Prelude import Servant.Job.Async import Servant.Job.Types import Servant.Job.Utils (jsonOptions) import Test.QuickCheck (elements) import Test.QuickCheck.Arbitrary -import Gargantext.Core.Types (TODO(..)) + +------------------------------------------------------------------------ + instance Arbitrary a => Arbitrary (JobStatus 'Safe a) where arbitrary = panic "TODO" diff --git a/src/Gargantext/API/Settings.hs b/src/Gargantext/API/Admin/Settings.hs similarity index 98% rename from src/Gargantext/API/Settings.hs rename to src/Gargantext/API/Admin/Settings.hs index f04076cf..ed7719de 100644 --- a/src/Gargantext/API/Settings.hs +++ b/src/Gargantext/API/Admin/Settings.hs @@ -1,5 +1,5 @@ {-| -Module : Gargantext.API.Settings +Module : Gargantext.API.Admin.Settings Description : Settings of the API (Server and Client) Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 @@ -23,7 +23,7 @@ TODO-SECURITY: Critical {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} -module Gargantext.API.Settings +module Gargantext.API.Admin.Settings where import Control.Concurrent @@ -41,8 +41,8 @@ import Data.Text import Database.PostgreSQL.Simple (Connection, connect, close, ConnectInfo) import GHC.Enum import GHC.Generics (Generic) +import Gargantext.API.Admin.Orchestrator.Types import Gargantext.API.Ngrams (NgramsRepo, HasRepoVar(..), HasRepoSaver(..), HasRepo(..), RepoEnv(..), r_version, saveRepo, initRepo, renv_var, renv_lock) -import Gargantext.API.Orchestrator.Types import Gargantext.Database.Admin.Utils (databaseParameters, HasConnectionPool(..), Cmd', runCmd) import Gargantext.Prelude import Network.HTTP.Client (Manager) diff --git a/src/Gargantext/API/Types.hs b/src/Gargantext/API/Admin/Types.hs similarity index 95% rename from src/Gargantext/API/Types.hs rename to src/Gargantext/API/Admin/Types.hs index 659e4a76..10e2490d 100644 --- a/src/Gargantext/API/Types.hs +++ b/src/Gargantext/API/Admin/Types.hs @@ -1,5 +1,5 @@ {-| -Module : Gargantext.API.Types +Module : Gargantext.API.Admin.Types Description : Server API main Types Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 @@ -22,8 +22,8 @@ Portability : POSIX {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -module Gargantext.API.Types - ( module Gargantext.API.Types +module Gargantext.API.Admin.Types + ( module Gargantext.API.Admin.Types , HasServerError(..) , serverError ) @@ -37,9 +37,9 @@ import Crypto.JOSE.Error as Jose import Data.Aeson.Types import Data.Typeable import Data.Validity +import Gargantext.API.Admin.Orchestrator.Types +import Gargantext.API.Admin.Settings import Gargantext.API.Ngrams -import Gargantext.API.Orchestrator.Types -import Gargantext.API.Settings import Gargantext.Core.Types import Gargantext.Database.Action.Query.Tree import Gargantext.Database.Admin.Types.Errors (NodeError(..), HasNodeError(..)) diff --git a/src/Gargantext/API/Utils.hs b/src/Gargantext/API/Admin/Utils.hs similarity index 90% rename from src/Gargantext/API/Utils.hs rename to src/Gargantext/API/Admin/Utils.hs index a46c0d6f..4672a602 100644 --- a/src/Gargantext/API/Utils.hs +++ b/src/Gargantext/API/Admin/Utils.hs @@ -1,5 +1,5 @@ {-| -Module : Gargantext.API.Utils +Module : Gargantext.API.Admin.Utils Description : Server API main Types Copyright : (c) CNRS, 2017-Present License : BSD3 @@ -14,7 +14,7 @@ Mainly copied from Servant.Job.Utils (Thanks) {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} -module Gargantext.API.Utils +module Gargantext.API.Admin.Utils where import Gargantext.Prelude diff --git a/src/Gargantext/API/Application.hs b/src/Gargantext/API/Application.hs deleted file mode 100644 index f3f30ab9..00000000 --- a/src/Gargantext/API/Application.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-| -Module : Gargantext.API.Application -Description : Application of the API -Copyright : (c) CNRS, 2017-Present -License : AGPL + CECILL v3 -Maintainer : team@gargantext.org -Stability : experimental -Portability : POSIX - -Inspired by : http://blog.wuzzeb.org/full-stack-web-haskell/server.html - --} - -{-# OPTIONS_GHC -fno-warn-name-shadowing #-} - -{-# LANGUAGE OverloadedStrings #-} - -module Gargantext.API.Application - where - - - diff --git a/src/Gargantext/API/Annuaire.hs b/src/Gargantext/API/Corpus/Annuaire.hs similarity index 95% rename from src/Gargantext/API/Annuaire.hs rename to src/Gargantext/API/Corpus/Annuaire.hs index 3d6ce1c7..481cb5a4 100644 --- a/src/Gargantext/API/Annuaire.hs +++ b/src/Gargantext/API/Corpus/Annuaire.hs @@ -1,5 +1,5 @@ {-| -Module : Gargantext.API.Annuaire +Module : Gargantext.API.Corpus.Annuaire Description : New annuaire API Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 @@ -17,7 +17,7 @@ Portability : POSIX {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} -module Gargantext.API.Annuaire +module Gargantext.API.Corpus.Annuaire where import Control.Lens hiding (elements) @@ -25,8 +25,7 @@ import Data.Aeson import Data.Swagger import Data.Text (Text) import GHC.Generics (Generic) -import qualified Gargantext.API.Corpus.New.File as NewFile -import Gargantext.API.Orchestrator.Types +import Gargantext.API.Admin.Orchestrator.Types import Gargantext.Core (Lang(..)) import Gargantext.Core.Utils.Prefix (unPrefixSwagger) import Gargantext.Database.Action.Flow (FlowCmdM) -- flowAnnuaire @@ -37,7 +36,8 @@ import Servant.API.Flatten (Flat) import Servant.Job.Core import Servant.Job.Types import Servant.Job.Utils (jsonOptions) -import Web.FormUrlEncoded (FromForm) +import Web.FormUrlEncoded (FromForm) +import qualified Gargantext.API.Corpus.New.File as NewFile type Api = Summary "New Annuaire endpoint" diff --git a/src/Gargantext/API/Export.hs b/src/Gargantext/API/Corpus/Export.hs similarity index 97% rename from src/Gargantext/API/Export.hs rename to src/Gargantext/API/Corpus/Export.hs index f3e603c5..f2e95429 100644 --- a/src/Gargantext/API/Export.hs +++ b/src/Gargantext/API/Corpus/Export.hs @@ -1,5 +1,5 @@ {-| -Module : Gargantext.API.Export +Module : Gargantext.API.Corpus.Export Description : Get Metrics from Storage (Database like) Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 @@ -22,7 +22,7 @@ Main exports of Gargantext: {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} -module Gargantext.API.Export +module Gargantext.API.Corpus.Export where import Data.Aeson.TH (deriveJSON) @@ -34,7 +34,7 @@ import Data.Text (Text) import GHC.Generics (Generic) import Gargantext.API.Ngrams import Gargantext.API.Ngrams.Tools (filterListWithRoot, mapTermListRoot, getRepo) -import Gargantext.API.Types (GargNoServer) +import Gargantext.API.Admin.Types (GargNoServer) import Gargantext.Core.Types -- import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) import Gargantext.Database.Action.Metrics.NgramsByNode (getNgramsByNodeOnlyUser) diff --git a/src/Gargantext/API/Corpus/New.hs b/src/Gargantext/API/Corpus/New.hs index b045019d..be522310 100644 --- a/src/Gargantext/API/Corpus/New.hs +++ b/src/Gargantext/API/Corpus/New.hs @@ -28,20 +28,19 @@ module Gargantext.API.Corpus.New import Control.Lens hiding (elements) import Data.Aeson import Data.Aeson.TH (deriveJSON) -import Data.Maybe (fromMaybe) import Data.Either +import Data.Maybe (fromMaybe) import Data.Swagger import Data.Text (Text) import GHC.Generics (Generic) +import Gargantext.API.Admin.Orchestrator.Types import Gargantext.API.Corpus.New.File -import Gargantext.API.Orchestrator.Types import Gargantext.Core (Lang(..)) +import Gargantext.Core.Types.Individu (UserId, User(..)) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) import Gargantext.Database.Action.Flow (FlowCmdM, flowCorpus, flowCorpusSearchInDatabase) import Gargantext.Database.Admin.Types.Node (CorpusId, ToHyperdataDocument(..)) -import Gargantext.Core.Types.Individu (UserId, User(..)) import Gargantext.Prelude -import qualified Gargantext.Text.Corpus.Parsers as Parser (FileFormat(..), parseFormat) import Gargantext.Text.Terms (TermType(..)) import Servant import Servant.API.Flatten (Flat) @@ -53,6 +52,7 @@ import Test.QuickCheck (elements) import Test.QuickCheck.Arbitrary import Web.FormUrlEncoded (FromForm) import qualified Gargantext.Text.Corpus.API as API +import qualified Gargantext.Text.Corpus.Parsers as Parser (FileFormat(..), parseFormat) ------------------------------------------------------------------------ data Query = Query { query_query :: Text @@ -153,8 +153,10 @@ type AsyncJobs event ctI input output = type Upload = Summary "Corpus Upload endpoint" :> "corpus" :> Capture "corpus_id" CorpusId - :<|> "addWithquery" :> AsyncJobsAPI ScraperStatus WithQuery ScraperStatus - :<|> "addWithfile" :> AsyncJobs ScraperStatus '[FormUrlEncoded] WithForm ScraperStatus + :<|> "addWithquery" + :> AsyncJobsAPI ScraperStatus WithQuery ScraperStatus + :<|> "addWithfile" + :> AsyncJobs ScraperStatus '[FormUrlEncoded] WithForm ScraperStatus type AddWithQuery = Summary "Add with Query to corpus endpoint" :> "corpus" diff --git a/src/Gargantext/API/Ngrams/List.hs b/src/Gargantext/API/Ngrams/List.hs index f47abda4..814b289c 100644 --- a/src/Gargantext/API/Ngrams/List.hs +++ b/src/Gargantext/API/Ngrams/List.hs @@ -33,8 +33,8 @@ import GHC.Generics (Generic) import Gargantext.API.Corpus.New import Gargantext.API.Corpus.New.File (FileType(..)) import Gargantext.API.Ngrams -import Gargantext.API.Orchestrator.Types -import Gargantext.API.Types (GargServer) +import Gargantext.API.Admin.Orchestrator.Types +import Gargantext.API.Admin.Types (GargServer) import Gargantext.Core.Utils.Prefix (unPrefixSwagger) import Gargantext.Database.Action.Flow (FlowCmdM) import Gargantext.Database.Admin.Types.Node diff --git a/src/Gargantext/API/Node.hs b/src/Gargantext/API/Node.hs index 8e47e943..090b7c08 100644 --- a/src/Gargantext/API/Node.hs +++ b/src/Gargantext/API/Node.hs @@ -44,22 +44,22 @@ import Data.Swagger import Data.Text (Text()) import Data.Time (UTCTime) import GHC.Generics (Generic) -import Gargantext.API.Auth (withAccess, PathId(..)) +import Gargantext.API.Admin.Auth (withAccess, PathId(..)) +import Gargantext.API.Admin.Types import Gargantext.API.Metrics import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus, QueryParamR) import Gargantext.API.Ngrams.NTree (MyTree) import Gargantext.API.Search (SearchDocsAPI, searchDocs, SearchPairsAPI, searchPairs) import Gargantext.API.Table -import Gargantext.API.Types import Gargantext.Core.Types (NodeTableResult) import Gargantext.Core.Types.Main (Tree, NodeTree, ListType) -import Gargantext.Database.Action.Query.Facet (FacetDoc, OrderBy(..)) import Gargantext.Database.Action.Flow.Pairing (pairing) +import Gargantext.Database.Action.Query +import Gargantext.Database.Action.Query.Facet (FacetDoc, OrderBy(..)) +import Gargantext.Database.Action.Query.Node hiding (postNode) import Gargantext.Database.Action.Query.Node.Children (getChildren) import Gargantext.Database.Action.Query.Node.UpdateOpaleye (updateHyperdata) import Gargantext.Database.Action.Query.Node.User -import Gargantext.Database.Action.Query.Node hiding (postNode) -import Gargantext.Database.Action.Query import Gargantext.Database.Action.Query.Tree (treeDB) import Gargantext.Database.Admin.Config (nodeTypeId) import Gargantext.Database.Admin.Types.Errors (HasNodeError(..)) diff --git a/src/Gargantext/API/Search.hs b/src/Gargantext/API/Search.hs index 9d48fa02..172c9bb5 100644 --- a/src/Gargantext/API/Search.hs +++ b/src/Gargantext/API/Search.hs @@ -30,7 +30,7 @@ import Data.Swagger import Data.Text (Text) import Data.Time (UTCTime) import GHC.Generics (Generic) -import Gargantext.API.Types (GargServer) +import Gargantext.API.Admin.Types (GargServer) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) import Gargantext.Database.Action.Query.Facet import Gargantext.Database.Action.Search diff --git a/src/Gargantext/Prelude/Utils.hs b/src/Gargantext/Prelude/Utils.hs index c35cab71..bbca9ec6 100644 --- a/src/Gargantext/Prelude/Utils.hs +++ b/src/Gargantext/Prelude/Utils.hs @@ -26,7 +26,7 @@ import Data.ByteString.Base64.URL as URL import Data.Either import Data.Text (Text) import GHC.IO (FilePath) -import Gargantext.API.Settings +import Gargantext.API.Admin.Settings import Gargantext.Database.Admin.Types.Node (NodeId, NodeType) import Gargantext.Prelude import System.Directory (createDirectoryIfMissing) diff --git a/src/Gargantext/Text/Corpus/API.hs b/src/Gargantext/Text/Corpus/API.hs index 6b17c93f..d09ee525 100644 --- a/src/Gargantext/Text/Corpus/API.hs +++ b/src/Gargantext/Text/Corpus/API.hs @@ -24,15 +24,14 @@ module Gargantext.Text.Corpus.API where import Data.Maybe -import Gargantext.Prelude +import Gargantext.API.Admin.Orchestrator.Types (ExternalAPIs(..), externalAPIs) import Gargantext.Core (Lang(..)) -import Gargantext.API.Orchestrator.Types (ExternalAPIs(..), externalAPIs) import Gargantext.Database.Admin.Types.Node (HyperdataDocument(..)) - -import qualified Gargantext.Text.Corpus.API.Pubmed as PUBMED -import qualified Gargantext.Text.Corpus.API.Isidore as ISIDORE +import Gargantext.Prelude import qualified Gargantext.Text.Corpus.API.Hal as HAL +import qualified Gargantext.Text.Corpus.API.Isidore as ISIDORE import qualified Gargantext.Text.Corpus.API.Istex as ISTEX +import qualified Gargantext.Text.Corpus.API.Pubmed as PUBMED -- | Get External API metadata main function get :: ExternalAPIs -> Query -> Maybe Limit -> IO [HyperdataDocument] diff --git a/src/Gargantext/Text/List/Learn.hs b/src/Gargantext/Text/List/Learn.hs index aaf21d7e..50a56e5d 100644 --- a/src/Gargantext/Text/List/Learn.hs +++ b/src/Gargantext/Text/List/Learn.hs @@ -21,7 +21,8 @@ module Gargantext.Text.List.Learn where import Control.Monad.Reader (MonadReader) -import Gargantext.API.Settings +-- TODO remvoe this deps +import Gargantext.API.Admin.Settings import Data.Map (Map) import Data.Maybe (maybe) import Gargantext.Core.Types.Main (ListType(..), listTypeId, fromListTypeId) diff --git a/src/Gargantext/Viz/Graph/API.hs b/src/Gargantext/Viz/Graph/API.hs index f9849c85..e150a095 100644 --- a/src/Gargantext/Viz/Graph/API.hs +++ b/src/Gargantext/Viz/Graph/API.hs @@ -41,8 +41,8 @@ import qualified Xmlbf as Xmlbf import Gargantext.API.Ngrams (NgramsRepo, r_version) import Gargantext.API.Ngrams.Tools -import Gargantext.API.Orchestrator.Types -import Gargantext.API.Types +import Gargantext.API.Admin.Orchestrator.Types +import Gargantext.API.Admin.Types import Gargantext.Core.Types.Main import Gargantext.Database.Admin.Config import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsOnlyUser) diff --git a/src/Gargantext/Viz/Phylo/API.hs b/src/Gargantext/Viz/Phylo/API.hs index 6c8ccaa0..6cfeabd0 100644 --- a/src/Gargantext/Viz/Phylo/API.hs +++ b/src/Gargantext/Viz/Phylo/API.hs @@ -29,7 +29,7 @@ import Data.String.Conversions import qualified Data.ByteString as DB import qualified Data.ByteString.Lazy as DBL import Data.Swagger -import Gargantext.API.Types +import Gargantext.API.Admin.Types import Gargantext.Database.Action.Query.Node (insertNodes, nodePhyloW, getNodePhylo) import Gargantext.Database.Admin.Types.Node -- (PhyloId, ListId, CorpusId, UserId, NodeId(..)) import Gargantext.Prelude -- 2.47.0