[refactor] some more Cmd refactoring + test fixes

parent 2ed7d1de
Pipeline #5243 passed with stages
in 57 minutes and 29 seconds
...@@ -185,12 +185,12 @@ getChart cId _start _end maybeListId tabType = do ...@@ -185,12 +185,12 @@ getChart cId _start _end maybeListId tabType = do
pure $ constructHashedResponse chart pure $ constructHashedResponse chart
updateChart :: HasNodeError err => updateChart :: HasNodeError err
CorpusId => CorpusId
-> Maybe ListId -> Maybe ListId
-> TabType -> TabType
-> Maybe Limit -> Maybe Limit
-> DBCmd err () -> DBCmd err ()
updateChart cId maybeListId tabType maybeLimit = do updateChart cId maybeListId tabType maybeLimit = do
listId <- case maybeListId of listId <- case maybeListId of
Just lid -> pure lid Just lid -> pure lid
...@@ -202,12 +202,12 @@ updateChart cId maybeListId tabType maybeLimit = do ...@@ -202,12 +202,12 @@ updateChart cId maybeListId tabType maybeLimit = do
_ <- updateChart' cId listId tabType maybeLimit _ <- updateChart' cId listId tabType maybeLimit
pure () pure ()
updateChart' :: HasNodeError err => updateChart' :: HasNodeError err
CorpusId => CorpusId
-> ListId -> ListId
-> TabType -> TabType
-> Maybe Limit -> Maybe Limit
-> DBCmd err (ChartMetrics Histo) -> DBCmd err (ChartMetrics Histo)
updateChart' cId listId tabType _maybeLimit = do updateChart' cId listId tabType _maybeLimit = do
node <- getNodeWith listId (Proxy :: Proxy HyperdataList) node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let hl = node ^. node_hyperdata let hl = node ^. node_hyperdata
...@@ -267,7 +267,7 @@ getPie cId _start _end maybeListId tabType = do ...@@ -267,7 +267,7 @@ getPie cId _start _end maybeListId tabType = do
chart <- case mChart of chart <- case mChart of
Just chart -> pure chart Just chart -> pure chart
Nothing -> do Nothing -> do
updatePie' cId maybeListId tabType Nothing updatePie' cId listId tabType Nothing
pure $ constructHashedResponse chart pure $ constructHashedResponse chart
...@@ -278,23 +278,23 @@ updatePie :: HasNodeStory env err m ...@@ -278,23 +278,23 @@ updatePie :: HasNodeStory env err m
-> Maybe Limit -> Maybe Limit
-> m () -> m ()
updatePie cId maybeListId tabType maybeLimit = do updatePie cId maybeListId tabType maybeLimit = do
listId <- case maybeListId of
Just lid -> pure lid
Nothing -> defaultList cId
printDebug "[updatePie] cId" cId printDebug "[updatePie] cId" cId
printDebug "[updatePie] maybeListId" maybeListId printDebug "[updatePie] maybeListId" maybeListId
printDebug "[updatePie] tabType" tabType printDebug "[updatePie] tabType" tabType
printDebug "[updatePie] maybeLimit" maybeLimit printDebug "[updatePie] maybeLimit" maybeLimit
_ <- updatePie' cId maybeListId tabType maybeLimit _ <- updatePie' cId listId tabType maybeLimit
pure () pure ()
updatePie' :: (HasNodeStory env err m, HasNodeError err) updatePie' :: (HasNodeStory env err m, HasNodeError err)
=> CorpusId => CorpusId
-> Maybe ListId -> ListId
-> TabType -> TabType
-> Maybe Limit -> Maybe Limit
-> m (ChartMetrics Histo) -> m (ChartMetrics Histo)
updatePie' cId maybeListId tabType _maybeLimit = do updatePie' cId listId tabType _maybeLimit = do
listId <- case maybeListId of
Just lid -> pure lid
Nothing -> defaultList cId
node <- getNodeWith listId (Proxy :: Proxy HyperdataList) node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
let hl = node ^. node_hyperdata let hl = node ^. node_hyperdata
pieMap = hl ^. hl_pie pieMap = hl ^. hl_pie
......
This diff is collapsed.
...@@ -36,7 +36,7 @@ import qualified Data.Text as Text ...@@ -36,7 +36,7 @@ import qualified Data.Text as Text
------------------------------------------------------------------------ ------------------------------------------------------------------------
getNgramsList :: HasNodeStory env err m getNgramsList :: HasNodeStory env err m
=> ListId -> m NgramsList => ListId -> m NgramsList
getNgramsList lId = fromList getNgramsList lId = fromList
<$> zip ngramsTypes <$> zip ngramsTypes
<$> mapM (getNgramsTableMap lId) ngramsTypes <$> mapM (getNgramsTableMap lId) ngramsTypes
......
...@@ -16,24 +16,21 @@ Main exports of Gargantext: ...@@ -16,24 +16,21 @@ Main exports of Gargantext:
module Gargantext.API.Node.Corpus.Export module Gargantext.API.Node.Corpus.Export
where where
import Data.HashMap.Strict qualified as HashMap
import Data.List qualified as List
import Data.Map.Strict (Map) import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Set (Set) import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text, pack) 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.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.API.Prelude (GargNoServer)
import Gargantext.Prelude.Crypto.Hash (hash)
import Gargantext.Core.Types
import Gargantext.Core.NodeStory import Gargantext.Core.NodeStory
import Gargantext.Core.Types
import Gargantext.Database.Action.Metrics.NgramsByContext (getNgramsByContextOnlyUser) import Gargantext.Database.Action.Metrics.NgramsByContext (getNgramsByContextOnlyUser)
import Gargantext.Database.Admin.Config (userMaster) import Gargantext.Database.Admin.Config (userMaster)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..)) import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
...@@ -42,9 +39,11 @@ import Gargantext.Database.Query.Table.Node ...@@ -42,9 +39,11 @@ import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Error (HasNodeError) import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.Node.Select (selectNodesWithUsername) import Gargantext.Database.Query.Table.Node.Select (selectNodesWithUsername)
import Gargantext.Database.Query.Table.NodeContext (selectDocNodes) 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.Context (_context_id, _context_hyperdata)
import Gargantext.Database.Schema.Ngrams (NgramsType(..))
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Prelude.Crypto.Hash (hash)
import Servant (Headers, Header, addHeader)
-------------------------------------------------- --------------------------------------------------
-- | Hashes are ordered by Set -- | Hashes are ordered by Set
......
...@@ -31,7 +31,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus) ...@@ -31,7 +31,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus)
import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..)) import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..))
import Gargantext.Database.Admin.Types.Node (CorpusId, ListId, NodeType(NodeTexts)) import Gargantext.Database.Admin.Types.Node (CorpusId, ListId, NodeType(NodeTexts))
import Gargantext.Database.Prelude (hasConfig) 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 (insertDefaultNodeIfNotExists)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError) import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Tree.Error (HasTreeError) import Gargantext.Database.Query.Tree.Error (HasTreeError)
...@@ -160,12 +160,12 @@ triggerSearxSearch :: ( MonadBase IO m ...@@ -160,12 +160,12 @@ triggerSearxSearch :: ( MonadBase IO m
, HasTreeError err , HasTreeError err
, HasInvalidError err , HasInvalidError err
, MonadJobStatus m ) , MonadJobStatus m )
=> User => User
-> CorpusId -> CorpusId
-> API.RawQuery -> API.RawQuery
-> Lang -> Lang
-> JobHandle m -> JobHandle m
-> m () -> m ()
triggerSearxSearch user cId q l jobHandle = do triggerSearxSearch user cId q l jobHandle = do
userId <- getUserId user userId <- getUserId user
...@@ -181,12 +181,7 @@ triggerSearxSearch user cId q l jobHandle = do ...@@ -181,12 +181,7 @@ triggerSearxSearch user cId q l jobHandle = do
uId <- getUserId user uId <- getUserId user
let surl = _gc_frame_searx_url cfg let surl = _gc_frame_searx_url cfg
-- printDebug "[triggerSearxSearch] surl" surl -- printDebug "[triggerSearxSearch] surl" surl
mListId <- defaultListMaybe cId listId <- getOrMkList cId uId
listId <- case mListId of
Nothing -> do
listId <- getOrMkList cId uId
pure listId
Just listId -> pure listId
-- printDebug "[triggerSearxSearch] listId" listId -- printDebug "[triggerSearxSearch] listId" listId
......
...@@ -281,11 +281,14 @@ type GraphVersionsAPI = Summary "Graph versions" ...@@ -281,11 +281,14 @@ type GraphVersionsAPI = Summary "Graph versions"
graphVersionsAPI :: UserId -> NodeId -> GargServer GraphVersionsAPI graphVersionsAPI :: UserId -> NodeId -> GargServer GraphVersionsAPI
graphVersionsAPI u n = graphVersionsAPI u n =
graphVersions 0 n graphVersions u n
:<|> recomputeVersions u n :<|> recomputeVersions u n
graphVersions :: Int -> NodeId -> GargNoServer GraphVersions graphVersions :: (HasNodeStory env err m)
graphVersions n nId = do => UserId
-> NodeId
-> m GraphVersions
graphVersions u nId = do
nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph) nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
let let
graph = nodeGraph graph = nodeGraph
...@@ -302,21 +305,14 @@ graphVersions n nId = do ...@@ -302,21 +305,14 @@ graphVersions n nId = do
mcId <- getClosestParentIdByType nId NodeCorpus mcId <- getClosestParentIdByType nId NodeCorpus
let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId let cId = maybe (panic "[G.V.G.API] Node has no parent") identity mcId
maybeListId <- defaultListMaybe cId listId <- getOrMkList cId u
case maybeListId of repo <- getRepo [listId]
Nothing -> if n <= 2 let v = repo ^. unNodeStory . at listId . _Just . a_version
then graphVersions (n+1) cId -- printDebug "graphVersions" v
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
pure $ GraphVersions { gv_graph = listVersion pure $ GraphVersions { gv_graph = listVersion
, gv_repo = v } , gv_repo = v }
--recomputeVersions :: UserId -> NodeId -> GargNoServer Graph
recomputeVersions :: HasNodeStory env err m recomputeVersions :: HasNodeStory env err m
=> UserId => UserId
-> NodeId -> NodeId
...@@ -324,10 +320,11 @@ recomputeVersions :: HasNodeStory env err m ...@@ -324,10 +320,11 @@ recomputeVersions :: HasNodeStory env err m
recomputeVersions uId nId = recomputeGraph uId nId Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False recomputeVersions uId nId = recomputeGraph uId nId Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
------------------------------------------------------------ ------------------------------------------------------------
graphClone :: UserId graphClone :: HasNodeError err
=> UserId
-> NodeId -> NodeId
-> HyperdataGraphAPI -> HyperdataGraphAPI
-> GargNoServer NodeId -> DBCmd err NodeId
graphClone uId pId (HyperdataGraphAPI { _hyperdataAPIGraph = graph graphClone uId pId (HyperdataGraphAPI { _hyperdataAPIGraph = graph
, _hyperdataAPICamera = camera }) = do , _hyperdataAPICamera = camera }) = do
let nodeType = NodeGraph let nodeType = NodeGraph
......
...@@ -34,6 +34,7 @@ import Gargantext.API.Prelude ...@@ -34,6 +34,7 @@ import Gargantext.API.Prelude
import Gargantext.Core.Mail.Types (HasMail(..)) import Gargantext.Core.Mail.Types (HasMail(..))
import Gargantext.Core.NLP (HasNLPServer(..)) import Gargantext.Core.NLP (HasNLPServer(..))
import Gargantext.Database.Query.Table.Node.Error import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Prelude (HasConfig(..), HasConnectionPool(..))
import Gargantext.Prelude.Config import Gargantext.Prelude.Config
import Gargantext.Prelude.Mail.Types (MailConfig(..), LoginType(NoAuth)) import Gargantext.Prelude.Mail.Types (MailConfig(..), LoginType(NoAuth))
import Gargantext.System.Logging (HasLogger(..), Logger, MonadLogger(..)) 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