Skip to content

haskell-gargantext
haskell-gargantext
Verified Commit 8d3f7def authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[refactor] simplify types 

- DBCmd instead of Cmd
- remove FlowCmdM in favor of HasNodeStory
parent a7375084
Pipeline #5229 failed with stages
          in 67 minutes and 9 seconds
          Hide whitespace changes
          Inline Side-by-side
          Showing with 130 additions and 137 deletions
          src/Gargantext/API/Metrics.hs
          View file @ 8d3f7def
          ......@@ -190,7 +190,7 @@ updateChart :: HasNodeError err =>
          -> Maybe ListId
          -> TabType
          -> Maybe Limit
          -> Cmd err ()
          -> DBCmd err ()
          updateChart cId maybeListId tabType maybeLimit = do
          printDebug "[updateChart] cId" cId
          printDebug "[updateChart] maybeListId" maybeListId
          ......@@ -204,7 +204,7 @@ updateChart' :: HasNodeError err =>
          -> Maybe ListId
          -> TabType
          -> Maybe Limit
          -> Cmd err (ChartMetrics Histo)
          -> DBCmd err (ChartMetrics Histo)
          updateChart' cId maybeListId tabType _maybeLimit = do
          listId <- case maybeListId of
          Just lid -> pure lid
          ......
          src/Gargantext/API/Node/Update.hs
          View file @ 8d3f7def
          ......@@ -28,6 +28,7 @@ import Gargantext.API.Admin.Types (HasSettings)
          --import Gargantext.API.Ngrams.Types (TabType(..))
          import Gargantext.API.Prelude (GargM, GargError, simuLogs)
          import Gargantext.Core.Methods.Similarities (GraphMetric(..))
          import Gargantext.Core.NodeStory (HasNodeStory)
          import Gargantext.Core.Types.Main (ListType(..))
          import Gargantext.Core.Viz.Graph.API (recomputeGraph)
          import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..), BridgenessMethod(..))
          ......@@ -196,13 +197,13 @@ updateNode _uId _nId _p jobHandle = do
          simuLogs jobHandle 10
          ------------------------------------------------------------------------
          updateDocs :: (FlowCmdM env err m, MonadJobStatus m)
          updateDocs :: (HasNodeStory env err m)
          => NodeId -> m ()
          updateDocs cId = do
          lId <- defaultList cId
          _ <- reIndexWith cId lId NgramsTerms (Set.singleton MapTerm)
          _ <- updateNgramsOccurrences cId (Just lId)
          _ <- updateContextScore cId (Just lId)
          _ <- updateContextScore cId lId
          _ <- Metrics.updateChart cId (Just lId) NgramsTypes.Docs Nothing
          -- printDebug "updateContextsScore" (cId, lId, u)
          pure ()
          ......
          src/Gargantext/Core/NodeStory.hs
          View file @ 8d3f7def
          ......@@ -117,7 +117,7 @@ import Gargantext.API.Ngrams.Types
          import Gargantext.Core.Types (ListId, NodeId(..), NodeType)
          import Gargantext.Core.Utils.Prefix (unPrefix)
          import Gargantext.Database.Admin.Config (nodeTypeId)
          import Gargantext.Database.Prelude (CmdM', HasConnectionPool(..), HasConfig)
          import Gargantext.Database.Prelude (DbCmd', HasConnectionPool(..))
          import Gargantext.Database.Query.Table.Node.Error (HasNodeError())
          import Gargantext.Database.Schema.Ngrams (NgramsType)
          import Gargantext.Prelude
          ......@@ -143,12 +143,10 @@ data NodeStoryEnv = NodeStoryEnv
          }
          deriving (Generic)
          type HasNodeStory env err m = ( CmdM' env err m
          type HasNodeStory env err m = ( DbCmd' env err m
          , MonadReader env m
          , MonadError err m
          , HasNodeStoryEnv env
          , HasConfig env
          , HasConnectionPool env
          , HasNodeError err
          )
          ......
          src/Gargantext/Core/Viz/Chart.hs
          View file @ 8d3f7def
          ......@@ -14,12 +14,15 @@ Portability : POSIX
          module Gargantext.Core.Viz.Chart
          where
          import Data.HashMap.Strict qualified as HashMap
          import Data.List (sortOn)
          import Data.List qualified as List
          import Data.Map.Strict (toList)
          import qualified Data.List as List
          import Data.Maybe (catMaybes)
          import qualified Data.Vector as V
          import Data.Vector qualified as V
          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
          ......@@ -28,21 +31,18 @@ import Gargantext.Database.Query.Table.Node.Select
          import Gargantext.Database.Query.Table.NodeContext (selectDocsDates)
          import Gargantext.Database.Schema.Node
          import Gargantext.Prelude
          import Gargantext.Core.Text.Metrics.Count (occurrencesWith)
          -- Pie Chart
          import Gargantext.API.Ngrams.NgramsTree
          import Gargantext.API.Ngrams.Tools
          import Gargantext.API.Ngrams.Types
          import Gargantext.Core.Types
          import Gargantext.Database.Action.Flow.Types
          import Gargantext.Database.Action.Metrics.NgramsByContext
          import Gargantext.Database.Schema.Ngrams
          import Gargantext.Core.Viz.Types
          import qualified Data.HashMap.Strict as HashMap
          histoData :: CorpusId -> Cmd err Histo
          histoData :: CorpusId -> DBCmd err Histo
          histoData cId = do
          dates <- selectDocsDates cId
          let (ls, css) = V.unzip
          ......@@ -53,9 +53,9 @@ histoData cId = do
          pure (Histo ls css)
          chartData :: FlowCmdM env err m
          => CorpusId -> NgramsType -> ListType
          -> m Histo
          chartData :: HasNodeStory env err m
          => CorpusId -> NgramsType -> ListType
          -> m Histo
          chartData cId nt lt = do
          ls' <- selectNodesWithUsername NodeList userMaster
          ls <- map (_node_id) <$> getListsWithParentId cId
          ......@@ -77,7 +77,7 @@ chartData cId nt lt = do
          pure (Histo dates (round <$> count))
          treeData :: FlowCmdM env err m
          treeData :: HasNodeStory env err m
          => CorpusId -> NgramsType -> ListType
          -> m (V.Vector NgramsTree)
          treeData cId nt lt = do
          ......
          src/Gargantext/Database/Action/Flow.hs
          View file @ 8d3f7def
          ......@@ -384,7 +384,7 @@ flowCorpusUser l user userCorpusId listId ctype mfslw = do
          -- Annuaire Flow
          -- _ <- mkAnnuaire rootUserId userId
          _ <- reIndexWith userCorpusId listId NgramsTerms (Set.singleton MapTerm)
          _ <- updateContextScore userCorpusId (Just listId)
          _ <- updateContextScore userCorpusId listId
          _ <- updateNgramsOccurrences userCorpusId (Just listId)
          pure userCorpusId
          ......@@ -624,9 +624,7 @@ extractInsert docs = do
          -- | Re-index documents of a corpus with ngrams in the list
          reIndexWith :: ( HasNodeStory env err m
          , FlowCmdM env err m
          )
          reIndexWith :: ( HasNodeStory env err m )
          => CorpusId
          -> ListId
          -> NgramsType
          ......
          src/Gargantext/Database/Action/Metrics.hs
          View file @ 8d3f7def
          ......@@ -15,36 +15,35 @@ Node API
          module Gargantext.Database.Action.Metrics
          where
          import Database.PostgreSQL.Simple.SqlQQ (sql)
          -- import Gargantext.Database.Action.Metrics.NgramsByContext (refreshNgramsMaterialized)
          import Data.HashMap.Strict (HashMap)
          import Data.HashMap.Strict qualified as HM
          import Data.List qualified as List
          import Data.Map.Strict (Map)
          import Data.Map.Strict qualified as Map
          import Data.Set (Set)
          import Data.Set qualified as Set
          import Data.Text qualified as Text
          import Data.Vector (Vector)
          import Database.PostgreSQL.Simple (Query, Only(..))
          import Database.PostgreSQL.Simple.SqlQQ (sql)
          import Database.PostgreSQL.Simple.ToField (toField, Action{-, ToField-})
          import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
          import Data.Vector (Vector)
          import Gargantext.Core (HasDBid(toDBid))
          import Gargantext.API.Ngrams.Tools (filterListWithRoot, groupNodesByNgrams, Diagonal(..), getCoocByNgrams, mapTermListRoot, RootTerm, getRepo)
          import Gargantext.Database.Prelude (runPGSQuery{-, formatPGSQuery-})
          import Gargantext.API.Ngrams.Types (TabType(..), ngramsTypeFromTabType, NgramsTerm(..))
          import Gargantext.Core.Mail.Types (HasMail)
          import Gargantext.Core (HasDBid(toDBid))
          import Gargantext.Core.NodeStory hiding (runPGSQuery)
          import Gargantext.Core.Text.Metrics (scored, Scored(..), {-localMetrics, toScored-})
          import Database.PostgreSQL.Simple.ToField (toField, Action{-, ToField-})
          import Gargantext.Core.Types (ListType(..), NodeType(..), ContextId)
          import Gargantext.Core.Types.Query (Limit(..))
          import Gargantext.Database.Action.Flow.Types (FlowCmdM)
          import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOnlyUser{-, getTficfWith-})
          import Gargantext.Database.Admin.Config (userMaster)
          -- import Gargantext.Database.Action.Metrics.NgramsByContext (refreshNgramsMaterialized)
          import Gargantext.Database.Admin.Types.Node (ListId, CorpusId)
          import Gargantext.Database.Prelude (runPGSQuery{-, formatPGSQuery-})
          import Gargantext.Database.Query.Table.Node (defaultList)
          import Gargantext.Database.Query.Table.Node.Select
          import Gargantext.Prelude
          import qualified Data.HashMap.Strict as HM
          import qualified Data.Map.Strict as Map
          import qualified Data.Set as Set
          import qualified Data.List as List
          import qualified Data.Text as Text
          getMetrics :: FlowCmdM env err m
          => CorpusId -> Maybe ListId -> TabType -> Maybe Limit
          ......@@ -81,17 +80,17 @@ getNgramsCooc cId maybeListId tabType maybeLimit = do
          ------------------------------------------------------------------------
          ------------------------------------------------------------------------
          updateNgramsOccurrences :: (FlowCmdM env err m)
          => CorpusId -> Maybe ListId
          -> m ()
          updateNgramsOccurrences :: (HasNodeStory env err m)
          => CorpusId -> Maybe ListId
          -> m ()
          updateNgramsOccurrences cId mlId = do
          _ <- mapM (updateNgramsOccurrences' cId mlId Nothing) [Terms, Sources, Authors, Institutes]
          pure ()
          updateNgramsOccurrences' :: (FlowCmdM env err m)
          => CorpusId -> Maybe ListId -> Maybe Limit -> TabType
          -> m [Int]
          updateNgramsOccurrences' :: (HasNodeStory env err m)
          => CorpusId -> Maybe ListId -> Maybe Limit -> TabType
          -> m [Int]
          updateNgramsOccurrences' cId maybeListId maybeLimit tabType = do
          lId <- case maybeListId of
          ......@@ -136,16 +135,16 @@ updateNgramsOccurrences' cId maybeListId maybeLimit tabType = do
          ------------------------------------------------------------------------
          -- Used for scores in Ngrams Table
          getNgramsOccurrences :: (FlowCmdM env err m)
          => CorpusId -> ListId -> TabType -> Maybe Limit
          -> m (HashMap NgramsTerm Int)
          getNgramsOccurrences :: (HasNodeStory env err m)
          => CorpusId -> ListId -> TabType -> Maybe Limit
          -> m (HashMap NgramsTerm Int)
          getNgramsOccurrences c l t ml = HM.map Set.size <$> getNgramsContexts c l t ml
          getNgramsContexts :: (FlowCmdM env err m)
          => CorpusId -> ListId -> TabType -> Maybe Limit
          -> m (HashMap NgramsTerm (Set ContextId))
          getNgramsContexts :: (HasNodeStory env err m)
          => CorpusId -> ListId -> TabType -> Maybe Limit
          -> m (HashMap NgramsTerm (Set ContextId))
          getNgramsContexts cId lId tabType maybeLimit = do
          (_ngs', ngs) <- getNgrams lId tabType
          lIds <- selectNodesWithUsername NodeList userMaster
          ......@@ -159,14 +158,10 @@ getNgramsContexts cId lId tabType maybeLimit = do
          ------------------------------------------------------------------------
          updateContextScore :: (FlowCmdM env err m)
          => CorpusId -> Maybe ListId
          -> m [Int]
          updateContextScore cId maybeListId = do
          lId <- case maybeListId of
          Nothing -> defaultList cId
          Just lId' -> pure lId'
          updateContextScore :: (HasNodeStory env err m)
          => CorpusId -> ListId
          -> m [Int]
          updateContextScore cId lId = do
          result <- getContextsNgramsScore cId lId Terms MapTerm Nothing
          ......@@ -200,15 +195,17 @@ updateContextScore cId maybeListId = do
          -- Used for scores in Doc Table
          getContextsNgramsScore :: (FlowCmdM env err m)
          => CorpusId -> ListId -> TabType -> ListType -> Maybe Limit
          -> m (Map ContextId Int)
          getContextsNgramsScore :: --(FlowCmdM env err m)
          (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)
          => CorpusId -> ListId -> TabType -> ListType -> Maybe Limit
          -> m (Map ContextId (Set NgramsTerm))
          getContextsNgrams :: --(FlowCmdM env err m)
          (HasNodeStory env err m)
          => CorpusId -> ListId -> TabType -> ListType -> Maybe Limit
          -> m (Map ContextId (Set NgramsTerm))
          getContextsNgrams cId lId tabType listType maybeLimit = do
          (ngs', ngs) <- getNgrams lId tabType
          lIds <- selectNodesWithUsername NodeList userMaster
          ......@@ -232,7 +229,7 @@ getContextsNgrams cId lId tabType listType maybeLimit = do
          ------------------------------------------------------------------------
          getNgrams :: (HasMail env, HasNodeStory env err m)
          getNgrams :: (HasNodeStory env err m)
          => ListId -> TabType
          -> m ( HashMap NgramsTerm (ListType, Maybe NgramsTerm)
          , HashMap NgramsTerm (Maybe RootTerm)
          ......
          src/Gargantext/Database/Action/Metrics/NgramsByContext.hs
          View file @ 8d3f7def
          ......@@ -20,25 +20,25 @@ module Gargantext.Database.Action.Metrics.NgramsByContext
          --import Data.Map.Strict.Patch (PatchMap, Replace, diff)
          -- import Control.Monad (void)
          import Data.HashMap.Strict (HashMap)
          import Data.HashMap.Strict qualified as HM
          import Data.List qualified as List
          import Data.Map.Strict (Map)
          import Data.Map.Strict qualified as Map
          import Data.Set (Set)
          import Data.Set qualified as Set
          import Data.Text (Text)
          import Data.Tuple.Extra (first, second, swap)
          import Database.PostgreSQL.Simple qualified as DPS
          import Database.PostgreSQL.Simple.SqlQQ (sql)
          import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
          import Database.PostgreSQL.Simple.Types qualified as DPST
          import Gargantext.API.Ngrams.Types (NgramsTerm(..))
          import Gargantext.Core
          import Gargantext.Data.HashMap.Strict.Utils as HM
          import Gargantext.Database.Admin.Types.Node (ListId, CorpusId, NodeId(..), ContextId, MasterCorpusId, NodeType(NodeDocument), UserCorpusId, DocId)
          import Gargantext.Database.Prelude (Cmd, runPGSQuery) -- , execPGSQuery)
          import Gargantext.Database.Prelude (DBCmd, runPGSQuery) -- , execPGSQuery)
          import Gargantext.Database.Schema.Ngrams (ngramsTypeId, NgramsType(..))
          import Gargantext.Prelude
          import qualified Data.HashMap.Strict as HM
          import qualified Data.List as List
          import qualified Data.Map.Strict as Map
          import qualified Data.Set as Set
          import qualified Database.PostgreSQL.Simple as DPS
          import qualified Database.PostgreSQL.Simple.Types as DPST
          -- | fst is size of Supra Corpus
          -- snd is Texts and size of Occurrences (different docs)
          ......@@ -61,10 +61,10 @@ countContextsByNgramsWith f m = (total, m')
          $ HM.toList m''
          ------------------------------------------------------------------------
          getContextsByNgramsUser :: HasDBid NodeType
          getContextsByNgramsUser :: HasDBid NodeType
          => CorpusId
          -> NgramsType
          -> Cmd err (HashMap NgramsTerm (Set ContextId))
          -> DBCmd err (HashMap NgramsTerm (Set ContextId))
          getContextsByNgramsUser cId nt =
          HM.fromListWith (<>) <$> map (\(n,t) -> (NgramsTerm t, Set.singleton n))
          <$> selectNgramsByContextUser cId nt
          ......@@ -73,7 +73,7 @@ getContextsByNgramsUser cId nt =
          selectNgramsByContextUser :: HasDBid NodeType
          => CorpusId
          -> NgramsType
          -> Cmd err [(NodeId, Text)]
          -> DBCmd err [(NodeId, Text)]
          selectNgramsByContextUser cId' nt' =
          runPGSQuery queryNgramsByContextUser
          ( cId'
          ......@@ -99,11 +99,11 @@ getContextsByNgramsUser cId nt =
          ------------------------------------------------------------------------
          getOccByNgramsOnlyFast_withSample :: HasDBid NodeType
          => CorpusId
          -> Int
          -> NgramsType
          -> [NgramsTerm]
          -> Cmd err (HashMap NgramsTerm Int)
          => CorpusId
          -> Int
          -> NgramsType
          -> [NgramsTerm]
          -> DBCmd err (HashMap NgramsTerm Int)
          getOccByNgramsOnlyFast_withSample cId int nt ngs =
          HM.fromListWith (+) <$> selectNgramsOccurrencesOnlyByContextUser_withSample cId int nt ngs
          ......@@ -111,7 +111,7 @@ getOccByNgramsOnlyFast_withSample cId int nt ngs =
          getOccByNgramsOnlyFast :: CorpusId
          -> ListId
          -> NgramsType
          -> Cmd err (HashMap NgramsTerm [ContextId])
          -> DBCmd err (HashMap NgramsTerm [ContextId])
          getOccByNgramsOnlyFast cId lId nt = do
          --HM.fromList <$> map (\(t,n) -> (NgramsTerm t, round n)) <$> run cId lId nt
          HM.fromList <$> map (\(t, ns) -> (NgramsTerm t, NodeId <$> DPST.fromPGArray ns)) <$> run cId lId nt
          ......@@ -120,7 +120,7 @@ getOccByNgramsOnlyFast cId lId nt = do
          run :: CorpusId
          -> ListId
          -> NgramsType
          -> Cmd err [(Text, DPST.PGArray Int)]
          -> DBCmd err [(Text, DPST.PGArray Int)]
          run cId' lId' nt' = runPGSQuery query
          ( cId'
          , lId'
          ......@@ -179,11 +179,11 @@ getOccByNgramsOnlyFast cId lId nt = do
          selectNgramsOccurrencesOnlyByContextUser_withSample :: HasDBid NodeType
          => CorpusId
          -> Int
          -> NgramsType
          -> [NgramsTerm]
          -> Cmd err [(NgramsTerm, Int)]
          => CorpusId
          -> Int
          -> NgramsType
          -> [NgramsTerm]
          -> DBCmd err [(NgramsTerm, Int)]
          selectNgramsOccurrencesOnlyByContextUser_withSample cId int nt tms =
          fmap (first NgramsTerm) <$>
          runPGSQuery queryNgramsOccurrencesOnlyByContextUser_withSample
          ......@@ -216,10 +216,10 @@ queryNgramsOccurrencesOnlyByContextUser_withSample = [sql|
          |]
          selectNgramsOccurrencesOnlyByContextUser_withSample' :: HasDBid NodeType
          => CorpusId
          -> Int
          -> NgramsType
          -> Cmd err [(NgramsTerm, Int)]
          => CorpusId
          -> Int
          -> NgramsType
          -> DBCmd err [(NgramsTerm, Int)]
          selectNgramsOccurrencesOnlyByContextUser_withSample' cId int nt =
          fmap (first NgramsTerm) <$>
          runPGSQuery queryNgramsOccurrencesOnlyByContextUser_withSample
          ......@@ -253,7 +253,7 @@ getContextsByNgramsOnlyUser :: HasDBid NodeType
          -> [ListId]
          -> NgramsType
          -> [NgramsTerm]
          -> Cmd err (HashMap NgramsTerm (Set NodeId))
          -> DBCmd err (HashMap NgramsTerm (Set NodeId))
          getContextsByNgramsOnlyUser cId ls nt ngs =
          HM.unionsWith (<>)
          . map (HM.fromListWith (<>)
          ......@@ -262,11 +262,11 @@ getContextsByNgramsOnlyUser cId ls nt ngs =
          (splitEvery 1000 ngs)
          getNgramsByContextOnlyUser :: HasDBid NodeType
          => NodeId
          -> [ListId]
          -> NgramsType
          -> [NgramsTerm]
          -> Cmd err (Map NodeId (Set NgramsTerm))
          => NodeId
          -> [ListId]
          -> NgramsType
          -> [NgramsTerm]
          -> DBCmd err (Map NodeId (Set NgramsTerm))
          getNgramsByContextOnlyUser cId ls nt ngs =
          Map.unionsWith (<>)
          . map ( Map.fromListWith (<>)
          ......@@ -282,7 +282,7 @@ selectNgramsOnlyByContextUser :: HasDBid NodeType
          -> [ListId]
          -> NgramsType
          -> [NgramsTerm]
          -> Cmd err [(NgramsTerm, ContextId)]
          -> DBCmd err [(NgramsTerm, ContextId)]
          selectNgramsOnlyByContextUser cId ls nt tms =
          fmap (first NgramsTerm) <$>
          runPGSQuery queryNgramsOnlyByContextUser
          ......@@ -317,7 +317,7 @@ getNgramsByDocOnlyUser :: DocId
          -> [ListId]
          -> NgramsType
          -> [NgramsTerm]
          -> Cmd err (HashMap NgramsTerm (Set NodeId))
          -> DBCmd err (HashMap NgramsTerm (Set NodeId))
          getNgramsByDocOnlyUser cId ls nt ngs =
          HM.unionsWith (<>)
          . map (HM.fromListWith (<>) . map (second Set.singleton))
          ......@@ -328,7 +328,7 @@ selectNgramsOnlyByDocUser :: DocId
          -> [ListId]
          -> NgramsType
          -> [NgramsTerm]
          -> Cmd err [(NgramsTerm, NodeId)]
          -> DBCmd err [(NgramsTerm, NodeId)]
          selectNgramsOnlyByDocUser dId ls nt tms =
          fmap (first NgramsTerm) <$>
          runPGSQuery queryNgramsOnlyByDocUser
          ......@@ -360,7 +360,7 @@ queryNgramsOnlyByDocUser = [sql|
          getContextsByNgramsMaster :: HasDBid NodeType
          => UserCorpusId
          -> MasterCorpusId
          -> Cmd err (HashMap Text (Set NodeId))
          -> DBCmd err (HashMap Text (Set NodeId))
          getContextsByNgramsMaster ucId mcId = unionsWith (<>)
          . map (HM.fromListWith (<>) . map (\(n,t) -> (t, Set.singleton n)))
          -- . takeWhile (not . List.null)
          ......@@ -368,11 +368,11 @@ getContextsByNgramsMaster ucId mcId = unionsWith (<>)
          <$> mapM (selectNgramsByContextMaster 1000 ucId mcId) [0,500..10000]
          selectNgramsByContextMaster :: HasDBid NodeType
          => Int
          -> UserCorpusId
          -> MasterCorpusId
          -> Int
          -> Cmd err [(NodeId, Text)]
          => Int
          -> UserCorpusId
          -> MasterCorpusId
          -> Int
          -> DBCmd err [(NodeId, Text)]
          selectNgramsByContextMaster n ucId mcId p = runPGSQuery
          queryNgramsByContextMaster'
          ( ucId
          ......
          src/Gargantext/Database/Query/Table/Node/Select.hs
          View file @ 8d3f7def
          ......@@ -27,7 +27,7 @@ import Gargantext.Database.Schema.Node
          import Gargantext.Database.Schema.User
          import Gargantext.Database.Query.Table.User
          selectNodesWithUsername :: (HasDBid NodeType) => NodeType -> Username -> Cmd err [NodeId]
          selectNodesWithUsername :: (HasDBid NodeType) => NodeType -> Username -> DBCmd err [NodeId]
          selectNodesWithUsername nt u = runOpaQuery $ proc () -> do
          n <- queryNodeTable -< ()
          usrs <- optionalRestrict queryUserTable -<
          ......
          src/Gargantext/Database/Query/Table/NodeContext.hs
          View file @ 8d3f7def
          ......@@ -70,12 +70,12 @@ queryNodeContextTable :: Select NodeContextRead
          queryNodeContextTable = selectTable nodeContextTable
          -- | not optimized (get all ngrams without filters)
          _nodesContexts :: Cmd err [NodeContext]
          _nodesContexts :: DBCmd err [NodeContext]
          _nodesContexts = runOpaQuery queryNodeContextTable
          ------------------------------------------------------------------------
          -- | Basic NodeContext tools
          getNodeContexts :: NodeId -> Cmd err [NodeContext]
          getNodeContexts :: NodeId -> DBCmd err [NodeContext]
          getNodeContexts n = runOpaQuery (selectNodeContexts $ pgNodeId n)
          where
          selectNodeContexts :: Field SqlInt4 -> Select NodeContextRead
          ......@@ -85,7 +85,7 @@ getNodeContexts n = runOpaQuery (selectNodeContexts $ pgNodeId n)
          returnA -< ns
          getNodeContext :: HasNodeError err => ContextId -> NodeId -> Cmd err NodeContext
          getNodeContext :: HasNodeError err => ContextId -> NodeId -> DBCmd err NodeContext
          getNodeContext c n = do
          maybeNodeContext <- headMay <$> runOpaQuery (selectNodeContext (pgNodeId c) (pgNodeId n))
          case maybeNodeContext of
          ......@@ -99,7 +99,7 @@ getNodeContext c n = do
          restrict -< _nc_node_id ns .== n'
          returnA -< ns
          updateNodeContextCategory :: ContextId -> NodeId -> Int -> Cmd err Int64
          updateNodeContextCategory :: ContextId -> NodeId -> Int -> DBCmd err Int64
          updateNodeContextCategory cId nId cat = do
          execPGSQuery upScore (cat, cId, nId)
          where
          ......@@ -120,7 +120,7 @@ data ContextForNgrams =
          getContextsForNgrams :: HasNodeError err
          => NodeId
          -> [Int]
          -> Cmd err [ContextForNgrams]
          -> DBCmd err [ContextForNgrams]
          getContextsForNgrams cId ngramsIds = do
          res <- runPGSQuery query (cId, PGS.In ngramsIds)
          pure $ (\( _cfn_nodeId
          ......@@ -153,7 +153,7 @@ data ContextForNgramsTerms =
          getContextsForNgramsTerms :: HasNodeError err
          => NodeId
          -> [Text]
          -> Cmd err [ContextForNgramsTerms]
          -> DBCmd err [ContextForNgramsTerms]
          getContextsForNgramsTerms cId ngramsTerms = do
          res <- runPGSQuery query (cId, PGS.In ngramsTerms)
          pure $ (\( _cfnt_nodeId
          ......@@ -203,7 +203,7 @@ getContextsForNgramsTerms cId ngramsTerms = do
          getContextNgrams :: HasNodeError err
          => NodeId
          -> NodeId
          -> Cmd err [Text]
          -> DBCmd err [Text]
          getContextNgrams contextId listId = do
          res <- runPGSQuery query (contextId, listId)
          pure $ (\(PGS.Only term) -> term) <$> res
          ......@@ -227,7 +227,7 @@ getContextNgrams contextId listId = do
          getContextNgramsMatchingFTS :: HasNodeError err
          => NodeId
          -> NodeId
          -> Cmd err [Text]
          -> DBCmd err [Text]
          getContextNgramsMatchingFTS contextId listId = do
          res <- runPGSQuery query (listId, contextId)
          pure $ (\(PGS.Only term) -> term) <$> res
          ......@@ -256,7 +256,7 @@ getContextNgramsMatchingFTS contextId listId = do
          AND (contexts.search @@ plainto_tsquery(ngrams.terms)
          OR contexts.search @@ plainto_tsquery('french', ngrams.terms)) |]
          ------------------------------------------------------------------------
          insertNodeContext :: [NodeContext] -> Cmd err Int
          insertNodeContext :: [NodeContext] -> DBCmd err Int
          insertNodeContext ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
          $ Insert nodeContextTable ns' rCount (Just DoNothing))
          where
          ......@@ -274,7 +274,7 @@ insertNodeContext ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
          type Node_Id = NodeId
          type Context_Id = NodeId
          deleteNodeContext :: Node_Id -> Context_Id -> Cmd err Int
          deleteNodeContext :: Node_Id -> Context_Id -> DBCmd err Int
          deleteNodeContext n c = mkCmd $ \conn ->
          fromIntegral <$> runDelete_ conn
          (Delete nodeContextTable
          ......@@ -286,7 +286,7 @@ deleteNodeContext n c = mkCmd $ \conn ->
          ------------------------------------------------------------------------
          -- | Favorite management
          nodeContextsCategory :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
          nodeContextsCategory :: [(CorpusId, DocId, Int)] -> DBCmd err [Int]
          nodeContextsCategory inputData = map (\(PGS.Only a) -> a)
          <$> runPGSQuery catSelect (PGS.Only $ Values fields inputData)
          where
          ......@@ -302,7 +302,7 @@ nodeContextsCategory inputData = map (\(PGS.Only a) -> a)
          ------------------------------------------------------------------------
          -- | Score management
          nodeContextsScore :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
          nodeContextsScore :: [(CorpusId, DocId, Int)] -> DBCmd err [Int]
          nodeContextsScore inputData = map (\(PGS.Only a) -> a)
          <$> runPGSQuery catScore (PGS.Only $ Values fields inputData)
          where
          ......@@ -318,7 +318,7 @@ nodeContextsScore inputData = map (\(PGS.Only a) -> a)
          ------------------------------------------------------------------------
          selectCountDocs :: HasDBid NodeType => CorpusId -> Cmd err Int
          selectCountDocs :: HasDBid NodeType => CorpusId -> DBCmd err Int
          selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
          where
          queryCountDocs cId' = proc () -> do
          ......@@ -330,13 +330,13 @@ selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
          -- | TODO use UTCTime fast
          selectDocsDates :: HasDBid NodeType => CorpusId -> Cmd err [Text]
          selectDocsDates :: HasDBid NodeType => CorpusId -> DBCmd err [Text]
          selectDocsDates cId = map (head' "selectDocsDates" . splitOn "-")
          <$> catMaybes
          <$> map (view hd_publication_date)
          <$> selectDocs cId
          selectDocs :: HasDBid NodeType => CorpusId -> Cmd err [HyperdataDocument]
          selectDocs :: HasDBid NodeType => CorpusId -> DBCmd err [HyperdataDocument]
          selectDocs cId = runOpaQuery (queryDocs cId)
          queryDocs :: HasDBid NodeType => CorpusId -> O.Select (Field SqlJsonb)
          ......@@ -347,7 +347,7 @@ queryDocs cId = proc () -> do
          restrict -< (c ^. context_typename) .== sqlInt4 (toDBid NodeDocument)
          returnA -< view (context_hyperdata) c
          selectDocNodes :: HasDBid NodeType => CorpusId -> Cmd err [Context HyperdataDocument]
          selectDocNodes :: HasDBid NodeType => CorpusId -> DBCmd err [Context HyperdataDocument]
          selectDocNodes cId = runOpaQuery (queryDocNodes cId)
          queryDocNodes :: HasDBid NodeType => CorpusId -> O.Select ContextRead
          ......@@ -380,7 +380,7 @@ joinOn1 = proc () -> do
          ------------------------------------------------------------------------
          selectPublicContexts :: HasDBid NodeType => (Hyperdata a, DefaultFromField SqlJsonb a)
          => Cmd err [(Node a, Maybe Int)]
          => DBCmd err [(Node a, Maybe Int)]
          selectPublicContexts = runOpaQuery (queryWithType NodeFolderPublic)
          queryWithType :: HasDBid NodeType => NodeType -> O.Select (NodeRead, MaybeFields (Field SqlInt4))
          ......
          src/Gargantext/Database/Query/Table/NodeNode.hs
          View file @ 8d3f7def
          ......@@ -54,12 +54,12 @@ queryNodeNodeTable :: Select NodeNodeRead
          queryNodeNodeTable = selectTable nodeNodeTable
          -- | not optimized (get all ngrams without filters)
          _nodesNodes :: Cmd err [NodeNode]
          _nodesNodes :: DBCmd err [NodeNode]
          _nodesNodes = runOpaQuery queryNodeNodeTable
          ------------------------------------------------------------------------
          -- | Basic NodeNode tools
          getNodeNode :: NodeId -> Cmd err [NodeNode]
          getNodeNode :: NodeId -> DBCmd err [NodeNode]
          getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
          where
          selectNodeNode :: Column SqlInt4 -> Select NodeNodeRead
          ......@@ -71,7 +71,7 @@ getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
          ------------------------------------------------------------------------
          -- TODO (refactor with Children)
          {-
          getNodeNodeWith :: NodeId -> proxy a -> Maybe NodeType -> Cmd err [a]
          getNodeNodeWith :: NodeId -> proxy a -> Maybe NodeType -> DBCmd err [a]
          getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
          where
          query = selectChildren pId maybeNodeType
          ......@@ -93,7 +93,7 @@ getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
          -}
          ------------------------------------------------------------------------
          insertNodeNode :: [NodeNode] -> Cmd err Int
          insertNodeNode :: [NodeNode] -> DBCmd err Int
          insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
          $ Insert nodeNodeTable ns' rCount (Just DoNothing))
          where
          ......@@ -111,7 +111,7 @@ insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
          type Node1_Id = NodeId
          type Node2_Id = NodeId
          deleteNodeNode :: Node1_Id -> Node2_Id -> Cmd err Int
          deleteNodeNode :: Node1_Id -> Node2_Id -> DBCmd err Int
          deleteNodeNode n1 n2 = mkCmd $ \conn ->
          fromIntegral <$> runDelete_ conn
          (Delete nodeNodeTable
          ......@@ -123,7 +123,7 @@ deleteNodeNode n1 n2 = mkCmd $ \conn ->
          ------------------------------------------------------------------------
          -- | Favorite management
          _nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
          _nodeNodeCategory :: CorpusId -> DocId -> Int -> DBCmd err [Int]
          _nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
          where
          favQuery :: PGS.Query
          ......@@ -132,7 +132,7 @@ _nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery
          RETURNING node2_id;
          |]
          nodeNodesCategory :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
          nodeNodesCategory :: [(CorpusId, DocId, Int)] -> DBCmd err [Int]
          nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
          <$> runPGSQuery catQuery (PGS.Only $ Values fields inputData)
          where
          ......@@ -148,7 +148,7 @@ nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
          ------------------------------------------------------------------------
          -- | Score management
          _nodeNodeScore :: CorpusId -> DocId -> Int -> Cmd err [Int]
          _nodeNodeScore :: CorpusId -> DocId -> Int -> DBCmd err [Int]
          _nodeNodeScore cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery scoreQuery (c,cId,dId)
          where
          scoreQuery :: PGS.Query
          ......@@ -157,7 +157,7 @@ _nodeNodeScore cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery scoreQuery (
          RETURNING node2_id;
          |]
          nodeNodesScore :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
          nodeNodesScore :: [(CorpusId, DocId, Int)] -> DBCmd err [Int]
          nodeNodesScore inputData = map (\(PGS.Only a) -> a)
          <$> runPGSQuery catScore (PGS.Only $ Values fields inputData)
          where
          ......@@ -172,7 +172,7 @@ nodeNodesScore inputData = map (\(PGS.Only a) -> a)
          |]
          ------------------------------------------------------------------------
          _selectCountDocs :: HasDBid NodeType => CorpusId -> Cmd err Int
          _selectCountDocs :: HasDBid NodeType => CorpusId -> DBCmd err Int
          _selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
          where
          queryCountDocs cId' = proc () -> do
          ......@@ -188,13 +188,13 @@ _selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
          -- | TODO use UTCTime fast
          selectDocsDates :: HasDBid NodeType => CorpusId -> Cmd err [Text]
          selectDocsDates :: HasDBid NodeType => CorpusId -> DBCmd err [Text]
          selectDocsDates cId = map (head' "selectDocsDates" . splitOn "-")
          <$> catMaybes
          <$> map (view hd_publication_date)
          <$> selectDocs cId
          selectDocs :: HasDBid NodeType => CorpusId -> Cmd err [HyperdataDocument]
          selectDocs :: HasDBid NodeType => CorpusId -> DBCmd err [HyperdataDocument]
          selectDocs cId = runOpaQuery (queryDocs cId)
          queryDocs :: HasDBid NodeType => CorpusId -> O.Select (Column SqlJsonb)
          ......@@ -207,7 +207,7 @@ queryDocs cId = proc () -> do
          restrict -< n ^. node_typename .== (sqlInt4 $ toDBid NodeDocument)
          returnA -< view node_hyperdata n
          selectDocNodes :: HasDBid NodeType =>CorpusId -> Cmd err [Node HyperdataDocument]
          selectDocNodes :: HasDBid NodeType => CorpusId -> DBCmd err [Node HyperdataDocument]
          selectDocNodes cId = runOpaQuery (queryDocNodes cId)
          queryDocNodes :: HasDBid NodeType =>CorpusId -> O.Select NodeRead
          ......@@ -230,7 +230,7 @@ joinInCorpus = proc () -> do
          ------------------------------------------------------------------------
          selectPublicNodes :: HasDBid NodeType => (Hyperdata a, DefaultFromField SqlJsonb a)
          => Cmd err [(Node a, Maybe Int)]
          => DBCmd err [(Node a, Maybe Int)]
          selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
          queryWithType :: HasDBid NodeType
          ......
          test/Test/Database/Operations/DocumentSearch.hs
          View file @ 8d3f7def
          ......@@ -19,8 +19,7 @@ import Control.Lens (view)
          import Control.Monad.Reader
          import Data.Aeson.QQ.Simple
          import Data.Aeson.Types
          import Data.Maybe
          import Gargantext.API.Node.Update (updateDocs)
          -- import Gargantext.API.Node.Update (updateDocs)
          import Gargantext.Core
          import Gargantext.Core.NLP (nlpServerGet)
          import Gargantext.Core.Types.Individu
          ......@@ -30,7 +29,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Document
          import Gargantext.Database.Query.Table.Node
          import Gargantext.Database.Query.Tree.Root
          import Gargantext.Database.Schema.Node (NodePoly(..))
          import Network.URI (parseURI)
          -- import Network.URI (parseURI)
          import Test.Database.Types
          import Test.Hspec.Expectations
          ......
          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