Skip to content

haskell-gargantext
haskell-gargantext
Commit 45d49b0f authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[FIX] Monads dependencies, flowSocialList integration to flow (WIP)

parent 1690d344
Show whitespace changes
Inline Side-by-side
Showing with 100 additions and 72 deletions
src/Gargantext/API/Ngrams.hs
View file @ 45d49b0f
......@@ -131,6 +131,7 @@ import Gargantext.Database.Admin.Types.Node (NodeType(..))
import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
import Gargantext.Database.Query.Table.Node (getNode)
import Gargantext.Database.Query.Tree.Error (HasTreeError)
import Gargantext.Database.Schema.Node (node_id, node_parentId, node_userId)
{-
......@@ -318,12 +319,14 @@ tableNgramsPull listId ngramsType p_version = do
-- Apply the given patch to the DB and returns the patch to be applied on the
-- client.
-- TODO-ACCESS check
tableNgramsPut :: (HasNodeError err,
HasInvalidError err,
HasConfig env,
HasConnectionPool env,
HasSettings env,
RepoCmdM env err m)
tableNgramsPut :: ( HasNodeError err
, HasTreeError err
, HasInvalidError err
, HasConfig env
, HasConnectionPool env
, HasSettings env
, RepoCmdM env err m
)
=> TabType
-> ListId
-> Versioned NgramsTablePatch
......@@ -670,6 +673,7 @@ getTableNgramsDoc dId tabType listId limit_ offset listType minSize maxSize orde
apiNgramsTableCorpus :: ( RepoCmdM env err m
, HasNodeError err
, HasTreeError err
, HasInvalidError err
, HasConnectionPool env
, HasConfig env
......@@ -683,6 +687,7 @@ apiNgramsTableCorpus cId = getTableNgramsCorpus cId
apiNgramsTableDoc :: ( RepoCmdM env err m
, HasNodeError err
, HasTreeError err
, HasInvalidError err
, HasConnectionPool env
, HasConfig env
......
src/Gargantext/Core/Text/List.hs
View file @ 45d49b0f
......@@ -14,6 +14,7 @@ Portability : POSIX
module Gargantext.Core.Text.List
where
import Control.Lens (makeLenses)
import Data.Maybe (fromMaybe, catMaybes)
import Data.Ord (Down(..))
......@@ -26,23 +27,25 @@ import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import Gargantext.API.Ngrams.Types (NgramsElement, mkNgramsElement, NgramsTerm(..), RootParent(..), mSetFromList)
-- import Gargantext.API.Ngrams.Tools (getCoocByNgrams', Diagonal(..))
import Gargantext.API.Ngrams.Types (NgramsElement, mkNgramsElement, NgramsTerm(..), RootParent(..), mSetFromList)
import Gargantext.Core (Lang(..))
import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId)
import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Core.Text (size)
import Gargantext.Core.Text.List.Learn (Model(..))
import Gargantext.Core.Text.List.Social (flowSocialList)
import Gargantext.Core.Text.Metrics (scored', Scored(..), normalizeGlobal, normalizeLocal)
import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId)
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.Metrics.NgramsByNode (ngramsGroup, getNodesByNgramsUser, groupNodesByNgramsWith, getNodesByNgramsOnlyUser)
import Gargantext.Database.Action.Metrics.TFICF (getTficf)
import Gargantext.API.Ngrams.Types (RepoCmdM)
import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Database.Prelude (Cmd, CmdM)
import Gargantext.Database.Query.Table.Node (defaultList)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError())
import Gargantext.Database.Prelude (Cmd)
import Gargantext.Database.Query.Tree.Error (HasTreeError)
import Gargantext.Database.Schema.Ngrams (NgramsType(..))
import Gargantext.Prelude
import Gargantext.Core.Text (size)
import Gargantext.Core.Text.List.Learn (Model(..))
-- import Gargantext.Core.Text.Metrics (takeScored)
data NgramsListBuilder = BuilderStepO { stemSize :: !Int
......@@ -63,26 +66,37 @@ data NgramsListBuilder = BuilderStepO { stemSize :: !Int
data StopSize = StopSize {unStopSize :: !Int}
-- | TODO improve grouping functions of Authors, Sources, Institutes..
buildNgramsLists :: HasNodeError err
=> Lang
buildNgramsLists :: ( RepoCmdM env err m
, CmdM env err m
, HasTreeError err
, HasNodeError err
)
=> User
-> Lang
-> Int
-> Int
-> StopSize
-> UserCorpusId
-> MasterCorpusId
-> Cmd err (Map NgramsType [NgramsElement])
buildNgramsLists l n m s uCid mCid = do
ngTerms <- buildNgramsTermsList l n m s uCid mCid
othersTerms <- mapM (buildNgramsOthersList uCid identity)
-> m (Map NgramsType [NgramsElement])
buildNgramsLists user l n m s uCid mCid = do
ngTerms <- buildNgramsTermsList user l n m s uCid mCid
othersTerms <- mapM (buildNgramsOthersList user uCid identity)
[Authors, Sources, Institutes]
pure $ Map.unions $ othersTerms <> [ngTerms]
buildNgramsOthersList :: UserCorpusId
buildNgramsOthersList :: (-- RepoCmdM env err m
-- , CmdM env err m
HasNodeError err
-- , HasTreeError err
)
=> User
-> UserCorpusId
-> (Text -> Text)
-> NgramsType
-> Cmd err (Map NgramsType [NgramsElement])
buildNgramsOthersList uCid groupIt nt = do
buildNgramsOthersList user uCid groupIt nt = do
ngs <- groupNodesByNgramsWith groupIt <$> getNodesByNgramsUser uCid nt
let
......@@ -105,15 +119,20 @@ buildNgramsOthersList uCid groupIt nt = do
)]
-- TODO use ListIds
buildNgramsTermsList :: HasNodeError err
=> Lang
buildNgramsTermsList :: ( HasNodeError err
, CmdM env err m
, RepoCmdM env err m
, HasTreeError err
)
=> User
-> Lang
-> Int
-> Int
-> StopSize
-> UserCorpusId
-> MasterCorpusId
-> Cmd err (Map NgramsType [NgramsElement])
buildNgramsTermsList l n m s uCid mCid = do
-> m (Map NgramsType [NgramsElement])
buildNgramsTermsList user l n m s uCid mCid = do
-- Computing global speGen score
allTerms <- Map.toList <$> getTficf uCid mCid NgramsTerms
......@@ -122,6 +141,8 @@ buildNgramsTermsList l n m s uCid mCid = do
-- printDebug "tail candidates" (List.take 10 $ List.reverse $ allTerms)
-- First remove stops terms
mapSocialList <- flowSocialList user NgramsTerms (Set.fromList $ map fst allTerms)
let
-- stopTerms ignored for now (need to be tagged already)
(_stopTerms, candidateTerms) = List.partition ((isStopTerm s) . fst) allTerms
......
src/Gargantext/Core/Text/List/Social.hs
View file @ 45d49b0f
......@@ -6,8 +6,6 @@ License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
module Gargantext.Core.Text.List.Social
......@@ -28,7 +26,6 @@ import Data.Maybe (fromMaybe)
import Data.Map (Map)
import Data.Set (Set)
import Data.Text (Text)
import Gargantext.API.Ngrams
import Gargantext.API.Ngrams.Tools -- (getListNgrams)
import Gargantext.API.Ngrams.Types
import Gargantext.Core.Types.Main
......
src/Gargantext/Database/Action/Flow.hs
View file @ 45d49b0f
......@@ -79,19 +79,19 @@ import Gargantext.Database.Action.Search (searchDocInDatabase)
import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Ngrams
import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Document.Insert -- (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..))
import Gargantext.Database.Query.Tree.Root (getOrMkRoot, getOrMk_RootWithCorpus)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Query.Table.Ngrams
import Gargantext.Database.Query.Table.NodeNgrams (listInsertDb , getCgramsId)
import Gargantext.Database.Query.Table.NodeNodeNgrams2
import Gargantext.Database.Prelude
import Gargantext.Database.Query.Tree.Root (getOrMkRoot, getOrMk_RootWithCorpus)
import Gargantext.Database.Schema.Node (NodePoly(..))
import Gargantext.Prelude
import Gargantext.Prelude.Crypto.Hash (Hash)
import qualified Gargantext.Database.Query.Table.Node.Document.Add as Doc (add)
import qualified Gargantext.Core.Text.Corpus.API as API
import qualified Gargantext.Database.Query.Table.Node.Document.Add as Doc (add)
------------------------------------------------------------------------
-- TODO use internal with API name (could be old data)
......@@ -132,7 +132,8 @@ getDataText (InternalOrigin _) _la q _li = do
pure $ DataOld ids
-------------------------------------------------------------------------------
flowDataText :: FlowCmdM env err m
flowDataText :: ( FlowCmdM env err m
)
=> User
-> DataText
-> TermType Lang
......@@ -145,7 +146,7 @@ flowDataText u (DataNew txt) tt cid = flowCorpus u (Right [cid]) tt txt
------------------------------------------------------------------------
-- TODO use proxy
flowAnnuaire :: FlowCmdM env err m
flowAnnuaire :: (FlowCmdM env err m)
=> User
-> Either CorpusName [CorpusId]
-> (TermType Lang)
......@@ -156,7 +157,7 @@ flowAnnuaire u n l filePath = do
flow (Nothing :: Maybe HyperdataAnnuaire) u n l docs
------------------------------------------------------------------------
flowCorpusFile :: FlowCmdM env err m
flowCorpusFile :: (FlowCmdM env err m)
=> User
-> Either CorpusName [CorpusId]
-> Limit -- Limit the number of docs (for dev purpose)
......@@ -181,7 +182,10 @@ flowCorpus :: (FlowCmdM env err m, FlowCorpus a)
flowCorpus = flow (Nothing :: Maybe HyperdataCorpus)
flow :: (FlowCmdM env err m, FlowCorpus a, MkCorpus c)
flow :: ( FlowCmdM env err m
, FlowCorpus a
, MkCorpus c
)
=> Maybe c
-> User
-> Either CorpusName [CorpusId]
......@@ -194,7 +198,9 @@ flow c u cn la docs = do
flowCorpusUser (la ^. tt_lang) u cn c (concat ids)
------------------------------------------------------------------------
flowCorpusUser :: (FlowCmdM env err m, MkCorpus c)
flowCorpusUser :: ( FlowCmdM env err m
, MkCorpus c
)
=> Lang
-> User
-> Either CorpusName [CorpusId]
......@@ -214,7 +220,7 @@ flowCorpusUser l user corpusName ctype ids = do
-- User List Flow
(masterUserId, _masterRootId, masterCorpusId) <- getOrMk_RootWithCorpus (UserName userMaster) (Left "") ctype
ngs <- buildNgramsLists l 2 3 (StopSize 3) userCorpusId masterCorpusId
ngs <- buildNgramsLists user l 2 3 (StopSize 3) userCorpusId masterCorpusId
_userListId <- flowList_DbRepo listId ngs
_mastListId <- getOrMkList masterCorpusId masterUserId
-- _ <- insertOccsUpdates userCorpusId mastListId
......
src/Gargantext/Database/Action/Flow/Types.hs
View file @ 45d49b0f
......@@ -29,6 +29,7 @@ import Gargantext.Core.Text.Terms
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Prelude (CmdM)
import Gargantext.Database.Query.Table.Node.Document.Insert
import Gargantext.Database.Query.Tree.Error (HasTreeError)
type FlowCmdM env err m =
( CmdM env err m
......@@ -36,6 +37,7 @@ type FlowCmdM env err m =
, HasNodeError err
, HasInvalidError err
, HasRepoVar env
, HasTreeError err
)
type FlowCorpus a = ( AddUniqId a
......
src/Gargantext/Database/Prelude.hs
View file @ 45d49b0f
......@@ -87,9 +87,6 @@ type Cmd err a = forall m env. CmdM env err m => m a
fromInt64ToInt :: Int64 -> Int
fromInt64ToInt = fromIntegral
......
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