[refactor] more FlowCmdM removal

parent 6417bcc9
Pipeline #5239 canceled with stages
in 8 minutes and 34 seconds
...@@ -16,12 +16,18 @@ Portability : POSIX ...@@ -16,12 +16,18 @@ Portability : POSIX
module Gargantext.API.Ngrams.List module Gargantext.API.Ngrams.List
where where
import Data.ByteString.Lazy qualified as BSL
import Data.Csv qualified as Csv
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.Map.Strict (Map, toList) import Data.Map.Strict (Map, toList)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Set qualified as Set
import Data.Text (Text, concat, pack, splitOn) import Data.Text (Text, concat, pack, splitOn)
import Data.Vector (Vector) import Data.Vector (Vector)
import Data.Vector qualified as Vec
import Gargantext.API.Admin.EnvTypes (Env, GargJob(..)) import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
import Gargantext.API.Admin.Orchestrator.Types import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Ngrams (setListNgrams) import Gargantext.API.Ngrams (setListNgrams)
...@@ -34,25 +40,18 @@ import Gargantext.Core.NodeStory ...@@ -34,25 +40,18 @@ import Gargantext.Core.NodeStory
import Gargantext.Core.Types.Main (ListType(..)) import Gargantext.Core.Types.Main (ListType(..))
import Gargantext.Database.Action.Flow (reIndexWith) import Gargantext.Database.Action.Flow (reIndexWith)
import Gargantext.Database.Action.Flow.Types (FlowCmdM) import Gargantext.Database.Action.Flow.Types (FlowCmdM)
-- import Gargantext.Database.Action.Metrics.NgramsByContext (refreshNgramsMaterialized)
import Gargantext.Database.Admin.Types.Node 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.Query.Table.Node (getNode)
import Gargantext.Database.Schema.Ngrams import Gargantext.Database.Schema.Ngrams
import Gargantext.Database.Schema.Node (_node_parent_id) import Gargantext.Database.Schema.Node (_node_parent_id)
import Gargantext.Database.Types (Indexed(..)) import Gargantext.Database.Types (Indexed(..))
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..)) import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Gargantext.Utils.Servant qualified as GUS
import Prelude qualified
import Protolude qualified as P
import Servant 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" type GETAPI = Summary "Get List"
:> "lists" :> "lists"
...@@ -120,10 +119,10 @@ getCsv lId = do ...@@ -120,10 +119,10 @@ getCsv lId = do
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- TODO : purge list -- TODO : purge list
-- TODO talk -- TODO talk
setList :: FlowCmdM env err m setList :: HasNodeStory env err m
=> ListId => ListId
-> NgramsList -> NgramsList
-> m Bool -> m Bool
setList l m = do setList l m = do
-- TODO check with Version for optim -- TODO check with Version for optim
-- printDebug "New list as file" l -- printDebug "New list as file" l
...@@ -197,7 +196,7 @@ parseCsvData lst = Map.fromList $ conv <$> lst ...@@ -197,7 +196,7 @@ parseCsvData lst = Map.fromList $ conv <$> lst
} }
) )
csvPost :: FlowCmdM env err m csvPost :: HasNodeStory env err m
=> ListId => ListId
-> Text -> Text
-> m (Either Text ()) -> m (Either Text ())
...@@ -236,7 +235,7 @@ csvPostAsync lId = ...@@ -236,7 +235,7 @@ csvPostAsync lId =
-- | This is for debugging the CSV parser in the REPL -- | 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 ()) => ListId -> P.FilePath -> m (Either Text ())
importCsvFile lId fp = do importCsvFile lId fp = do
contents <- liftBase $ P.readFile fp contents <- liftBase $ P.readFile fp
......
...@@ -3,43 +3,46 @@ ...@@ -3,43 +3,46 @@
module Gargantext.API.Node.Corpus.Searx where module Gargantext.API.Node.Corpus.Searx where
import Control.Lens (view) import Control.Lens (view)
import Data.Aeson qualified as Aeson
import Data.Aeson.TH (deriveJSON) import Data.Aeson.TH (deriveJSON)
import Data.Either (Either(..)) 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.Calendar (Day, toGregorian)
import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM) import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM)
import Data.Tuple.Select (sel1, sel2, sel3) import Data.Tuple.Select (sel1, sel2, sel3)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.Core (Lang(..)) 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 (buildNgramsLists)
import Gargantext.Core.Text.List.Group.WithStem ({-StopSize(..),-} GroupParams(..)) import Gargantext.Core.Text.List.Group.WithStem ({-StopSize(..),-} GroupParams(..))
import Gargantext.Core.Text.Terms (TermType(..)) import Gargantext.Core.Text.Terms (TermType(..))
import Gargantext.Core.Types (HasInvalidError)
import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Database.Action.Flow (addDocumentsToHyperCorpus) --, DataText(..)) import Gargantext.Database.Action.Flow (addDocumentsToHyperCorpus) --, DataText(..))
import Gargantext.Database.Action.Flow.List (flowList_DbRepo) import Gargantext.Database.Action.Flow.List (flowList_DbRepo)
import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Action.User (getUserId) import Gargantext.Database.Action.User (getUserId)
import Gargantext.Database.Admin.Config (userMaster) 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.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 (defaultListMaybe, 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.Database.Query.Tree.Root (getOrMk_RootWithCorpus)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Prelude.Config import Gargantext.Prelude.Config
import Gargantext.Utils.Jobs (JobHandle, MonadJobStatus(..)) import Gargantext.Utils.Jobs (JobHandle, MonadJobStatus(..))
import Network.HTTP.Client import Network.HTTP.Client
import Network.HTTP.Client.TLS import Network.HTTP.Client.TLS
import Prelude qualified
import Protolude (catMaybes, encodeUtf8, rightToMaybe, Text, void) 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 :: Lang -> Text
langToSearx All = "en-US" langToSearx All = "en-US"
...@@ -108,7 +111,12 @@ fetchSearxPage (FetchSearxParams { _fsp_language ...@@ -108,7 +111,12 @@ fetchSearxPage (FetchSearxParams { _fsp_language
let dec = Aeson.eitherDecode $ responseBody res :: (Either Prelude.String SearxResponse) let dec = Aeson.eitherDecode $ responseBody res :: (Either Prelude.String SearxResponse)
pure dec 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 => User
-> CorpusId -> CorpusId
-> ListId -> ListId
...@@ -145,7 +153,13 @@ insertSearxResponse user cId listId l (Right (SearxResponse { _srs_results })) = ...@@ -145,7 +153,13 @@ insertSearxResponse user cId listId l (Right (SearxResponse { _srs_results })) =
pure () pure ()
-- TODO Make an async task out of this? -- TODO Make an async task out of this?
triggerSearxSearch :: (MonadBase IO m, FlowCmdM env err m, MonadJobStatus m) triggerSearxSearch :: ( MonadBase IO m
, HasNodeStory env err m
, HasNLPServer env
, HasNodeError err
, HasTreeError err
, HasInvalidError err
, MonadJobStatus m )
=> User => User
-> CorpusId -> CorpusId
-> API.RawQuery -> API.RawQuery
......
...@@ -622,7 +622,8 @@ instance HasText a => HasText (Node a) ...@@ -622,7 +622,8 @@ instance HasText a => HasText (Node a)
-- | TODO putelsewhere -- | TODO putelsewhere
-- | Upgrade function -- | Upgrade function
-- Suppose all documents are English (this is the case actually) -- Suppose all documents are English (this is the case actually)
indexAllDocumentsWithPosTag :: FlowCmdM env err m indexAllDocumentsWithPosTag :: ( HasNodeStory env err m
, HasNLPServer env )
=> m () => m ()
indexAllDocumentsWithPosTag = do indexAllDocumentsWithPosTag = do
rootId <- getRootId (UserName userMaster) rootId <- getRootId (UserName userMaster)
...@@ -631,7 +632,8 @@ indexAllDocumentsWithPosTag = do ...@@ -631,7 +632,8 @@ indexAllDocumentsWithPosTag = do
_ <- mapM extractInsert (splitEvery 1000 docs) _ <- mapM extractInsert (splitEvery 1000 docs)
pure () pure ()
extractInsert :: FlowCmdM env err m extractInsert :: ( HasNodeStory env err m
, HasNLPServer env )
=> [Node HyperdataDocument] -> m () => [Node HyperdataDocument] -> m ()
extractInsert docs = do extractInsert docs = do
let documentsWithId = map (\doc -> Indexed (doc ^. node_id) doc) docs let documentsWithId = map (\doc -> Indexed (doc ^. node_id) doc) docs
......
...@@ -184,15 +184,13 @@ updateContextScore cId lId = do ...@@ -184,15 +184,13 @@ updateContextScore cId lId = do
-- Used for scores in Doc Table -- Used for scores in Doc Table
getContextsNgramsScore :: --(FlowCmdM env err m) getContextsNgramsScore :: (HasNodeStory env err m)
(HasNodeStory env err m)
=> CorpusId -> ListId -> TabType -> ListType -> Maybe Limit => CorpusId -> ListId -> TabType -> ListType -> Maybe Limit
-> m (Map ContextId Int) -> m (Map ContextId Int)
getContextsNgramsScore cId lId tabType listType maybeLimit getContextsNgramsScore cId lId tabType listType maybeLimit
= Map.map Set.size <$> getContextsNgrams cId lId tabType listType maybeLimit = Map.map Set.size <$> getContextsNgrams cId lId tabType listType maybeLimit
getContextsNgrams :: --(FlowCmdM env err m) getContextsNgrams :: (HasNodeStory env err m)
(HasNodeStory env err m)
=> CorpusId -> ListId -> TabType -> ListType -> Maybe Limit => CorpusId -> ListId -> TabType -> ListType -> Maybe Limit
-> m (Map ContextId (Set NgramsTerm)) -> m (Map ContextId (Set NgramsTerm))
getContextsNgrams cId lId tabType listType maybeLimit = do getContextsNgrams cId lId tabType listType maybeLimit = do
......
...@@ -249,11 +249,11 @@ queryNgramsOccurrencesOnlyByContextUser_withSample' = [sql| ...@@ -249,11 +249,11 @@ queryNgramsOccurrencesOnlyByContextUser_withSample' = [sql|
------------------------------------------------------------------------ ------------------------------------------------------------------------
getContextsByNgramsOnlyUser :: HasDBid NodeType getContextsByNgramsOnlyUser :: HasDBid NodeType
=> CorpusId => CorpusId
-> [ListId] -> [ListId]
-> NgramsType -> NgramsType
-> [NgramsTerm] -> [NgramsTerm]
-> DBCmd err (HashMap NgramsTerm (Set NodeId)) -> DBCmd err (HashMap NgramsTerm (Set NodeId))
getContextsByNgramsOnlyUser cId ls nt ngs = getContextsByNgramsOnlyUser cId ls nt ngs =
HM.unionsWith (<>) HM.unionsWith (<>)
. map (HM.fromListWith (<>) . map (HM.fromListWith (<>)
......
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