Skip to content

haskell-gargantext
haskell-gargantext
Verified Commit 6417bcc9 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[refactoring] more FlowCmdM typeclass refactoring

parent 146c2eb0
Pipeline #5237 failed with stages
          in 74 minutes and 11 seconds
          Hide whitespace changes
          Inline Side-by-side
          Showing with 137 additions and 126 deletions
          src/Gargantext/Core/Text/List.hs
          View file @ 6417bcc9
          ......@@ -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
          )
          ......
          src/Gargantext/Core/Text/List/Social.hs
          View file @ 6417bcc9
          ......@@ -23,7 +23,7 @@ import Data.Pool
          import Data.Swagger
          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)
          ......@@ -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
          ......
          src/Gargantext/Core/Text/List/Social/Find.hs
          View file @ 6417bcc9
          ......@@ -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]
          src/Gargantext/Core/Viz/Graph/API.hs
          View file @ 6417bcc9
          ......@@ -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
          ......
          src/Gargantext/Core/Viz/Phylo/Legacy/LegacyMain.hs
          View file @ 6417bcc9
          ......@@ -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
          ......
          src/Gargantext/Database/Action/Flow.hs
          View file @ 6417bcc9
          ......@@ -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)
          ......@@ -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
          ......
          src/Gargantext/Database/Action/Flow/List.hs
          View file @ 6417bcc9
          ......@@ -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)
          ......
          src/Gargantext/Database/Action/Metrics/TFICF.hs
          View file @ 6417bcc9
          ......@@ -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)
          ......
          src/Gargantext/Database/Query/Table/NgramsPostag.hs
          View file @ 6417bcc9
          ......@@ -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"]
          ......
          src/Gargantext/Database/Query/Tree.hs
          View file @ 6417bcc9
          ......@@ -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
          ......
          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