Commit 4ef66cea authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge remote-tracking branch 'origin/dev-typeclasses-refactoring' into dev

parents aa230640 a2e7a40c
......@@ -56,9 +56,9 @@ import Gargantext.API.Ngrams (saveNodeStoryImmediate)
import Gargantext.API.Routes
import Gargantext.API.Server (server)
import Gargantext.Core.NodeStory
-- import Gargantext.Database.Prelude (Cmd)
-- import Gargantext.Database.Action.Metrics.NgramsByContext (refreshNgramsMaterialized)
import Gargantext.Database.Prelude qualified as DB
import Gargantext.Prelude hiding (putStrLn)
import Gargantext.System.Logging
import Network.HTTP.Types hiding (Query)
import Network.Wai
import Network.Wai.Handler.Warp hiding (defaultSettings)
......@@ -66,10 +66,8 @@ import Network.Wai.Middleware.Cors
import Network.Wai.Middleware.RequestLogger
import Paths_gargantext (getDataDir)
import Servant
import System.Cron.Schedule qualified as Cron
import System.FilePath
import qualified Gargantext.Database.Prelude as DB
import qualified System.Cron.Schedule as Cron
import Gargantext.System.Logging
-- | startGargantext takes as parameters port number and Ini file.
startGargantext :: Mode -> PortNumber -> FilePath -> IO ()
......
......@@ -58,7 +58,7 @@ import Gargantext.Core.Mail.Types (mailSettings)
import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..))
import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Admin.Types.Node (NodeId(..))
import Gargantext.Database.Prelude (Cmd', CmdM, CmdCommon)
import Gargantext.Database.Prelude (Cmd', CmdCommon, DbCmd')
import Gargantext.Database.Query.Table.User
import Gargantext.Database.Query.Tree (isDescendantOf, isIn)
import Gargantext.Database.Query.Tree.Root (getRoot)
......@@ -79,7 +79,8 @@ import Gargantext.API.Auth.PolicyCheck
-- | Main functions of authorization
makeTokenForUser :: (HasSettings env, HasJoseError err)
makeTokenForUser :: ( HasSettings env
, HasJoseError err )
=> NodeId -> Cmd' env err Token
makeTokenForUser uid = do
jwtS <- view $ settings . jwtSettings
......@@ -88,10 +89,10 @@ makeTokenForUser uid = do
either joseError (pure . toStrict . LE.decodeUtf8) e
-- TODO not sure about the encoding...
checkAuthRequest :: ( HasSettings env, CmdCommon env, HasJoseError err)
checkAuthRequest :: ( HasSettings env, HasJoseError err, DbCmd' env err m )
=> Username
-> GargPassword
-> Cmd' env err CheckAuth
-> m CheckAuth
checkAuthRequest couldBeEmail (GargPassword p) = do
-- Sometimes user put email instead of username
-- hence we have to check before
......@@ -113,8 +114,8 @@ checkAuthRequest couldBeEmail (GargPassword p) = do
token <- makeTokenForUser uid
pure $ Valid token uid userLight_id
auth :: (HasSettings env, CmdCommon env, HasJoseError err)
=> AuthRequest -> Cmd' env err AuthResponse
auth :: (HasSettings env, HasJoseError err, DbCmd' env err m)
=> AuthRequest -> m AuthResponse
auth (AuthRequest u p) = do
checkAuthRequest' <- checkAuthRequest u p
case checkAuthRequest' of
......@@ -135,7 +136,7 @@ authCheck _env (BasicAuthData login password) = pure $
maybe Indefinite Authenticated $ TODO
-}
withAccessM :: (CmdM env err m, HasServerError err)
withAccessM :: ( DbCmd' env err m )
=> AuthenticatedUser
-> PathId
-> m a
......@@ -143,7 +144,6 @@ withAccessM :: (CmdM env err m, HasServerError err)
withAccessM (AuthenticatedUser uId) (PathNode id) m = do
d <- id `isDescendantOf` uId
if d then m else m -- serverError err401
withAccessM (AuthenticatedUser uId) (PathNodeNode cId docId) m = do
_a <- isIn cId docId -- TODO use one query for all ?
_d <- cId `isDescendantOf` uId
......
......@@ -25,7 +25,7 @@ import Gargantext.API.Admin.Auth (withAccess)
import Gargantext.API.Admin.Auth.Types (PathId(..), AuthenticatedUser)
import Gargantext.API.Prelude
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude -- (Cmd, CmdM)
import Gargantext.Database.Prelude (JSONB)
import Gargantext.Database.Query.Table.Context
-------------------------------------------------------------------
......
......@@ -14,22 +14,22 @@ module Gargantext.API.Dev where
import Control.Exception (finally)
import Control.Monad (fail)
import Control.Monad.Reader (runReaderT)
import Control.Monad.Except (runExceptT)
import Control.Monad.Reader (runReaderT)
import Gargantext.API.Admin.EnvTypes
import Gargantext.API.Admin.Settings
import Gargantext.API.Ngrams (saveNodeStoryImmediate)
import Gargantext.API.Prelude
import Gargantext.Core.NLP (nlpServerMap)
import Gargantext.Core.NodeStory
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (Cmd', Cmd'', databaseParameters, runCmd)
import Gargantext.Prelude
import Gargantext.Prelude.Config (readConfig)
import qualified Gargantext.Prelude.Mail as Mail
import qualified Gargantext.Prelude.NLP as NLP
import Gargantext.Prelude.Mail qualified as Mail
import Gargantext.Prelude.NLP qualified as NLP
import Gargantext.System.Logging
import Servant
import System.IO (FilePath)
import Gargantext.System.Logging
type IniPath = FilePath
-------------------------------------------------------------------
......
......@@ -211,8 +211,8 @@ toHyperdataRowDocumentGQL hyperdata =
}
HyperdataRowContact { } -> Nothing
updateNodeContextCategory :: ( CmdCommon env, HasSettings env) =>
NodeContextCategoryMArgs -> GqlM' e env [Int]
updateNodeContextCategory :: (CmdCommon env, HasSettings env)
=> NodeContextCategoryMArgs -> GqlM' e env [Int]
updateNodeContextCategory NodeContextCategoryMArgs { context_id, node_id, category } = do
_ <- lift $ DNC.updateNodeContextCategory (NodeId context_id) (NodeId node_id) category
......
......@@ -8,7 +8,7 @@ import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Auth.PolicyCheck
import Gargantext.API.GraphQL.Types
import Gargantext.API.Prelude
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
withPolicy :: (HasConnectionPool env, HasConfig env)
=> AuthenticatedUser
......
......@@ -4,24 +4,21 @@
module Gargantext.API.GraphQL.User where
import Data.Maybe (listToMaybe)
import Data.Morpheus.Types
( GQLType
, lift
)
import Data.Morpheus.Types ( GQLType , lift )
import Data.Text (Text)
import GHC.Generics (Generic)
import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Auth.PolicyCheck
import Gargantext.API.GraphQL.PolicyCheck
import Gargantext.API.GraphQL.Types
import Gargantext.Core.Types.Individu qualified as Individu
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..))
import Gargantext.Database.Admin.Types.Node (NodeId(..))
import Gargantext.Database.Prelude (CmdCommon)
import Gargantext.Database.Query.Table.User qualified as DBUser
import Gargantext.Database.Schema.User (UserLight(..))
import Gargantext.Prelude
import qualified Gargantext.Core.Types.Individu as Individu
import qualified Gargantext.Database.Query.Table.User as DBUser
import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Auth.PolicyCheck
import Gargantext.API.GraphQL.PolicyCheck
data User m = User
{ u_email :: Text
......@@ -54,9 +51,8 @@ resolveUsers autUser mgr UserArgs { user_id } = do
withPolicy autUser mgr alwaysAllow $ dbUsers user_id
-- | Inner function to fetch the user from DB.
dbUsers
:: (CmdCommon env)
=> Int -> GqlM e env [User (GqlM e env)]
dbUsers :: (CmdCommon env)
=> Int -> GqlM e env [User (GqlM e env)]
dbUsers user_id = lift (map toUser <$> DBUser.getUsersWithId (Individu.RootId $ NodeId user_id))
toUser
......
......@@ -35,7 +35,7 @@ import Gargantext.Core.Viz.Types
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataList(..), hl_chart, hl_pie, hl_scatter, hl_tree)
import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metric(..), Metrics(..))
import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (DBCmd)
import Gargantext.Database.Query.Table.Node (defaultList, getNodeWith)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
......@@ -185,12 +185,12 @@ getChart cId _start _end maybeListId tabType = do
pure $ constructHashedResponse chart
updateChart :: HasNodeError err =>
CorpusId
-> Maybe ListId
-> TabType
-> Maybe Limit
-> DBCmd err ()
updateChart :: HasNodeError err
=> CorpusId
-> Maybe ListId
-> TabType
-> Maybe Limit
-> DBCmd err ()
updateChart cId maybeListId tabType maybeLimit = do
listId <- case maybeListId of
Just lid -> pure lid
......@@ -202,12 +202,12 @@ updateChart cId maybeListId tabType maybeLimit = do
_ <- updateChart' cId listId tabType maybeLimit
pure ()
updateChart' :: HasNodeError err =>
CorpusId
-> ListId
-> TabType
-> Maybe Limit
-> DBCmd err (ChartMetrics Histo)
updateChart' :: HasNodeError err
=> CorpusId
-> ListId
-> TabType
-> Maybe Limit
-> DBCmd err (ChartMetrics Histo)
updateChart' cId listId tabType _maybeLimit = do
node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let hl = node ^. node_hyperdata
......@@ -267,7 +267,7 @@ getPie cId _start _end maybeListId tabType = do
chart <- case mChart of
Just chart -> pure chart
Nothing -> do
updatePie' cId maybeListId tabType Nothing
updatePie' cId listId tabType Nothing
pure $ constructHashedResponse chart
......@@ -278,23 +278,23 @@ updatePie :: HasNodeStory env err m
-> Maybe Limit
-> m ()
updatePie cId maybeListId tabType maybeLimit = do
listId <- case maybeListId of
Just lid -> pure lid
Nothing -> defaultList cId
printDebug "[updatePie] cId" cId
printDebug "[updatePie] maybeListId" maybeListId
printDebug "[updatePie] tabType" tabType
printDebug "[updatePie] maybeLimit" maybeLimit
_ <- updatePie' cId maybeListId tabType maybeLimit
_ <- updatePie' cId listId tabType maybeLimit
pure ()
updatePie' :: (HasNodeStory env err m, HasNodeError err)
=> CorpusId
-> Maybe ListId
-> ListId
-> TabType
-> Maybe Limit
-> m (ChartMetrics Histo)
updatePie' cId maybeListId tabType _maybeLimit = do
listId <- case maybeListId of
Just lid -> pure lid
Nothing -> defaultList cId
updatePie' cId listId tabType _maybeLimit = do
node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let hl = node ^. node_hyperdata
pieMap = hl ^. hl_pie
......
This diff is collapsed.
......@@ -16,12 +16,18 @@ Portability : POSIX
module Gargantext.API.Ngrams.List
where
import Data.ByteString.Lazy qualified as BSL
import Data.Csv qualified as Csv
import Data.Either (Either(..))
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.Map.Strict (Map, toList)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe)
import Data.Set qualified as Set
import Data.Text (Text, concat, pack, splitOn)
import Data.Vector (Vector)
import Data.Vector qualified as Vec
import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Ngrams (setListNgrams)
......@@ -34,25 +40,18 @@ import Gargantext.Core.NodeStory
import Gargantext.Core.Types.Main (ListType(..))
import Gargantext.Database.Action.Flow (reIndexWith)
import Gargantext.Database.Action.Flow.Types (FlowCmdM)
-- import Gargantext.Database.Action.Metrics.NgramsByContext (refreshNgramsMaterialized)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Query.Table.Ngrams qualified as TableNgrams
import Gargantext.Database.Query.Table.Node (getNode)
import Gargantext.Database.Schema.Ngrams
import Gargantext.Database.Schema.Node (_node_parent_id)
import Gargantext.Database.Types (Indexed(..))
import Gargantext.Prelude
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Gargantext.Utils.Servant qualified as GUS
import Prelude qualified
import Protolude qualified as P
import Servant
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Csv as Csv
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Vector as Vec
import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
import qualified Gargantext.Utils.Servant as GUS
import qualified Prelude
import qualified Protolude as P
------------------------------------------------------------------------
type GETAPI = Summary "Get List"
:> "lists"
......@@ -120,10 +119,10 @@ getCsv lId = do
------------------------------------------------------------------------
-- TODO : purge list
-- TODO talk
setList :: FlowCmdM env err m
=> ListId
-> NgramsList
-> m Bool
setList :: HasNodeStory env err m
=> ListId
-> NgramsList
-> m Bool
setList l m = do
-- TODO check with Version for optim
-- printDebug "New list as file" l
......@@ -197,7 +196,7 @@ parseCsvData lst = Map.fromList $ conv <$> lst
}
)
csvPost :: FlowCmdM env err m
csvPost :: HasNodeStory env err m
=> ListId
-> Text
-> m (Either Text ())
......@@ -236,7 +235,7 @@ csvPostAsync lId =
-- | This is for debugging the CSV parser in the REPL
importCsvFile :: FlowCmdM env err m
importCsvFile :: (HasNodeStory env err m)
=> ListId -> P.FilePath -> m (Either Text ())
importCsvFile lId fp = do
contents <- liftBase $ P.readFile fp
......
......@@ -36,7 +36,7 @@ import qualified Data.Text as Text
------------------------------------------------------------------------
getNgramsList :: HasNodeStory env err m
=> ListId -> m NgramsList
=> ListId -> m NgramsList
getNgramsList lId = fromList
<$> zip ngramsTypes
<$> mapM (getNgramsTableMap lId) ngramsTypes
......
......@@ -25,7 +25,7 @@ import Data.Validity
import Gargantext.API.Ngrams.Types
import Gargantext.Core.NodeStory
import Gargantext.Core.Types (ListType(..), NodeId, NodeType(..), ListId)
import Gargantext.Database.Prelude (CmdM, HasConnectionPool(..))
import Gargantext.Database.Prelude (HasConnectionPool(..))
import Gargantext.Database.Schema.Ngrams (NgramsType)
import Gargantext.Prelude
import qualified Data.HashMap.Strict as HM
......@@ -229,7 +229,7 @@ getCoocByNgrams'' (Diagonal diag) (f1,f2) (m1,m2) =
------------------------------------------
migrateFromDirToDb :: (CmdM env err m) -- , HasNodeStory env err m)
migrateFromDirToDb :: (HasNodeStory env err m) -- , HasNodeStory env err m)
=> m ()
migrateFromDirToDb = do
pool <- view connPool
......
......@@ -37,12 +37,19 @@ import GHC.Generics (Generic)
import Gargantext.API.Admin.Auth (withAccess, withPolicy)
import Gargantext.API.Admin.Auth.Types (PathId(..), AuthenticatedUser (..))
import Gargantext.API.Admin.EnvTypes
import Gargantext.API.Auth.PolicyCheck
import Gargantext.API.Metrics
import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableCorpus)
import Gargantext.API.Ngrams.Types (TabType(..))
import Gargantext.API.Node.DocumentUpload qualified as DocumentUpload
import Gargantext.API.Node.DocumentsFromWriteNodes qualified as DocumentsFromWriteNodes
import Gargantext.API.Node.File
import Gargantext.API.Node.FrameCalcUpload qualified as FrameCalcUpload
import Gargantext.API.Node.New
import Gargantext.API.Node.Share qualified as Share
import Gargantext.API.Node.Update qualified as Update
import Gargantext.API.Prelude
import Gargantext.API.Search qualified as Search
import Gargantext.API.Table
import Gargantext.Core.Types (NodeTableResult)
import Gargantext.Core.Types.Individu (User(..))
......@@ -50,15 +57,17 @@ import Gargantext.Core.Types.Main (Tree, NodeTree)
import Gargantext.Core.Types.Query (Limit, Offset)
import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Core.Viz.Phylo.API (PhyloAPI, phyloAPI)
import Gargantext.Database.Action.Delete qualified as Action (deleteNode)
import Gargantext.Database.Action.Flow.Pairing (pairing)
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude -- (Cmd, CmdM)
import Gargantext.Database.Prelude (Cmd, JSONB)
import Gargantext.Database.Query.Facet (FacetDoc, OrderBy(..))
import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Children (getChildren)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
import Gargantext.Database.Query.Table.Node.Update qualified as U (update, Update(..))
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Query.Table.NodeContext (nodeContextsCategory, nodeContextsScore)
import Gargantext.Database.Query.Table.NodeNode
......@@ -67,15 +76,6 @@ import Gargantext.Prelude
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import qualified Gargantext.API.Node.DocumentUpload as DocumentUpload
import qualified Gargantext.API.Node.DocumentsFromWriteNodes as DocumentsFromWriteNodes
import qualified Gargantext.API.Node.FrameCalcUpload as FrameCalcUpload
import qualified Gargantext.API.Node.Share as Share
import qualified Gargantext.API.Node.Update as Update
import qualified Gargantext.API.Search as Search
import qualified Gargantext.Database.Action.Delete as Action (deleteNode)
import qualified Gargantext.Database.Query.Table.Node.Update as U (update, Update(..))
import Gargantext.API.Auth.PolicyCheck
-- | Admin NodesAPI
......
......@@ -16,24 +16,21 @@ Main exports of Gargantext:
module Gargantext.API.Node.Corpus.Export
where
import Data.HashMap.Strict qualified as HashMap
import Data.List qualified as List
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text, pack)
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.HashMap.Strict as HashMap
import Servant (Headers, Header, addHeader)
import Gargantext.API.Node.Corpus.Export.Types
import qualified Gargantext.API.Node.Document.Export.Types as DocumentExport
import Gargantext.API.Ngrams.Types
import Gargantext.API.Ngrams.Tools (filterListWithRoot, mapTermListRoot, getRepo)
import Gargantext.API.Ngrams.Types
import Gargantext.API.Node.Corpus.Export.Types
import Gargantext.API.Node.Document.Export.Types qualified as DocumentExport
import Gargantext.API.Prelude (GargNoServer)
import Gargantext.Prelude.Crypto.Hash (hash)
import Gargantext.Core.Types
import Gargantext.Core.NodeStory
import Gargantext.Core.Types
import Gargantext.Database.Action.Metrics.NgramsByContext (getNgramsByContextOnlyUser)
import Gargantext.Database.Admin.Config (userMaster)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
......@@ -42,9 +39,11 @@ import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.Node.Select (selectNodesWithUsername)
import Gargantext.Database.Query.Table.NodeContext (selectDocNodes)
import Gargantext.Database.Schema.Ngrams (NgramsType(..))
import Gargantext.Database.Schema.Context (_context_id, _context_hyperdata)
import Gargantext.Database.Schema.Ngrams (NgramsType(..))
import Gargantext.Prelude
import Gargantext.Prelude.Crypto.Hash (hash)
import Servant (Headers, Header, addHeader)
--------------------------------------------------
-- | Hashes are ordered by Set
......
......@@ -32,7 +32,7 @@ import Servant.Swagger.Internal
import Gargantext.API.Node.Corpus.New.Types
import Gargantext.Core.Types (TODO)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude -- (Cmd, CmdM)
import Gargantext.Database.Prelude (Cmd)
import Gargantext.Prelude
import Gargantext.Prelude.Crypto.Hash (hash)
......
......@@ -3,43 +3,46 @@
module Gargantext.API.Node.Corpus.Searx where
import Control.Lens (view)
import Data.Aeson qualified as Aeson
import Data.Aeson.TH (deriveJSON)
import Data.Either (Either(..))
import Data.HashMap.Strict qualified as HashMap
import Data.Text qualified as T
import Data.Text qualified as Text
import Data.Time.Calendar (Day, toGregorian)
import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM)
import Data.Tuple.Select (sel1, sel2, sel3)
import GHC.Generics (Generic)
import Gargantext.Core (Lang(..))
import Gargantext.Core.NLP (nlpServerGet)
import Gargantext.Core.NLP (HasNLPServer, nlpServerGet)
import Gargantext.Core.NodeStory (HasNodeStory)
import Gargantext.Core.Text.Corpus.API qualified as API
import Gargantext.Core.Text.List (buildNgramsLists)
import Gargantext.Core.Text.List.Group.WithStem ({-StopSize(..),-} GroupParams(..))
import Gargantext.Core.Text.Terms (TermType(..))
import Gargantext.Core.Types (HasInvalidError)
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Database.Action.Flow (addDocumentsToHyperCorpus) --, DataText(..))
import Gargantext.Database.Action.Flow.List (flowList_DbRepo)
import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Action.User (getUserId)
import Gargantext.Database.Admin.Config (userMaster)
import Gargantext.Database.Query.Table.Node (insertDefaultNodeIfNotExists)
import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus)
import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..))
import Gargantext.Database.Admin.Types.Node (CorpusId, ListId, NodeType(NodeTexts))
import Gargantext.Database.Prelude (hasConfig)
import Gargantext.Database.Query.Table.Node (defaultListMaybe, getOrMkList)
import Gargantext.Database.Query.Table.Node (getOrMkList)
import Gargantext.Database.Query.Table.Node (insertDefaultNodeIfNotExists)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Tree.Error (HasTreeError)
import Gargantext.Database.Query.Tree.Root (getOrMk_RootWithCorpus)
import Gargantext.Prelude
import Gargantext.Prelude.Config
import Gargantext.Utils.Jobs (JobHandle, MonadJobStatus(..))
import Network.HTTP.Client
import Network.HTTP.Client.TLS
import Prelude qualified
import Protolude (catMaybes, encodeUtf8, rightToMaybe, Text, void)
import qualified Data.Aeson as Aeson
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as T
import qualified Data.Text as Text
import qualified Gargantext.Core.Text.Corpus.API as API
import qualified Prelude
langToSearx :: Lang -> Text
langToSearx All = "en-US"
......@@ -108,7 +111,12 @@ fetchSearxPage (FetchSearxParams { _fsp_language
let dec = Aeson.eitherDecode $ responseBody res :: (Either Prelude.String SearxResponse)
pure dec
insertSearxResponse :: (MonadBase IO m, FlowCmdM env err m)
insertSearxResponse :: ( MonadBase IO m
, HasNodeStory env err m
, HasNLPServer env
, HasNodeError err
, HasTreeError err
, HasInvalidError err )
=> User
-> CorpusId
-> ListId
......@@ -145,13 +153,19 @@ insertSearxResponse user cId listId l (Right (SearxResponse { _srs_results })) =
pure ()
-- TODO Make an async task out of this?
triggerSearxSearch :: (MonadBase IO m, FlowCmdM env err m, MonadJobStatus m)
=> User
-> CorpusId
-> API.RawQuery
-> Lang
-> JobHandle m
-> m ()
triggerSearxSearch :: ( MonadBase IO m
, HasNodeStory env err m
, HasNLPServer env
, HasNodeError err
, HasTreeError err
, HasInvalidError err
, MonadJobStatus m )
=> User
-> CorpusId
-> API.RawQuery
-> Lang
-> JobHandle m
-> m ()
triggerSearxSearch user cId q l jobHandle = do
userId <- getUserId user
......@@ -167,12 +181,7 @@ triggerSearxSearch user cId q l jobHandle = do
uId <- getUserId user
let surl = _gc_frame_searx_url cfg
-- printDebug "[triggerSearxSearch] surl" surl
mListId <- defaultListMaybe cId
listId <- case mListId of
Nothing -> do
listId <- getOrMkList cId uId
pure listId
Just listId -> pure listId
listId <- getOrMkList cId uId
-- printDebug "[triggerSearxSearch] listId" listId
......
......@@ -9,7 +9,7 @@ import Data.Proxy
import Gargantext.Core
import Gargantext.Database.Admin.Types.Hyperdata.Corpus
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (DbCmd')
import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
......
......@@ -36,7 +36,7 @@ import Gargantext.API.Prelude
import Gargantext.Database.Action.Flow.Types
import Gargantext.Database.Action.Node
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (Cmd)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Query.Table.Node.User
import Gargantext.Database.Schema.Node
......
......@@ -27,7 +27,7 @@ import Gargantext.Database.Action.Share as DB (shareNodeWith, unPublish)
import Gargantext.Database.Action.User
import Gargantext.Database.Action.User.New
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (CmdRandom)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Query.Tree (findNodesWithType)
import Gargantext.Prelude
......
......@@ -25,31 +25,31 @@ import Control.Exception (Exception)
import Control.Lens (Prism', (#))
import Control.Lens.TH (makePrisms)
import Control.Monad (mapM_)
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.Except (ExceptT)
import Control.Monad.Reader (ReaderT)
import Control.Monad.Error.Class (MonadError(..))
import Crypto.JOSE.Error as Jose
import Data.Aeson.Types
import qualified Data.Text as Text
import Data.Typeable
import Data.Validity
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Admin.Types
import Gargantext.Core.Mail.Types (HasMail)
import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.NodeStory
import Gargantext.Core.Mail.Types (HasMail)
import Gargantext.Core.Types
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (CmdM, CmdRandom, HasConnectionPool, HasConfig)
import Gargantext.Database.Query.Table.Node.Error (NodeError(..), HasNodeError(..))
import Gargantext.Database.Query.Tree
import Gargantext.Prelude
import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..), JobHandle)
import qualified Gargantext.Utils.Jobs.Monad as Jobs
import Gargantext.System.Logging
import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..), JobHandle)
import Gargantext.Utils.Jobs.Monad qualified as Jobs
import Servant
import Servant.Job.Async
import Servant.Job.Core (HasServerError(..), serverError)
import qualified Servant.Job.Types as SJ
import Gargantext.System.Logging
import Servant.Job.Types qualified as SJ
import qualified Data.Text as Text
class HasJoseError e where
_JoseError :: Prism' e Jose.Error
......
......@@ -34,7 +34,7 @@ import qualified Data.Set as Set
import Gargantext.API.Prelude
import Gargantext.API.Node.File
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (Cmd, DBCmd)
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Hyperdata.CorpusField
import Gargantext.Database.Admin.Types.Node
......@@ -79,7 +79,7 @@ api_node nId = do
selectPublic :: HasNodeError err
=> Cmd err [( Node HyperdataFolder, Maybe Int)]
=> DBCmd err [( Node HyperdataFolder, Maybe Int)]
selectPublic = selectPublicNodes
-- For tests only
......
......@@ -35,12 +35,8 @@ import Data.Aeson.TH (deriveJSON)
import Data.Maybe
import Data.Swagger
import Data.Text (Text())
import Data.Text qualified as T
import GHC.Generics (Generic)
import Prelude
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import Gargantext.API.HashedResponse
import Gargantext.API.Ngrams.Types (TabType(..))
import Gargantext.API.Prelude (GargServer)
......@@ -51,12 +47,15 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Database.Action.Learn (FavOrTrash(..), moreLike)
import Gargantext.Database.Action.Search
import Gargantext.Database.Admin.Types.Node hiding (ERROR, DEBUG)
import Gargantext.Database.Prelude -- (Cmd, CmdM)
import Gargantext.Database.Prelude (CmdM, DbCmd', DBCmd)
import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, runCountDocuments, OrderBy(..), runViewAuthorsDoc)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Prelude
import Gargantext.System.Logging
import qualified Data.Text as T
import Prelude
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
------------------------------------------------------------------------
......@@ -156,7 +155,7 @@ getTableHashApi cId tabType = do
HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing
pure h
searchInCorpus' :: (CmdM env err m, MonadLogger m)
searchInCorpus' :: (DbCmd' env err m, MonadLogger m)
=> CorpusId
-> Bool
-> RawQuery
......@@ -185,7 +184,7 @@ getTable :: HasNodeError err
-> Maybe OrderBy
-> Maybe RawQuery
-> Maybe Text
-> Cmd err FacetTableResult
-> DBCmd err FacetTableResult
getTable cId ft o l order raw_query year = do
docs <- getTable' cId ft o l order query year
docsCount <- runCountDocuments cId (ft == Just Trash) query year
......@@ -201,7 +200,7 @@ getTable' :: HasNodeError err
-> Maybe OrderBy
-> Maybe Text
-> Maybe Text
-> Cmd err [FacetDoc]
-> DBCmd err [FacetDoc]
getTable' cId ft o l order query year =
case ft of
(Just Docs) -> runViewDocuments cId False o l order query year
......@@ -213,7 +212,7 @@ getTable' cId ft o l order query year =
getPair :: ContactId -> Maybe TabType
-> Maybe Offset -> Maybe Limit
-> Maybe OrderBy -> Cmd err [FacetDoc]
-> Maybe OrderBy -> DBCmd err [FacetDoc]
getPair cId ft o l order =
case ft of
(Just Docs) -> runViewAuthorsDoc cId False o l order
......
......@@ -14,16 +14,16 @@ module Gargantext.Core.Mail where
import Control.Lens (view)
import Control.Monad.Reader (MonadReader)
import Control.Monad.Trans.Control (MonadBaseControl)
import Network.URI.Encode (encodeText)
import Data.List qualified as List
import Data.Text (Text, unlines, splitOn)
import Gargantext.Core.Types.Individu
import Gargantext.Database.Prelude (HasConfig(..))
import Gargantext.Database.Schema.User (UserLight(..))
import Gargantext.Prelude
import Gargantext.Prelude.Config (gc_url, gc_backend_name)
import Gargantext.Database.Prelude
import Gargantext.Prelude.Mail (gargMail, GargMail(..))
import Gargantext.Prelude.Mail.Types (MailConfig)
import qualified Data.List as List
import Network.URI.Encode (encodeText)
-- | Tool to put elsewhere
......
......@@ -23,7 +23,7 @@ import Control.Concurrent (MVar(), modifyMVar_, newMVar, readMVar, withMVar)
import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceFreq, debounceAction)
import Gargantext.Core.NodeStory hiding (readNodeStoryEnv)
import Gargantext.Core.Types (ListId, NodeId(..))
import Gargantext.Database.Prelude (CmdM, hasConfig)
import Gargantext.Database.Prelude (hasConfig)
import Gargantext.Prelude
import Gargantext.Prelude.Config (gc_repofilepath)
import System.Directory (renameFile, createDirectoryIfMissing, doesFileExist, removeFile)
......@@ -46,7 +46,7 @@ getRepo listIds = do
-- v' <- liftBase $ readMVar v
-- pure $ v'
getRepoReadConfig :: (CmdM env err m)
getRepoReadConfig :: (HasNodeStory env err m)
=> [ListId] -> m NodeListStory
getRepoReadConfig listIds = do
repoFP <- view $ hasConfig . gc_repofilepath
......
......@@ -18,14 +18,19 @@ module Gargantext.Core.Text.List
import Control.Lens hiding (both) -- ((^.), view, over, set, (_1), (_2))
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.HashSet (HashSet)
import Data.HashSet qualified as HashSet
import Data.List qualified as List
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Monoid (mempty)
import Data.Ord (Down(..))
import Data.Set (Set)
-- import Data.Text (Text)
import Data.Set qualified as Set
import Data.Tuple.Extra (both)
import Gargantext.API.Ngrams.Types (NgramsElement, NgramsTerm(..))
import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.NodeStory
import Gargantext.Core.Text (size)
import Gargantext.Core.Text.List.Group
......@@ -36,10 +41,11 @@ import Gargantext.Core.Text.List.Social.Prelude
import Gargantext.Core.Text.Metrics (scored', Scored(..), scored_speExc, scored_genInc, normalizeGlobal, normalizeLocal, scored_terms)
import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId)
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Data.HashMap.Strict.Utils qualified as HashMap
import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsUser, getContextsByNgramsOnlyUser)
import Gargantext.Database.Action.Metrics.TFICF (getTficf_withSample)
import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Database.Prelude (CmdM)
import Gargantext.Database.Prelude (DBCmd)
import Gargantext.Database.Query.Table.Ngrams (text2ngrams)
import Gargantext.Database.Query.Table.NgramsPostag (selectLems)
import Gargantext.Database.Query.Table.Node (defaultList)
......@@ -47,12 +53,6 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError())
import Gargantext.Database.Query.Tree.Error (HasTreeError)
import Gargantext.Database.Schema.Ngrams (NgramsType(..), Ngrams(..))
import Gargantext.Prelude
import qualified Data.HashMap.Strict as HashMap
import qualified Data.HashSet as HashSet
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Gargantext.Data.HashMap.Strict.Utils as HashMap
{-
-- TODO maybe useful for later
......@@ -65,7 +65,7 @@ isStopTerm (StopSize n) x = Text.length x < n || any isStopChar (Text.unpack x)
-- | TODO improve grouping functions of Authors, Sources, Institutes..
buildNgramsLists :: ( HasNodeStory env err m
, CmdM env err m
, HasNLPServer env
, HasTreeError err
, HasNodeError err
)
......@@ -90,7 +90,7 @@ data MapListSize = MapListSize { unMapListSize :: !Int }
data MaxListSize = MaxListSize { unMaxListSize :: !Int }
buildNgramsOthersList :: ( HasNodeError err
, CmdM env err m
, HasNLPServer env
, HasNodeStory env err m
, HasTreeError err
)
......@@ -134,11 +134,9 @@ buildNgramsOthersList user uCid mfslw _groupParams (nt, MapListSize mapListSize,
getGroupParams :: ( HasNodeError err
, CmdM env err m
, HasNodeStory env err m
, HasTreeError err
)
=> GroupParams -> HashSet Ngrams -> m GroupParams
=> GroupParams -> HashSet Ngrams -> DBCmd err GroupParams
getGroupParams gp@(GroupWithPosTag l nsc _m) ng = do
!hashMap <- HashMap.fromList <$> selectLems l nsc (HashSet.toList ng)
-- printDebug "hashMap" hashMap
......@@ -148,7 +146,7 @@ getGroupParams gp _ = pure gp
-- TODO use ListIds
buildNgramsTermsList :: ( HasNodeError err
, CmdM env err m
, HasNLPServer env
, HasNodeStory env err m
, HasTreeError err
)
......
......@@ -17,29 +17,29 @@ import Control.Lens (view)
import Control.Monad (mzero)
import Data.Aeson
import Data.HashMap.Strict (HashMap)
import Data.List qualified as List
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Monoid (mconcat)
import Data.Pool
import Data.Swagger
import Data.Text qualified as T
import Data.Vector qualified as V
import GHC.Generics
import Gargantext.API.Ngrams.Types (NgramsTerm, NgramsPatch)
import Gargantext.Core.NodeStory (HasNodeStory, getNodesArchiveHistory)
import Gargantext.Core.NodeStory (getNodesArchiveHistory)
import Gargantext.Core.Text.List.Social.Find (findListsId)
import Gargantext.Core.Text.List.Social.Patch (addScorePatches)
import Gargantext.Core.Text.List.Social.Prelude (FlowCont, FlowListScores)
import Gargantext.Core.Types.Individu (User)
import Gargantext.Database.Admin.Types.Node (ListId, NodeId(..))
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (DBCmd, connPool)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Tree (NodeMode(Private), HasTreeError)
import Gargantext.Database.Schema.Ngrams (NgramsType)
import Gargantext.Prelude
import Test.QuickCheck
import Web.Internal.HttpApiData (ToHttpApiData, FromHttpApiData, parseUrlPiece, toUrlPiece)
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.Vector as V
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | Main parameters
......@@ -116,84 +116,72 @@ keepAllParents _ = KeepAllParents True
-}
------------------------------------------------------------------------
flowSocialList :: ( HasNodeStory env err m
, CmdM env err m
, HasNodeError err
, HasTreeError err
)
=> Maybe FlowSocialListWith
-> User
-> NgramsType
-> FlowCont NgramsTerm FlowListScores
-> m (FlowCont NgramsTerm FlowListScores)
flowSocialList :: ( HasNodeError err
, HasTreeError err
)
=> Maybe FlowSocialListWith
-> User
-> NgramsType
-> FlowCont NgramsTerm FlowListScores
-> DBCmd err (FlowCont NgramsTerm FlowListScores)
flowSocialList Nothing u = flowSocialList' MySelfFirst u
flowSocialList (Just (FlowSocialListWithPriority p)) u = flowSocialList' p u
flowSocialList (Just (FlowSocialListWithLists ls)) _ = getHistoryScores ls
flowSocialList (Just (NoList _)) _u = panic "[G.C.T.L.Social] Should not be executed"
flowSocialList' :: ( HasNodeStory env err m
, CmdM env err m
, HasNodeError err
flowSocialList' :: ( HasNodeError err
, HasTreeError err
)
=> FlowSocialListPriority
-> User -> NgramsType
-> FlowCont NgramsTerm FlowListScores
-> m (FlowCont NgramsTerm FlowListScores)
-> DBCmd err (FlowCont NgramsTerm FlowListScores)
flowSocialList' flowPriority user nt flc =
mconcat <$> mapM (flowSocialListByMode' user nt flc)
(flowSocialListPriority flowPriority)
where
flowSocialListByMode' :: ( HasNodeStory env err m
, CmdM env err m
, HasNodeError err
flowSocialListByMode' :: ( HasNodeError err
, HasTreeError err
)
=> User -> NgramsType
-> FlowCont NgramsTerm FlowListScores
-> NodeMode
-> m (FlowCont NgramsTerm FlowListScores)
-> DBCmd err (FlowCont NgramsTerm FlowListScores)
flowSocialListByMode' user' nt' flc' mode =
findListsId user' mode
>>= flowSocialListByModeWith nt' flc'
flowSocialListByModeWith :: ( HasNodeStory env err m
, CmdM env err m
, HasNodeError err
flowSocialListByModeWith :: ( HasNodeError err
, HasTreeError err
)
=> NgramsType
-> FlowCont NgramsTerm FlowListScores
-> [ListId]
-> m (FlowCont NgramsTerm FlowListScores)
-> DBCmd err (FlowCont NgramsTerm FlowListScores)
flowSocialListByModeWith nt'' flc'' listes =
getHistoryScores listes nt'' flc''
-----------------------------------------------------------------
getHistoryScores :: ( HasNodeStory env err m
, CmdM env err m
, HasNodeError err
getHistoryScores :: ( HasNodeError err
, HasTreeError err
)
=> [ListId]
-> NgramsType
-> FlowCont NgramsTerm FlowListScores
-> m (FlowCont NgramsTerm FlowListScores)
-> DBCmd err (FlowCont NgramsTerm FlowListScores)
getHistoryScores lists nt fl =
addScorePatches nt lists fl <$> getHistory [nt] lists
getHistory :: ( HasNodeStory env err m
, CmdM env err m
, HasNodeError err
getHistory :: ( HasNodeError err
, HasTreeError err
)
=> [NgramsType]
-> [ListId]
-> m (Map ListId (Map NgramsType [HashMap NgramsTerm NgramsPatch]))
-> DBCmd err (Map ListId (Map NgramsType [HashMap NgramsTerm NgramsPatch]))
getHistory types listsId = do
pool <- view connPool
nsp <- liftBase $ withResource pool $ \c -> getNodesArchiveHistory c listsId
......
......@@ -17,7 +17,7 @@ import Control.Lens (view)
import Gargantext.Core.Types.Individu
import Gargantext.Database.Admin.Config
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (DBCmd)
import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Query.Tree
import Gargantext.Database.Query.Tree.Root (getRootId)
......@@ -25,7 +25,7 @@ import Gargantext.Prelude
------------------------------------------------------------------------
findListsId :: (HasNodeError err, HasTreeError err)
=> User -> NodeMode -> Cmd err [NodeId]
=> User -> NodeMode -> DBCmd err [NodeId]
findListsId u mode = do
rootId <- getRootId u
ns <- map (view dt_nodeId) <$> filter ((== nodeTypeId NodeList) . (view dt_typeId))
......@@ -40,7 +40,7 @@ findListsId u mode = do
findNodes' :: (HasTreeError err, HasNodeError err)
=> RootId
-> NodeMode
-> Cmd err [DbTreeNode]
-> DBCmd err [DbTreeNode]
findNodes' r Private = do
pv <- (findNodes r Private $ [NodeFolderPrivate] <> commonNodes)
sh <- (findNodes' r Shared)
......@@ -52,3 +52,5 @@ findNodes' r PublicDirect = findNodes r Public $ [NodeFolderPublic ] <
commonNodes:: [NodeType]
commonNodes = [NodeFolder, NodeCorpus, NodeList, NodeFolderShared, NodeTeam]
......@@ -25,7 +25,7 @@ import Gargantext.Core.NodeStory (HasNodeStory)
import Gargantext.Core.Text.Metrics.Count (occurrencesWith)
import Gargantext.Core.Types.Main
import Gargantext.Database.Admin.Config
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (DBCmd)
import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Select
import Gargantext.Database.Query.Table.NodeContext (selectDocsDates)
......
......@@ -108,7 +108,7 @@ getGraph _uId nId = do
let defaultEdgesStrength = Strong
let defaultBridgenessMethod = BridgenessMethod_Basic
graph' <- computeGraph cId defaultPartitionMethod defaultBridgenessMethod (withMetric defaultMetric) defaultEdgesStrength (NgramsTerms, NgramsTerms) repo
mt <- defaultGraphMetadata cId "Title" repo defaultMetric defaultEdgesStrength
mt <- defaultGraphMetadata cId listId "Title" repo defaultMetric defaultEdgesStrength
let
graph'' = set graph_metadata (Just mt) graph'
hg = HyperdataGraphAPI graph'' camera
......@@ -167,7 +167,7 @@ recomputeGraph _uId nId partitionMethod bridgeMethod maybeSimilarity maybeStreng
case graph of
Nothing -> do
mt <- defaultGraphMetadata cId "Title" repo (fromMaybe Order1 maybeSimilarity) strength
mt <- defaultGraphMetadata cId listId "Title" repo (fromMaybe Order1 maybeSimilarity) strength
g <- computeG $ Just mt
pure $ trace "[G.V.G.API.recomputeGraph] Graph empty, computed" g
Just graph' -> if (listVersion == Just v) && (not force)
......@@ -225,14 +225,13 @@ computeGraph corpusId partitionMethod bridgeMethod similarity strength (nt1,nt2)
defaultGraphMetadata :: HasNodeError err
=> CorpusId
-> ListId
-> Text
-> NodeListStory
-> GraphMetric
-> Strength
-> DBCmd err GraphMetadata
defaultGraphMetadata cId t repo gm str = do
lId <- defaultList cId
defaultGraphMetadata cId lId t repo gm str = do
pure $ GraphMetadata { _gm_title = t
, _gm_metric = gm
, _gm_edgesStrength = Just str
......@@ -282,11 +281,14 @@ type GraphVersionsAPI = Summary "Graph versions"
graphVersionsAPI :: UserId -> NodeId -> GargServer GraphVersionsAPI
graphVersionsAPI u n =
graphVersions 0 n
graphVersions u n
:<|> recomputeVersions u n
graphVersions :: Int -> NodeId -> GargNoServer GraphVersions
graphVersions n nId = do
graphVersions :: (HasNodeStory env err m)
=> UserId
-> NodeId
-> m GraphVersions
graphVersions u nId = do
nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
let
graph = nodeGraph
......@@ -303,21 +305,14 @@ graphVersions n nId = do
mcId <- getClosestParentIdByType nId NodeCorpus
let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId
maybeListId <- defaultListMaybe cId
case maybeListId of
Nothing -> if n <= 2
then graphVersions (n+1) cId
else panic "[G.V.G.API] list not found after iterations"
Just listId -> do
repo <- getRepo [listId]
let v = repo ^. unNodeStory . at listId . _Just . a_version
-- printDebug "graphVersions" v
listId <- getOrMkList cId u
repo <- getRepo [listId]
let v = repo ^. unNodeStory . at listId . _Just . a_version
-- printDebug "graphVersions" v
pure $ GraphVersions { gv_graph = listVersion
, gv_repo = v }
pure $ GraphVersions { gv_graph = listVersion
, gv_repo = v }
--recomputeVersions :: UserId -> NodeId -> GargNoServer Graph
recomputeVersions :: HasNodeStory env err m
=> UserId
-> NodeId
......@@ -325,10 +320,11 @@ recomputeVersions :: HasNodeStory env err m
recomputeVersions uId nId = recomputeGraph uId nId Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
------------------------------------------------------------
graphClone :: UserId
graphClone :: HasNodeError err
=> UserId
-> NodeId
-> HyperdataGraphAPI
-> GargNoServer NodeId
-> DBCmd err NodeId
graphClone uId pId (HyperdataGraphAPI { _hyperdataAPIGraph = graph
, _hyperdataAPICamera = camera }) = do
let nodeType = NodeGraph
......
......@@ -16,42 +16,34 @@ Portability : POSIX
module Gargantext.Core.Viz.Phylo.Legacy.LegacyMain
where
-- import Data.GraphViz
-- import qualified Data.ByteString as DB
import Control.Lens hiding (Level)
import qualified Data.List as List
import Data.HashMap.Strict qualified as HashMap
import Data.List qualified as List
import Data.Maybe
import Data.Proxy
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as Text
import Debug.Trace (trace)
import GHC.IO (FilePath)
import Gargantext.API.Ngrams.Tools (getTermsWith)
import Gargantext.API.Ngrams.Types
import Gargantext.Database.Admin.Types.Node
import Gargantext.Core (HasDBid, withDefaultLanguage)
import Gargantext.Core.NodeStory (HasNodeStory)
import Gargantext.Core.Text.Context (TermList)
import Gargantext.Core.Text.Terms.WithList
import Gargantext.Database.Query.Table.Node(defaultList, getNodeWith)
import Gargantext.Prelude
import Gargantext.Database.Action.Flow.Types
import Gargantext.Core.Types
import Gargantext.Core.Viz.LegacyPhylo hiding (Svg, Dot)
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Query.Table.Node(defaultList, getNodeWith)
import Gargantext.Database.Query.Table.NodeContext (selectDocs)
import Gargantext.Database.Schema.Ngrams (NgramsType(..))
import Gargantext.Database.Schema.Node
import Gargantext.Database.Query.Table.NodeContext (selectDocs)
import Gargantext.Core.Types
import Gargantext.Core (HasDBid, withDefaultLanguage)
-- import Gargantext.Core.Viz.Phylo.LevelMaker (toPhylo)
-- import Gargantext.Core.Viz.Phylo.Tools
-- import Gargantext.Core.Viz.Phylo.View.Export
-- import Gargantext.Core.Viz.Phylo.View.ViewMaker -- TODO Just Maker is fine
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Set as Set
import qualified Data.Text as Text
import Gargantext.Prelude
type MinSizeBranch = Int
flowPhylo :: (FlowCmdM env err m, HasDBid NodeType)
flowPhylo :: (HasNodeStory env err m, HasDBid NodeType)
=> CorpusId
-> m Phylo
flowPhylo cId = do
......
......@@ -26,7 +26,7 @@ module Gargantext.Database ( module Gargantext.Database.Prelude
where
import Gargantext.Prelude
import Gargantext.Database.Prelude -- (connectGargandb)
import Gargantext.Database.Prelude (DBCmd) -- (connectGargandb)
-- import Gargantext.Database.Schema.Node
-- import Gargantext.Database.Query.Table.Node
......@@ -36,11 +36,11 @@ import Gargantext.Database.Query.Table.NodeNode
class InsertDB a where
insertDB :: a -> Cmd err Int
insertDB :: a -> DBCmd err Int
{-
class DeleteDB a where
deleteDB :: a -> Cmd err Int
deleteDB :: a -> DBCmd err Int
-}
instance InsertDB [NodeNode] where
......
......@@ -77,7 +77,7 @@ import Gargantext.Core (Lang(..), PosTagAlgo(..), NLPServerConfig)
import Gargantext.Core (withDefaultLanguage)
import Gargantext.Core.Ext.IMTUser (readFile_Annuaire)
import Gargantext.Core.Flow.Types
import Gargantext.Core.NLP (nlpServerGet)
import Gargantext.Core.NLP (HasNLPServer, nlpServerGet)
import Gargantext.Core.NodeStory (HasNodeStory)
import Gargantext.Core.Text
import Gargantext.Core.Text.Corpus.API qualified as API
......@@ -88,7 +88,7 @@ import Gargantext.Core.Text.List.Social (FlowSocialListWith(..))
import Gargantext.Core.Text.Terms
import Gargantext.Core.Text.Terms.Mono.Stem.En (stemIt)
import Gargantext.Core.Text.Terms.WithList (MatchedText, buildPatternsWith, termsInText)
import Gargantext.Core.Types (POS(NP), TermsCount)
import Gargantext.Core.Types (HasInvalidError, POS(NP), TermsCount)
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Core.Types.Main
import Gargantext.Core.Types.Query (Limit)
......@@ -103,7 +103,7 @@ import Gargantext.Database.Action.Search (searchDocInDatabase)
import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node hiding (DEBUG) -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (DbCmd', DBCmd)
import Gargantext.Database.Query.Table.ContextNodeNgrams2
import Gargantext.Database.Query.Table.Ngrams
import Gargantext.Database.Query.Table.Node
......@@ -127,7 +127,7 @@ import PUBMED.Types qualified as PUBMED
------------------------------------------------------------------------
-- Imports for upgrade function
import Gargantext.Database.Query.Tree.Root (getRootId)
import Gargantext.Database.Query.Tree (findNodesId)
import Gargantext.Database.Query.Tree (findNodesId, HasTreeError)
------------------------------------------------------------------------
-- TODO use internal with API name (could be old data)
......@@ -157,13 +157,13 @@ printDataText (DataNew (maybeInt, conduitData)) = do
putText $ show (maybeInt, res)
-- TODO use the split parameter in config file
getDataText :: FlowCmdM env err m
getDataText :: (HasNodeError err)
=> DataOrigin
-> TermType Lang
-> API.RawQuery
-> Maybe PUBMED.APIKey
-> Maybe API.Limit
-> m (Either API.GetCorpusError DataText)
-> DBCmd err (Either API.GetCorpusError DataText)
getDataText (ExternalOrigin api) la q mPubmedAPIKey li = do
eRes <- liftBase $ API.get api (_tt_lang la) q mPubmedAPIKey li
pure $ DataNew <$> eRes
......@@ -175,12 +175,12 @@ getDataText (InternalOrigin _) _la q _ _li = do
ids <- map fst <$> searchDocInDatabase cId (stemIt $ API.getRawQuery q)
pure $ Right $ DataOld ids
getDataText_Debug :: FlowCmdM env err m
=> DataOrigin
-> TermType Lang
-> API.RawQuery
-> Maybe API.Limit
-> m ()
getDataText_Debug :: (HasNodeError err)
=> DataOrigin
-> TermType Lang
-> API.RawQuery
-> Maybe API.Limit
-> DBCmd err ()
getDataText_Debug a l q li = do
result <- getDataText a l q Nothing li
case result of
......@@ -190,7 +190,12 @@ getDataText_Debug a l q li = do
-------------------------------------------------------------------------------
flowDataText :: forall env err m.
( FlowCmdM env err m
( DbCmd' env err m
, HasNodeStory env err m
, MonadLogger m
, HasNLPServer env
, HasTreeError err
, HasInvalidError err
, MonadJobStatus m
)
=> User
......@@ -214,7 +219,13 @@ flowDataText u (DataNew (mLen, txtC)) tt cid mfslw jobHandle = do
------------------------------------------------------------------------
-- TODO use proxy
flowAnnuaire :: (FlowCmdM env err m, MonadJobStatus m)
flowAnnuaire :: ( DbCmd' env err m
, HasNodeStory env err m
, MonadLogger m
, HasNLPServer env
, HasTreeError err
, HasInvalidError err
, MonadJobStatus m )
=> User
-> Either CorpusName [CorpusId]
-> (TermType Lang)
......@@ -227,7 +238,13 @@ flowAnnuaire u n l filePath jobHandle = do
flow (Nothing :: Maybe HyperdataAnnuaire) u n l Nothing (fromIntegral $ length docs, yieldMany docs) jobHandle
------------------------------------------------------------------------
flowCorpusFile :: (FlowCmdM env err m, MonadJobStatus m)
flowCorpusFile :: ( DbCmd' env err m
, HasNodeStory env err m
, MonadLogger m
, HasNLPServer env
, HasTreeError err
, HasInvalidError err
, MonadJobStatus m )
=> User
-> Either CorpusName [CorpusId]
-> Limit -- Limit the number of docs (for dev purpose)
......@@ -250,7 +267,14 @@ flowCorpusFile u n _l la ft ff fp mfslw jobHandle = do
------------------------------------------------------------------------
-- | TODO improve the needed type to create/update a corpus
-- (For now, Either is enough)
flowCorpus :: (FlowCmdM env err m, FlowCorpus a, MonadJobStatus m)
flowCorpus :: ( DbCmd' env err m
, HasNodeStory env err m
, MonadLogger m
, HasNLPServer env
, HasTreeError err
, HasInvalidError err
, FlowCorpus a
, MonadJobStatus m )
=> User
-> Either CorpusName [CorpusId]
-> TermType Lang
......@@ -262,7 +286,12 @@ flowCorpus = flow (Nothing :: Maybe HyperdataCorpus)
flow :: forall env err m a c.
( FlowCmdM env err m
( DbCmd' env err m
, HasNodeStory env err m
, MonadLogger m
, HasNLPServer env
, HasTreeError err
, HasInvalidError err
, FlowCorpus a
, MkCorpus c
, MonadJobStatus m
......@@ -338,7 +367,11 @@ createNodes user corpusName ctype = do
pure (userId, userCorpusId, listId)
flowCorpusUser :: ( FlowCmdM env err m
flowCorpusUser :: ( HasNodeError err
, HasInvalidError err
, HasNLPServer env
, HasTreeError err
, HasNodeStory env err m
, MkCorpus c
)
=> Lang
......@@ -589,7 +622,8 @@ instance HasText a => HasText (Node a)
-- | TODO putelsewhere
-- | Upgrade function
-- Suppose all documents are English (this is the case actually)
indexAllDocumentsWithPosTag :: FlowCmdM env err m
indexAllDocumentsWithPosTag :: ( HasNodeStory env err m
, HasNLPServer env )
=> m ()
indexAllDocumentsWithPosTag = do
rootId <- getRootId (UserName userMaster)
......@@ -598,7 +632,8 @@ indexAllDocumentsWithPosTag = do
_ <- mapM extractInsert (splitEvery 1000 docs)
pure ()
extractInsert :: FlowCmdM env err m
extractInsert :: ( HasNodeStory env err m
, HasNLPServer env )
=> [Node HyperdataDocument] -> m ()
extractInsert docs = do
let documentsWithId = map (\doc -> Indexed (doc ^. node_id) doc) docs
......
......@@ -17,27 +17,26 @@ Portability : POSIX
module Gargantext.Database.Action.Flow.List
where
-- import Gargantext.Database.Query.Table.Node_NodeNgramsNodeNgrams
import Control.Concurrent
import Control.Lens ((^.), (+~), (%~), at, (.~), _Just)
import Control.Monad.Reader
import Data.List qualified as List
import Data.Map.Strict (Map, toList)
import Data.Map.Strict qualified as Map
import Data.Map.Strict.Patch qualified as PM
import Data.Text (Text)
import Gargantext.API.Ngrams (saveNodeStory)
import Gargantext.API.Ngrams.Tools (getNodeStoryVar)
import Gargantext.API.Ngrams.Types
import Gargantext.Core.NodeStory
import Gargantext.Core.Types (HasInvalidError(..), assertValid)
import Gargantext.Core.Types.Main (ListType(CandidateTerm))
import Gargantext.Core.NodeStory
import Gargantext.Database.Action.Flow.Types
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Query.Table.Ngrams qualified as TableNgrams
import Gargantext.Database.Query.Table.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb,{- getCgramsId -})
-- import Gargantext.Database.Query.Table.Node_NodeNgramsNodeNgrams
import Gargantext.Database.Schema.Ngrams (NgramsType(..))
import Gargantext.Prelude
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Map.Strict.Patch as PM
import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
-- FLOW LIST
-- 1. select specific terms of the corpus when compared with others langs
......@@ -82,10 +81,10 @@ flowList_Tficf' u m nt f = do
------------------------------------------------------------------------
flowList_DbRepo :: FlowCmdM env err m
=> ListId
-> Map NgramsType [NgramsElement]
-> m ListId
flowList_DbRepo :: (HasInvalidError err, HasNodeStory env err m)
=> ListId
-> Map NgramsType [NgramsElement]
-> m ListId
flowList_DbRepo lId ngs = do
-- printDebug "listId flowList" lId
_mapCgramsId <- listInsertDb lId toNodeNgramsW (Map.toList ngs)
......@@ -157,10 +156,10 @@ toNodeNgramsW' l'' ngs = [ NodeNgrams { _nng_id = Nothing
]
listInsert :: FlowCmdM env err m
=> ListId
-> Map NgramsType [NgramsElement]
-> m ()
listInsert :: (HasInvalidError err, HasNodeStory env err m)
=> ListId
-> Map NgramsType [NgramsElement]
-> m ()
listInsert lId ngs = mapM_ (\(typeList, ngElmts)
-> putListNgrams lId typeList ngElmts) (toList ngs)
......
......@@ -16,13 +16,18 @@ module Gargantext.Database.Action.Flow.Pairing
-- (pairing)
where
import Debug.Trace (trace)
import Control.Lens (_Just, (^.), view)
import Data.Hashable (Hashable)
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HM
import Data.HashMap.Strict qualified as HashMap
import Data.Hashable (Hashable)
import Data.List qualified as List
import Data.Maybe (fromMaybe, catMaybes)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as Text
import Debug.Trace (trace)
import Gargantext.API.Ngrams.Tools
import Gargantext.API.Ngrams.Types (NgramsTerm(..))
import Gargantext.Core
......@@ -42,16 +47,11 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.Node.Select (selectNodesWithUsername)
import Gargantext.Database.Query.Table.NodeContext_NodeContext (insertNodeContext_NodeContext)
import Gargantext.Database.Query.Table.NodeNode (insertNodeNode)
import Gargantext.Database.Prelude (Cmd, runOpaQuery)
import Gargantext.Database.Schema.Ngrams -- (NgramsType(..))
import Gargantext.Database.Schema.Node
-- import Gargantext.Database.Schema.Context
import qualified Data.HashMap.Strict as HM
import Gargantext.Prelude hiding (sum)
import Opaleye
import qualified Data.HashMap.Strict as HashMap
import qualified Data.List as List
import qualified Data.Set as Set
import qualified Data.Text as Text
-- | isPairedWith
-- All NodeAnnuaire paired with a Corpus of NodeId nId:
......
......@@ -15,19 +15,19 @@ Portability : POSIX
module Gargantext.Database.Action.Learn
where
import Data.List qualified as List
import Data.Maybe
import Data.Text (Text)
import Data.Text qualified as Text
import Gargantext.Core
import Gargantext.Core.Text.Learn
import Gargantext.Core.Types.Query (Offset, Limit(..))
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (DBCmd)
import Gargantext.Database.Query.Facet
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Prelude (Cmd)
import Gargantext.Prelude
import Gargantext.Core.Text.Learn
import qualified Data.List as List
import qualified Data.Text as Text
data FavOrTrash = IsFav | IsTrash
deriving (Eq)
......@@ -35,14 +35,14 @@ data FavOrTrash = IsFav | IsTrash
moreLike :: (HasDBid NodeType, HasNodeError err)
=> CorpusId -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
-> FavOrTrash -> Cmd err [FacetDoc]
-> FavOrTrash -> DBCmd err [FacetDoc]
moreLike cId o _l order ft = do
priors <- getPriors ft cId
moreLikeWith cId o (Just 3) order ft priors
---------------------------------------------------------------------------
getPriors :: (HasDBid NodeType, HasNodeError err)
=> FavOrTrash -> CorpusId -> Cmd err (Events Bool)
=> FavOrTrash -> CorpusId -> DBCmd err (Events Bool)
getPriors ft cId = do
docs_fav <- filter (\(FacetDoc _ _ _ _ f _ _) -> f == Just 2)
......@@ -60,7 +60,7 @@ getPriors ft cId = do
moreLikeWith :: (HasDBid NodeType, HasNodeError err)
=> CorpusId -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
-> FavOrTrash -> Events Bool -> Cmd err [FacetDoc]
-> FavOrTrash -> Events Bool -> DBCmd err [FacetDoc]
moreLikeWith cId o l order ft priors = do
docs_test <- filter (\(FacetDoc _ _ _ _ f _ _) -> f == Just 1)
......
......@@ -18,7 +18,7 @@ import Gargantext.Core.Mail (mail, MailModel(..))
import Gargantext.Core.Mail.Types (mailSettings)
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.User
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (CmdM)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Schema.User
import Gargantext.Prelude
......
......@@ -184,15 +184,13 @@ updateContextScore cId lId = do
-- Used for scores in Doc Table
getContextsNgramsScore :: --(FlowCmdM env err m)
(HasNodeStory env err m)
getContextsNgramsScore :: (HasNodeStory env err m)
=> CorpusId -> ListId -> TabType -> ListType -> Maybe Limit
-> m (Map ContextId Int)
getContextsNgramsScore cId lId tabType listType maybeLimit
= Map.map Set.size <$> getContextsNgrams cId lId tabType listType maybeLimit
getContextsNgrams :: --(FlowCmdM env err m)
(HasNodeStory env err m)
getContextsNgrams :: (HasNodeStory env err m)
=> CorpusId -> ListId -> TabType -> ListType -> Maybe Limit
-> m (Map ContextId (Set NgramsTerm))
getContextsNgrams cId lId tabType listType maybeLimit = do
......
......@@ -249,11 +249,11 @@ queryNgramsOccurrencesOnlyByContextUser_withSample' = [sql|
------------------------------------------------------------------------
getContextsByNgramsOnlyUser :: HasDBid NodeType
=> CorpusId
-> [ListId]
-> NgramsType
-> [NgramsTerm]
-> DBCmd err (HashMap NgramsTerm (Set NodeId))
=> CorpusId
-> [ListId]
-> NgramsType
-> [NgramsTerm]
-> DBCmd err (HashMap NgramsTerm (Set NodeId))
getContextsByNgramsOnlyUser cId ls nt ngs =
HM.unionsWith (<>)
. map (HM.fromListWith (<>)
......
......@@ -23,7 +23,7 @@ import Gargantext.Core
import Gargantext.Core.Text.Metrics.TFICF
import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsUser, {-getOccByNgramsOnlyFast,-} getOccByNgramsOnlyFast_withSample)
import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
import Gargantext.Database.Prelude (Cmd)
import Gargantext.Database.Prelude (DBCmd)
import Gargantext.Database.Query.Table.NodeContext (selectCountDocs)
import Gargantext.Database.Schema.Ngrams (NgramsType(..))
import Gargantext.API.Ngrams.Types
......@@ -58,10 +58,10 @@ getTficf cId mId nt = do
-}
getTficf_withSample :: HasDBid NodeType
=> UserCorpusId
-> MasterCorpusId
-> NgramsType
-> Cmd err (HashMap NgramsTerm Double)
=> UserCorpusId
-> MasterCorpusId
-> NgramsType
-> DBCmd err (HashMap NgramsTerm Double)
getTficf_withSample cId mId nt = do
mapTextDoubleLocal <- HM.filter (> 1)
<$> HM.map (fromIntegral . Set.size)
......
......@@ -30,7 +30,7 @@ import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Prelude
import Gargantext.Prelude.Crypto.Hash (hash)
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (DBCmd, HasConfig(..))
import Control.Lens (view)
import Gargantext.Prelude.Config (GargConfig(..))
......
......@@ -25,17 +25,17 @@ import Gargantext.Database.Action.User (getUserId)
import Gargantext.Database.Admin.Config (hasNodeType, isInNodeTypes)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAny(..))
import Gargantext.Database.Admin.Types.Node
-- import Gargantext.Database.Query.Join (leftJoin3')
import Gargantext.Database.Query.Table.Node (getNode, getNodesWith)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError, errorWith)
import Gargantext.Database.Query.Table.NodeNode (deleteNodeNode, queryNodeNodeTable)
import Gargantext.Database.Query.Table.User
import Gargantext.Database.Query.Tree.Root (getRootId)
import Gargantext.Database.Prelude (Cmd, runOpaQuery)
import Gargantext.Database.Schema.Node
import Gargantext.Prelude
import Gargantext.Utils.Tuple (uncurryMaybe)
import Opaleye hiding (not)
import qualified Opaleye as O
import Opaleye qualified as O
-- | TODO move in PhyloConfig of Gargantext
publicNodeTypes :: [NodeType]
......
{-|
Module : Gargantext.Database.Action.TSQuery
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Here is a longer description of this module, containing some
commentary with @some markup@.
-}
module Gargantext.Database.Action.TSQuery where
import Data.Aeson
......@@ -8,11 +21,11 @@ import Data.Text (Text, words)
import Database.PostgreSQL.Simple (Query)
import Database.PostgreSQL.Simple.ToField
import Gargantext.Core
import Gargantext.Core.Text.Terms.Mono.Stem.En (stemIt)
import Gargantext.Core.Types
import Gargantext.Core.Types.Query (Limit, Offset)
import Gargantext.Database.Prelude (Cmd, runPGSQuery)
import Gargantext.Database.Prelude (DBCmd, runPGSQuery)
import Gargantext.Prelude
import Gargantext.Core.Text.Terms.Mono.Stem.En (stemIt)
newtype TSQuery = UnsafeTSQuery [Text]
......@@ -71,7 +84,7 @@ textSearchQuery = "SELECT n.id, n.hyperdata->'publication_year' \
textSearch :: HasDBid NodeType
=> TSQuery -> ParentId
-> Limit -> Offset -> Order
-> Cmd err [(Int,Value,Value,Value, Value, Maybe Int)]
-> DBCmd err [(Int,Value,Value,Value, Value, Maybe Int)]
textSearch q p l o ord = runPGSQuery textSearchQuery (q,p,p,typeId,ord,o,l)
where
typeId = toDBid NodeDocument
......@@ -29,7 +29,7 @@ import Gargantext.Core.Mail.Types (HasMail, mailSettings)
import Gargantext.Core.Types.Individu
import Gargantext.Database.Action.Flow (getOrMkRoot)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (Cmd, DBCmd, CmdM)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..), nodeError, NodeError(..))
import Gargantext.Database.Query.Table.User
import Gargantext.Prelude
......@@ -135,12 +135,12 @@ _updateUsersPassword us = do
pure 1
------------------------------------------------------------------------
_rmUser :: HasNodeError err => User -> Cmd err Int64
_rmUser :: HasNodeError err => User -> DBCmd err Int64
_rmUser (UserName un) = deleteUsers [un]
_rmUser _ = nodeError NotImplYet
------------------------------------------------------------------------
-- TODO
_rmUsers :: HasNodeError err => [User] -> Cmd err Int64
_rmUsers :: HasNodeError err => [User] -> DBCmd err Int64
_rmUsers [] = pure 0
_rmUsers _ = undefined
......@@ -144,17 +144,15 @@ runCountOpaQuery q = do
-- countRows is guaranteed to return a list with exactly one row so DL.head is safe here
pure $ fromInt64ToInt $ DL.head counts
formatPGSQuery :: PGS.ToRow a => PGS.Query -> a -> Cmd err DB.ByteString
formatPGSQuery :: PGS.ToRow a => PGS.Query -> a -> DBCmd err DB.ByteString
formatPGSQuery q a = mkCmd $ \conn -> PGS.formatQuery conn q a
-- TODO use runPGSQueryDebug everywhere
runPGSQuery' :: (PGS.ToRow a, PGS.FromRow b) => PGS.Query -> a -> Cmd err [b]
runPGSQuery' :: (PGS.ToRow a, PGS.FromRow b) => PGS.Query -> a -> DBCmd err [b]
runPGSQuery' q a = mkCmd $ \conn -> PGS.query conn q a
runPGSQuery :: ( DbCmd' env err m
, PGS.FromRow r, PGS.ToRow q
)
=> PGS.Query -> q -> m [r]
runPGSQuery :: ( PGS.FromRow r, PGS.ToRow q )
=> PGS.Query -> q -> DBCmd err [r]
runPGSQuery q a = mkCmd $ \conn -> catch (PGS.query conn q a) (printError conn)
where
printError c (SomeException e) = do
......@@ -179,10 +177,8 @@ runPGSQueryFold q initialState consume = mkCmd $ \conn -> catch (PGS.fold_ conn
-- | TODO catch error
runPGSQuery_ :: ( CmdM env err m
, PGS.FromRow r
)
=> PGS.Query -> m [r]
runPGSQuery_ :: ( PGS.FromRow r )
=> PGS.Query -> DBCmd err [r]
runPGSQuery_ q = mkCmd $ \conn -> catch (PGS.query_ conn q) printError
where
printError (SomeException e) = do
......@@ -227,7 +223,7 @@ fromField' field mb = do
printSqlOpa :: Default Unpackspec a a => Select a -> IO ()
printSqlOpa = putStrLn . maybe "Empty query" identity . showSql
dbCheck :: CmdM env err m => m Bool
dbCheck :: DBCmd err Bool
dbCheck = do
r :: [PGS.Only Text] <- runPGSQuery_ "select username from public.auth_user"
case r of
......
......@@ -43,7 +43,7 @@ import Data.Text qualified as T
import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Core.Types.Query (Limit, Offset, IsTrash)
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (DBCmd, runCountOpaQuery, runOpaQuery)
import Gargantext.Database.Query.Facet.Types
import Gargantext.Database.Query.Filter
import Gargantext.Database.Query.Table.Context
......@@ -70,7 +70,7 @@ runViewAuthorsDoc :: HasDBid NodeType
-> Maybe Offset
-> Maybe Limit
-> Maybe OrderBy
-> Cmd err [FacetDoc]
-> DBCmd err [FacetDoc]
runViewAuthorsDoc cId t o l order = runOpaQuery $ filterWith o l order $ viewAuthorsDoc cId t ntId
where
ntId = NodeDocument
......@@ -125,11 +125,11 @@ runViewDocuments :: (HasDBid NodeType, HasNodeError err)
-> Maybe OrderBy
-> Maybe Text
-> Maybe Text
-> Cmd err [FacetDoc]
-> DBCmd err [FacetDoc]
runViewDocuments cId t o l order query year = do
listId <- defaultList cId
res <- runOpaQuery $ filterWith' o l order (sqlQuery listId) :: Cmd err [FacetDocAgg']
res <- runOpaQuery $ filterWith' o l order (sqlQuery listId) :: DBCmd err [FacetDocAgg']
pure $ remapNgramsCount <$> res
where
sqlQuery lId = viewDocuments cId lId t (toDBid NodeDocument) query year
......@@ -140,7 +140,7 @@ runViewDocuments cId t o l order query year = do
, .. }
runCountDocuments :: (HasDBid NodeType, HasNodeError err)
=> CorpusId -> IsTrash -> Maybe Text -> Maybe Text -> Cmd err Int
=> CorpusId -> IsTrash -> Maybe Text -> Maybe Text -> DBCmd err Int
runCountDocuments cId t mQuery mYear = do
listId <- defaultList cId
runCountOpaQuery (sqlQuery listId)
......
......@@ -25,7 +25,7 @@ import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Core.Types.Query (Limit, Offset)
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (DBCmd, JSONB, runOpaQuery)
import Gargantext.Database.Query.Filter (limit', offset')
import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Schema.Context
......@@ -35,7 +35,7 @@ import Prelude hiding (null, id, map, sum)
getContextWith :: (HasNodeError err, JSONB a)
=> ContextId -> proxy a -> Cmd err (Node a)
=> ContextId -> proxy a -> DBCmd err (Node a)
getContextWith nId _ = do
maybeContext <- headMay <$> runOpaQuery (selectContext (pgNodeId nId))
case maybeContext of
......@@ -51,7 +51,7 @@ selectContext id' = proc () -> do
restrict -< _context_id row .== id'
returnA -< row
runGetContexts :: Select ContextRead -> Cmd err [Context HyperdataAny]
runGetContexts :: Select ContextRead -> DBCmd err [Context HyperdataAny]
runGetContexts = runOpaQuery
------------------------------------------------------------------------
......@@ -84,11 +84,11 @@ selectContextsWith' parentId maybeContextType = proc () -> do
------------------------------------------------------------------------
getDocumentsV3WithParentId :: HasDBid NodeType => NodeId -> Cmd err [Context HyperdataDocumentV3]
getDocumentsV3WithParentId :: HasDBid NodeType => NodeId -> DBCmd err [Context HyperdataDocumentV3]
getDocumentsV3WithParentId n = runOpaQuery $ selectContextsWith' n (Just NodeDocument)
-- TODO: merge with getDocumentsWithParentId by having a class IsHyperdataDocument
getDocumentsWithParentId :: HasDBid NodeType => NodeId -> Cmd err [Context HyperdataDocument]
getDocumentsWithParentId :: HasDBid NodeType => NodeId -> DBCmd err [Context HyperdataDocument]
getDocumentsWithParentId n = runOpaQuery $ selectContextsWith' n (Just NodeDocument)
------------------------------------------------------------------------
......@@ -102,7 +102,8 @@ selectContextsWithParentID n = proc () -> do
------------------------------------------------------------------------
-- | Example of use:
-- runCmdReplEasy (getNodesWithType NodeList (Proxy :: Proxy HyperdataList))
getContextsWithType :: (HasNodeError err, JSONB a, HasDBid NodeType) => NodeType -> proxy a -> Cmd err [Context a]
getContextsWithType :: (HasNodeError err, JSONB a, HasDBid NodeType)
=> NodeType -> proxy a -> DBCmd err [Context a]
getContextsWithType nt _ = runOpaQuery $ selectContextsWithType nt
where
selectContextsWithType :: HasDBid NodeType
......@@ -112,7 +113,8 @@ getContextsWithType nt _ = runOpaQuery $ selectContextsWithType nt
restrict -< tn .== (sqlInt4 $ toDBid nt')
returnA -< row
getContextsIdWithType :: (HasNodeError err, HasDBid NodeType) => NodeType -> Cmd err [ContextId]
getContextsIdWithType :: (HasNodeError err, HasDBid NodeType)
=> NodeType -> DBCmd err [ContextId]
getContextsIdWithType nt = do
ns <- runOpaQuery $ selectContextsIdWithType nt
pure (map NodeId ns)
......
......@@ -28,7 +28,7 @@ import Data.HashMap.Strict (HashMap)
import Data.Map.Strict (Map)
import Data.Text (Text)
import Gargantext.Core.Types
import Gargantext.Database.Prelude (runOpaQuery, Cmd, formatPGSQuery, runPGSQuery, DBCmd)
import Gargantext.Database.Prelude (runOpaQuery, formatPGSQuery, runPGSQuery, DBCmd)
import Gargantext.Database.Query.Join (leftJoin3)
import Gargantext.Database.Query.Table.ContextNodeNgrams2
import Gargantext.Database.Query.Table.NodeNgrams (queryNodeNgramsTable)
......@@ -45,7 +45,7 @@ import qualified Database.PostgreSQL.Simple as PGS
queryNgramsTable :: Select NgramsRead
queryNgramsTable = selectTable ngramsTable
selectNgramsByDoc :: [ListId] -> DocId -> NgramsType -> Cmd err [Text]
selectNgramsByDoc :: [ListId] -> DocId -> NgramsType -> DBCmd err [Text]
selectNgramsByDoc lIds dId nt = runOpaQuery (query lIds dId nt)
where
......@@ -65,10 +65,10 @@ selectNgramsByDoc lIds dId nt = runOpaQuery (query lIds dId nt)
returnA -< ng^.ngrams_terms
_postNgrams :: CorpusId -> DocId -> [Text] -> Cmd err Int
_postNgrams :: CorpusId -> DocId -> [Text] -> DBCmd err Int
_postNgrams = undefined
_dbGetNgramsDb :: Cmd err [NgramsDB]
_dbGetNgramsDb :: DBCmd err [NgramsDB]
_dbGetNgramsDb = runOpaQuery queryNgramsTable
......@@ -85,7 +85,7 @@ insertNgrams' ns = runPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
where
fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]
_insertNgrams_Debug :: [(Text, Size)] -> Cmd err ByteString
_insertNgrams_Debug :: [(Text, Size)] -> DBCmd err ByteString
_insertNgrams_Debug ns = formatPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
where
fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]
......@@ -111,13 +111,13 @@ queryInsertNgrams = [sql|
--------------------------------------------------------------------------
selectNgramsId :: [Text] -> Cmd err (Map NgramsId Text)
selectNgramsId :: [Text] -> DBCmd err (Map NgramsId Text)
selectNgramsId ns =
if List.null ns
then pure Map.empty
else Map.fromList <$> map (\(Indexed i t) -> (i, t)) <$> (selectNgramsId' ns)
selectNgramsId' :: [Text] -> Cmd err [Indexed Int Text]
selectNgramsId' :: [Text] -> DBCmd err [Indexed Int Text]
selectNgramsId' ns = runPGSQuery querySelectNgramsId ( PGS.Only
$ Values fields ns
)
......
......@@ -24,7 +24,7 @@ import Data.Hashable (Hashable)
import Data.Text (Text)
import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Database.Prelude (Cmd, runPGSQuery, runPGSQuery_, DBCmd)
import Gargantext.Database.Prelude (runPGSQuery, runPGSQuery_, DBCmd)
import Gargantext.Database.Schema.Ngrams
import Gargantext.Database.Schema.Prelude
import Gargantext.Database.Query.Table.Ngrams
......@@ -155,7 +155,7 @@ SELECT terms,id FROM ins_form_ret
-- TODO add lang and postag algo
-- TODO remove when form == lem in insert
selectLems :: Lang -> NLPServerConfig -> [Ngrams] -> Cmd err [(Form, Lem)]
selectLems :: Lang -> NLPServerConfig -> [Ngrams] -> DBCmd err [(Form, Lem)]
selectLems l (NLPServerConfig { server }) ns = runPGSQuery querySelectLems (PGS.Only $ Values fields datas)
where
fields = map (\t -> QualifiedIdentifier Nothing t) ["int4","int4","text", "int4"]
......@@ -180,7 +180,7 @@ querySelectLems = [sql|
|]
-- | Insert Table
createTable_NgramsPostag :: Cmd err [Int]
createTable_NgramsPostag :: DBCmd err [Int]
createTable_NgramsPostag = map (\(PGS.Only a) -> a)
<$> runPGSQuery_ queryCreateTable
where
......
......@@ -25,22 +25,20 @@ import Control.Lens (set, view)
import Data.Aeson
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Database.PostgreSQL.Simple qualified as PGS
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Opaleye hiding (FromField)
import Prelude hiding (null, id, map, sum)
import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Core.Types.Query (Limit, Offset)
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Hyperdata.Default
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (DBCmd, JSONB, mkCmd, runPGSQuery, runOpaQuery)
import Gargantext.Database.Query.Filter (limit', offset')
import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Schema.Node
import Gargantext.Prelude hiding (sum, head)
import qualified Database.PostgreSQL.Simple as PGS
import Opaleye hiding (FromField)
import Prelude hiding (null, id, map, sum)
queryNodeSearchTable :: Select NodeSearchRead
......
......@@ -22,15 +22,11 @@ import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Core.Types.Query (Limit, Offset)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument, HyperdataContact)
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (DBCmd, JSONB, runCountOpaQuery, runOpaQuery)
import Gargantext.Database.Query.Filter
import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.Context
import Gargantext.Database.Schema.NodeContext
import Gargantext.Database.Query.Table.NodeContext
import Gargantext.Database.Schema.Context
import Gargantext.Database.Schema.Node
import Gargantext.Prelude
import Opaleye
......
......@@ -28,7 +28,7 @@ import Database.PostgreSQL.Simple.ToRow (ToRow(..))
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import GHC.Generics (Generic)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd, runPGSQuery, formatPGSQuery, DBCmd)
import Gargantext.Database.Prelude (runPGSQuery, formatPGSQuery, DBCmd)
import Gargantext.Prelude
---------------------------------------------------------------------------
......@@ -41,12 +41,12 @@ add pId ns = runPGSQuery queryAdd (Only $ Values fields inputData)
-- | Adds a single document. Useful for debugging purposes, but
-- not as efficient as adding documents in bulk via 'add'.
add_one :: CorpusId -> ContextId -> Cmd err [Only Int]
add_one :: CorpusId -> ContextId -> DBCmd err [Only Int]
add_one pId ctxId = runPGSQuery queryAdd (Only $ Values fields [InputData pId ctxId])
where
fields = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
add_debug :: CorpusId -> [ContextId] -> Cmd err ByteString
add_debug :: CorpusId -> [ContextId] -> DBCmd err ByteString
add_debug pId ns = formatPGSQuery queryAdd (Only $ Values fields inputData)
where
fields = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
......
......@@ -16,16 +16,14 @@ module Gargantext.Database.Query.Table.Node.Select
where
import Control.Arrow (returnA)
import Opaleye
import Protolude
import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Core.Types.Individu (Username)
import Gargantext.Database.Prelude
import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.User
import Gargantext.Database.Prelude (DBCmd, runOpaQuery)
import Gargantext.Database.Query.Table.User
import Gargantext.Database.Schema.Node
import Opaleye
import Protolude
selectNodesWithUsername :: (HasDBid NodeType) => NodeType -> Username -> DBCmd err [NodeId]
selectNodesWithUsername nt u = runOpaQuery $ proc () -> do
......
......@@ -19,7 +19,7 @@ import Database.PostgreSQL.Simple
import Gargantext.Prelude
import Gargantext.Core.Types (Name)
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (DBCmd, runPGSQuery)
import Gargantext.Database.Admin.Types.Node (NodeId, ParentId)
-- import Data.ByteString
......@@ -39,7 +39,7 @@ unOnly :: Only a -> a
unOnly (Only a) = a
-- TODO-ACCESS
update :: Update -> Cmd err [Int]
update :: Update -> DBCmd err [Int]
update (Rename nId name) = map unOnly <$> runPGSQuery "UPDATE nodes SET name=? where id=? returning id"
(DT.take 255 name,nId)
update (Move nId pId) = map unOnly <$> runPGSQuery "UPDATE nodes SET parent_id= ? where id=? returning id"
......
......@@ -22,7 +22,7 @@ import Gargantext.Prelude
import Gargantext.Database.Schema.Node
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd, mkCmd, DBCmd)
import Gargantext.Database.Prelude (mkCmd, DBCmd)
import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Error
......@@ -49,7 +49,7 @@ updateHyperdataQuery i h = seq h' $ {- trace "updateHyperdataQuery: encoded JSON
updateNodesWithType :: ( HasNodeError err
, HasDBid NodeType
, HyperdataC a
) => NodeType -> proxy a -> (a -> a) -> Cmd err [Int64]
) => NodeType -> proxy a -> (a -> a) -> DBCmd err [Int64]
updateNodesWithType nt p f = do
ns <- getNodesWithType nt p
mapM (\n -> updateHyperdata (_node_id n) (f $ _node_hyperdata n)) ns
......@@ -61,7 +61,7 @@ updateNodeWithType :: ( HasNodeError err
-> NodeType
-> proxy a
-> (a -> a)
-> Cmd err [Int64]
-> DBCmd err [Int64]
updateNodeWithType nId nt p f = do
ns <- getNodeWithType nId nt p
mapM (\n -> updateHyperdata (_node_id n) (f $ _node_hyperdata n)) ns
......@@ -71,7 +71,7 @@ updateNodeWithType nId nt p f = do
updateNodesWithType_ :: ( HasNodeError err
, HyperdataC a
, HasDBid NodeType
) => NodeType -> a -> Cmd err [Int64]
) => NodeType -> a -> DBCmd err [Int64]
updateNodesWithType_ nt h = do
ns <- getNodesIdWithType nt
mapM (\n -> updateHyperdata n h) ns
......@@ -17,14 +17,14 @@ import Gargantext.Core
import Gargantext.Core.Types (Name)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..), defaultHyperdataUser)
import Gargantext.Database.Admin.Types.Node (Node, NodeId(..), UserId, NodeType(..), pgNodeId)
import Gargantext.Database.Prelude -- (fromField', Cmd)
import Gargantext.Database.Prelude (DBCmd, runOpaQuery)
import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Schema.Node -- (Node(..))
import Gargantext.Prelude
import Opaleye (limit)
getNodeUser :: NodeId -> Cmd err (Node HyperdataUser)
getNodeUser :: NodeId -> DBCmd err (Node HyperdataUser)
getNodeUser nId = do
fromMaybe (panic $ "Node does not exist: " <> (cs $ show nId)) . headMay
<$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
......
......@@ -46,25 +46,23 @@ module Gargantext.Database.Query.Table.NodeContext
import Control.Arrow (returnA)
import Control.Lens (view, (^.))
import Data.Maybe (catMaybes)
import Data.Time (UTCTime)
import Data.Text (Text, splitOn)
import Data.Time (UTCTime)
import Database.PostgreSQL.Simple qualified as PGS (In(..), Query, Only(..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Opaleye
import qualified Database.PostgreSQL.Simple as PGS (In(..), Query, Only(..))
import qualified Opaleye as O
import Gargantext.Core
import Gargantext.Core.Types
-- import Gargantext.Core.Types.Search (HyperdataRow(..), toHyperdataRow)
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Prelude (DBCmd, execPGSQuery, mkCmd, restrictMaybe, runCountOpaQuery, runPGSQuery, runOpaQuery)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError, NodeError(DoesNotExist), nodeError)
import Gargantext.Database.Prelude
import Gargantext.Prelude.Crypto.Hash (Hash)
import Gargantext.Database.Schema.Context
import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.NodeContext
import Gargantext.Prelude
import Gargantext.Prelude.Crypto.Hash (Hash)
import Opaleye
import Opaleye qualified as O
queryNodeContextTable :: Select NodeContextRead
queryNodeContextTable = selectTable nodeContextTable
......
......@@ -20,12 +20,12 @@ module Gargantext.Database.Query.Table.NodeContext_NodeContext
where
import Data.Text (Text)
import Database.PostgreSQL.Simple qualified as PGS
import Gargantext.Core.Types
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (DBCmd, runPGSQuery)
import Gargantext.Database.Schema.NodeContext_NodeContext
import Gargantext.Database.Schema.Prelude hiding (sum)
import Gargantext.Prelude
import qualified Database.PostgreSQL.Simple as PGS
{-
queryNodeContext_NodeContextTable :: Select NodeContext_NodeContextRead
......
......@@ -26,20 +26,20 @@ module Gargantext.Database.Query.Table.NodeNgrams
)
where
import Data.List qualified as List
import Data.List.Extra (nubOrd)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Database.PostgreSQL.Simple qualified as PGS (Query, Only(..))
import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (DBCmd, runPGSQuery)
import Gargantext.Database.Schema.Ngrams (NgramsType, ngramsTypeId, fromNgramsTypeId)
import Gargantext.Database.Schema.NodeNgrams
import Gargantext.Database.Schema.Prelude (Select, FromRow, sql, fromRow, toField, field, Values(..), QualifiedIdentifier(..), selectTable)
import Gargantext.Prelude
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
queryNodeNgramsTable :: Select NodeNgramsRead
......@@ -62,11 +62,9 @@ getCgramsId mapId nt t = case Map.lookup nt mapId of
Just mapId' -> Map.lookup t mapId'
-- insertDb :: ListId -> Map NgramsType [NgramsElement] -> Cmd err [Result]
listInsertDb :: Show a => ListId
-> (ListId -> a -> [NodeNgramsW])
-> a
-- -> Cmd err [Returning]
-> DBCmd err (Map NgramsType (Map Text Int))
listInsertDb l f ngs = Map.map Map.fromList
<$> Map.fromListWith (<>)
......
......@@ -35,20 +35,20 @@ module Gargantext.Database.Query.Table.NodeNode
import Control.Arrow (returnA)
import Control.Lens ((^.), view)
import Data.Text (Text, splitOn)
import Data.Maybe (catMaybes)
import Data.Text (Text, splitOn)
import Database.PostgreSQL.Simple qualified as PGS
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (DBCmd, mkCmd, runPGSQuery, runCountOpaQuery, runOpaQuery)
import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.NodeNode
import Gargantext.Prelude
import Opaleye
import qualified Database.PostgreSQL.Simple as PGS
import qualified Opaleye as O
import Opaleye qualified as O
queryNodeNodeTable :: Select NodeNodeRead
queryNodeNodeTable = selectTable nodeNodeTable
......
......@@ -23,7 +23,7 @@ module Gargantext.Database.Query.Table.NodeNodeNgrams
where
import Gargantext.Database.Admin.Types.Node (pgNodeId)
import Gargantext.Database.Prelude (Cmd, mkCmd)
import Gargantext.Database.Prelude (DBCmd, mkCmd)
import Gargantext.Database.Schema.Ngrams (pgNgramsTypeId)
import Gargantext.Database.Schema.NodeNodeNgrams
import Gargantext.Database.Schema.Prelude
......@@ -34,7 +34,7 @@ queryNodeNodeNgramsTable :: Query NodeNodeNgramsRead
queryNodeNodeNgramsTable = selectTable nodeNodeNgramsTable
-- | Insert utils
insertNodeNodeNgrams :: [NodeNodeNgrams] -> Cmd err Int
insertNodeNodeNgrams :: [NodeNodeNgrams] -> DBCmd err Int
insertNodeNodeNgrams = insertNodeNodeNgramsW
. map (\(NodeNodeNgrams n1 n2 ng nt w) ->
NodeNodeNgrams (pgNodeId n1)
......@@ -44,7 +44,7 @@ insertNodeNodeNgrams = insertNodeNodeNgramsW
(sqlDouble w)
)
insertNodeNodeNgramsW :: [NodeNodeNgramsWrite] -> Cmd err Int
insertNodeNodeNgramsW :: [NodeNodeNgramsWrite] -> DBCmd err Int
insertNodeNodeNgramsW nnnw =
mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing
where
......
......@@ -58,7 +58,7 @@ import Gargantext.Core.Types.Individu
import qualified Gargantext.Prelude.Crypto.Auth as Auth
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..), hu_pubmed_api_key)
import Gargantext.Database.Admin.Types.Node (NodeType(NodeUser), Node, NodeId(..), pgNodeId)
import Gargantext.Database.Prelude
import Gargantext.Database.Prelude (DBCmd, mkCmd, runOpaQuery)
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateNodeWithType)
import Gargantext.Database.Schema.Node (NodeRead, node_hyperdata, queryNodeTable, node_id, node_user_id, node_typename)
import Gargantext.Database.Schema.User
......@@ -76,14 +76,14 @@ insertUsers us = mkCmd $ \c -> runInsert c insert
where
insert = Insert userTable us rCount Nothing
deleteUsers :: [Username] -> Cmd err Int64
deleteUsers :: [Username] -> DBCmd err Int64
deleteUsers us = mkCmd $ \c -> runDelete_ c
$ Delete userTable
(\user -> in_ (map sqlStrictText us) (user_username user))
rCount
-- Updates email or password only (for now)
updateUserDB :: UserWrite -> Cmd err Int64
updateUserDB :: UserWrite -> DBCmd err Int64
updateUserDB us = mkCmd $ \c -> runUpdate_ c (updateUserQuery us)
where
updateUserQuery :: UserWrite -> Update Int64
......@@ -119,7 +119,7 @@ toUserWrite (NewUser u m (Auth.PasswordHash p)) =
, user_forgot_password_uuid = Nothing }
------------------------------------------------------------------
getUsersWith :: Username -> Cmd err [UserLight]
getUsersWith :: Username -> DBCmd err [UserLight]
getUsersWith u = map toUserLight <$> runOpaQuery (selectUsersLightWith u)
selectUsersLightWith :: Username -> Select UserRead
......@@ -128,7 +128,7 @@ selectUsersLightWith u = proc () -> do
restrict -< user_username row .== sqlStrictText u
returnA -< row
getUsersWithEmail :: Text -> Cmd err [UserLight]
getUsersWithEmail :: Text -> DBCmd err [UserLight]
getUsersWithEmail e = map toUserLight <$> runOpaQuery (selectUsersLightWithEmail e)
selectUsersLightWithEmail :: Text -> Select UserRead
......@@ -137,7 +137,7 @@ selectUsersLightWithEmail e = proc () -> do
restrict -< user_email row .== sqlStrictText e
returnA -< row
getUsersWithForgotPasswordUUID :: UUID.UUID -> Cmd err [UserLight]
getUsersWithForgotPasswordUUID :: UUID.UUID -> DBCmd err [UserLight]
getUsersWithForgotPasswordUUID uuid = map toUserLight <$> runOpaQuery (selectUsersLightWithForgotPasswordUUID uuid)
selectUsersLightWithForgotPasswordUUID :: UUID.UUID -> Select UserRead
......@@ -173,7 +173,7 @@ queryUserTable = selectTable userTable
----------------------------------------------------------------------
-- | Get hyperdata associated with user node.
getUserHyperdata :: User -> Cmd err [HyperdataUser]
getUserHyperdata :: User -> DBCmd err [HyperdataUser]
getUserHyperdata (RootId uId) = do
runOpaQuery (selectUserHyperdataWithId uId)
where
......@@ -195,7 +195,7 @@ getUserHyperdata _ = undefined
-- | Same as `getUserHyperdata` but returns a `Node` type.
getUserNodeHyperdata :: User -> Cmd err [Node HyperdataUser]
getUserNodeHyperdata :: User -> DBCmd err [Node HyperdataUser]
getUserNodeHyperdata (RootId uId) = do
runOpaQuery (selectUserHyperdataWithId uId)
where
......@@ -215,14 +215,14 @@ getUserNodeHyperdata (UserDBId uId) = do
returnA -< row
getUserNodeHyperdata _ = undefined
getUsersWithHyperdata :: User -> Cmd err [(UserLight, HyperdataUser)]
getUsersWithHyperdata :: User -> DBCmd err [(UserLight, HyperdataUser)]
getUsersWithHyperdata i = do
u <- getUsersWithId i
h <- getUserHyperdata i
-- printDebug "[getUsersWithHyperdata]" (u,h)
pure $ zip u h
getUsersWithNodeHyperdata :: User -> Cmd err [(UserLight, Node HyperdataUser)]
getUsersWithNodeHyperdata :: User -> DBCmd err [(UserLight, Node HyperdataUser)]
getUsersWithNodeHyperdata i = do
u <- getUsersWithId i
h <- getUserNodeHyperdata i
......@@ -230,7 +230,7 @@ getUsersWithNodeHyperdata i = do
pure $ zip u h
updateUserEmail :: UserLight -> Cmd err Int64
updateUserEmail :: UserLight -> DBCmd err Int64
updateUserEmail (UserLight { .. }) = mkCmd $ \c -> runUpdate_ c updateUserQuery
where
updateUserQuery :: Update Int64
......@@ -240,7 +240,7 @@ updateUserEmail (UserLight { .. }) = mkCmd $ \c -> runUpdate_ c updateUserQuery
, uWhere = (\row -> user_id row .== (sqlInt4 userLight_id))
, uReturning = rCount }
updateUserPassword :: UserLight -> Cmd err Int64
updateUserPassword :: UserLight -> DBCmd err Int64
updateUserPassword (UserLight { userLight_password = GargPassword password, .. }) = mkCmd $ \c -> runUpdate_ c updateUserQuery
where
updateUserQuery :: Update Int64
......@@ -250,7 +250,7 @@ updateUserPassword (UserLight { userLight_password = GargPassword password, .. }
, uWhere = \row -> user_id row .== sqlInt4 userLight_id
, uReturning = rCount }
updateUserForgotPasswordUUID :: UserLight -> Cmd err Int64
updateUserForgotPasswordUUID :: UserLight -> DBCmd err Int64
updateUserForgotPasswordUUID (UserLight { .. }) = mkCmd $ \c -> runUpdate_ c updateUserQuery
where
pass = sqlStrictText $ fromMaybe "" userLight_forgot_password_uuid
......@@ -261,7 +261,7 @@ updateUserForgotPasswordUUID (UserLight { .. }) = mkCmd $ \c -> runUpdate_ c upd
, uWhere = \row -> user_id row .== sqlInt4 userLight_id
, uReturning = rCount }
getUserPubmedAPIKey :: User -> Cmd err (Maybe PUBMED.APIKey)
getUserPubmedAPIKey :: User -> DBCmd err (Maybe PUBMED.APIKey)
getUserPubmedAPIKey user = do
hs <- getUserHyperdata user
case hs of
......@@ -269,7 +269,7 @@ getUserPubmedAPIKey user = do
(x:_) -> pure $ _hu_pubmed_api_key x
updateUserPubmedAPIKey :: (HasDBid NodeType, HasNodeError err)
=> User -> PUBMED.APIKey -> Cmd err Int64
=> User -> PUBMED.APIKey -> DBCmd err Int64
updateUserPubmedAPIKey (RootId uId) apiKey = do
_ <- updateNodeWithType uId NodeUser (Proxy :: Proxy HyperdataUser) (\h -> h & hu_pubmed_api_key ?~ apiKey)
pure 1
......@@ -303,7 +303,7 @@ getUser :: Username -> DBCmd err (Maybe UserLight)
getUser u = userLightWithUsername u <$> usersLight
----------------------------------------------------------------------
insertNewUsers :: [NewUser GargPassword] -> Cmd err Int64
insertNewUsers :: [NewUser GargPassword] -> DBCmd err Int64
insertNewUsers newUsers = do
users' <- liftBase $ mapM toUserHash newUsers
insertUsers $ map toUserWrite users'
......
......@@ -60,7 +60,7 @@ import Gargantext.Core.Types.Main (NodeTree(..), Tree(..))
import Gargantext.Database.Admin.Config (fromNodeTypeId, nodeTypeId, fromNodeTypeId)
import Gargantext.Database.Admin.Types.Hyperdata.Any (HyperdataAny)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd, runPGSQuery, DBCmd)
import Gargantext.Database.Prelude (runPGSQuery, DBCmd)
import Gargantext.Database.Query.Table.Node (getNodeWith)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.NodeNode (getNodeNode)
......@@ -89,7 +89,7 @@ tree :: (HasTreeError err, HasNodeError err)
=> TreeMode
-> RootId
-> [NodeType]
-> Cmd err (Tree NodeTree)
-> DBCmd err (Tree NodeTree)
tree TreeBasic = tree_basic
tree TreeAdvanced = tree_advanced
tree TreeFirstLevel = tree_first_level
......@@ -100,7 +100,7 @@ tree TreeFirstLevel = tree_first_level
tree_basic :: (HasTreeError err, HasNodeError err)
=> RootId
-> [NodeType]
-> Cmd err (Tree NodeTree)
-> DBCmd err (Tree NodeTree)
tree_basic r nodeTypes =
(dbTree r nodeTypes <&> toTreeParent) >>= toTree
-- Same as (but easier to read) :
......@@ -110,7 +110,7 @@ tree_basic r nodeTypes =
tree_advanced :: (HasTreeError err, HasNodeError err)
=> RootId
-> [NodeType]
-> Cmd err (Tree NodeTree)
-> DBCmd err (Tree NodeTree)
tree_advanced r nodeTypes = do
-- let rPrefix s = "[tree_advanced] root = " <> show r <> " " <> s
mainRoot <- findNodes r Private nodeTypes
......@@ -128,7 +128,7 @@ tree_advanced r nodeTypes = do
tree_first_level :: (HasTreeError err, HasNodeError err)
=> RootId
-> [NodeType]
-> Cmd err (Tree NodeTree)
-> DBCmd err (Tree NodeTree)
tree_first_level r nodeTypes = do
-- let rPrefix s = mconcat [ "[tree_first_level] root = "
-- , show r
......@@ -151,7 +151,7 @@ tree_flat :: (HasTreeError err, HasNodeError err)
=> RootId
-> [NodeType]
-> Maybe Text
-> Cmd err [NodeTree]
-> DBCmd err [NodeTree]
tree_flat r nodeTypes q = do
mainRoot <- findNodes r Private nodeTypes
publicRoots <- findNodes r Public nodeTypes
......@@ -169,7 +169,7 @@ findNodes :: (HasTreeError err, HasNodeError err)
=> RootId
-> NodeMode
-> [NodeType]
-> Cmd err [DbTreeNode]
-> DBCmd err [DbTreeNode]
findNodes r Private nt = dbTree r nt
findNodes r Shared nt = findShared r NodeFolderShared nt sharedTreeUpdate
findNodes r SharedDirect nt = findSharedDirect r NodeFolderShared nt sharedTreeUpdate
......@@ -181,7 +181,7 @@ findNodes r PublicDirect nt = findSharedDirect r NodeFolderPublic nt publicTree
-- Queries the `nodes_nodes` table.
findShared :: HasTreeError err
=> RootId -> NodeType -> [NodeType] -> UpdateTree err
-> Cmd err [DbTreeNode]
-> DBCmd err [DbTreeNode]
findShared r nt nts fun = do
foldersSharedId <- findNodesId r [nt]
trees <- mapM (updateTree nts fun) foldersSharedId
......@@ -192,7 +192,7 @@ findShared r nt nts fun = do
-- and get the tree for its parent.
findSharedDirect :: (HasTreeError err, HasNodeError err)
=> RootId -> NodeType -> [NodeType] -> UpdateTree err
-> Cmd err [DbTreeNode]
-> DBCmd err [DbTreeNode]
findSharedDirect r nt nts fun = do
-- let rPrefix s = mconcat [ "[findSharedDirect] r = "
-- , show r
......@@ -214,11 +214,11 @@ findSharedDirect r nt nts fun = do
pure $ concat trees
type UpdateTree err = ParentId -> [NodeType] -> NodeId -> Cmd err [DbTreeNode]
type UpdateTree err = ParentId -> [NodeType] -> NodeId -> DBCmd err [DbTreeNode]
updateTree :: HasTreeError err
=> [NodeType] -> UpdateTree err -> RootId
-> Cmd err [DbTreeNode]
-> DBCmd err [DbTreeNode]
updateTree nts fun r = do
folders <- getNodeNode r
nodesSharedId <- mapM (fun r nts)
......@@ -245,12 +245,12 @@ publicTreeUpdate p nt n = dbTree n nt
-- | findNodesId returns all nodes matching nodeType but the root (Nodeuser)
findNodesId :: RootId -> [NodeType] -> Cmd err [NodeId]
findNodesId :: RootId -> [NodeType] -> DBCmd err [NodeId]
findNodesId r nt = tail
<$> map _dt_nodeId
<$> dbTree r nt
findNodesWithType :: RootId -> [NodeType] -> [NodeType] -> Cmd err [DbTreeNode]
findNodesWithType :: RootId -> [NodeType] -> [NodeType] -> DBCmd err [DbTreeNode]
findNodesWithType root target through =
filter isInTarget <$> dbTree root through
where
......@@ -331,7 +331,7 @@ toSubtreeParent r ns = fromListWith (\a b -> nub $ a <> b) . map (\n -> (_dt_par
-- | Main DB Tree function
dbTree :: RootId
-> [NodeType]
-> Cmd err [DbTreeNode]
-> DBCmd err [DbTreeNode]
dbTree rootId nodeTypes = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n)
<$> runPGSQuery [sql|
WITH RECURSIVE
......@@ -383,7 +383,7 @@ isDescendantOf childId rootId = (== [Only True])
|] (childId, rootId)
-- TODO should we check the category?
isIn :: NodeId -> DocId -> Cmd err Bool
isIn :: NodeId -> DocId -> DBCmd err Bool
isIn cId docId = ( == [Only True])
<$> runPGSQuery [sql| SELECT COUNT(*) = 1
FROM nodes_nodes nn
......@@ -393,8 +393,8 @@ isIn cId docId = ( == [Only True])
-- Recursive parents function to construct a breadcrumb
recursiveParents :: NodeId
-> [NodeType]
-> Cmd err [DbTreeNode]
-> [NodeType]
-> DBCmd err [DbTreeNode]
recursiveParents nodeId nodeTypes = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n)
<$> runPGSQuery [sql|
WITH RECURSIVE recursiveParents AS
......
......@@ -34,6 +34,7 @@ import Gargantext.API.Prelude
import Gargantext.Core.Mail.Types (HasMail(..))
import Gargantext.Core.NLP (HasNLPServer(..))
import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Prelude (HasConfig(..), HasConnectionPool(..))
import Gargantext.Prelude.Config
import Gargantext.Prelude.Mail.Types (MailConfig(..), LoginType(NoAuth))
import Gargantext.System.Logging (HasLogger(..), Logger, MonadLogger(..))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment