Commit 30953027 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-charts-update-economy' of...

Merge branch 'dev-charts-update-economy' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell-gargantext into dev-merge
parents e5b415b8 4252ada3
import Prelude (IO, id, (.)) import Prelude (IO, id, (.))
import Codec.Serialise (deserialise)
import Data.Aeson (encode) import Data.Aeson (encode)
import Codec.Serialise (deserialise)
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import Gargantext.API.Ngrams (NgramsRepo)
import Gargantext.API.Ngrams.Types (NgramsRepo)
main :: IO () main :: IO ()
main = L.interact (encode . (id :: NgramsRepo -> NgramsRepo) . deserialise) main = L.interact (encode . (id :: NgramsRepo -> NgramsRepo) . deserialise)
...@@ -76,7 +76,8 @@ import Gargantext.API.Admin.Auth (AuthContext, auth) ...@@ -76,7 +76,8 @@ import Gargantext.API.Admin.Auth (AuthContext, auth)
import Gargantext.API.Admin.FrontEnd (frontEndServer) import Gargantext.API.Admin.FrontEnd (frontEndServer)
import Gargantext.API.Admin.Settings (newEnv) import Gargantext.API.Admin.Settings (newEnv)
import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, env_gargConfig, jwtSettings, settings) import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, env_gargConfig, jwtSettings, settings)
import Gargantext.API.Ngrams (HasRepoSaver(..), saveRepo) import Gargantext.API.Ngrams (saveRepo)
import Gargantext.API.Ngrams.Types (HasRepoSaver(..))
import Gargantext.API.Prelude import Gargantext.API.Prelude
import Gargantext.API.Routes import Gargantext.API.Routes
import Gargantext.Prelude import Gargantext.Prelude
......
...@@ -25,9 +25,8 @@ import Data.Text (Text) ...@@ -25,9 +25,8 @@ import Data.Text (Text)
import Servant import Servant
import Gargantext.API.HashedResponse import Gargantext.API.HashedResponse
import Gargantext.API.Ngrams (ngramsTypeFromTabType)
import Gargantext.API.Ngrams.Types
import Gargantext.API.Ngrams.NTree import Gargantext.API.Ngrams.NTree
import Gargantext.API.Ngrams.Types
import Gargantext.API.Prelude (GargServer) import Gargantext.API.Prelude (GargServer)
import Gargantext.Core.Types (CorpusId, Limit, ListId, ListType(..)) import Gargantext.Core.Types (CorpusId, Limit, ListId, ListType(..))
import Gargantext.Database.Action.Flow import Gargantext.Database.Action.Flow
......
...@@ -30,8 +30,6 @@ module Gargantext.API.Ngrams ...@@ -30,8 +30,6 @@ module Gargantext.API.Ngrams
, getTableNgrams , getTableNgrams
, setListNgrams , setListNgrams
--, rmListNgrams TODO fix before exporting --, rmListNgrams TODO fix before exporting
, putListNgrams
--, putListNgrams'
, apiNgramsTableCorpus , apiNgramsTableCorpus
, apiNgramsTableDoc , apiNgramsTableDoc
...@@ -64,7 +62,6 @@ module Gargantext.API.Ngrams ...@@ -64,7 +62,6 @@ module Gargantext.API.Ngrams
, renv_lock , renv_lock
, TabType(..) , TabType(..)
, ngramsTypeFromTabType
, HasRepoVar(..) , HasRepoVar(..)
, HasRepoSaver(..) , HasRepoSaver(..)
...@@ -119,9 +116,10 @@ import Prelude (error) ...@@ -119,9 +116,10 @@ import Prelude (error)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.API.Admin.Types (HasSettings) import Gargantext.API.Admin.Types (HasSettings)
import qualified Gargantext.API.Metrics as Metrics
import Gargantext.API.Ngrams.Types import Gargantext.API.Ngrams.Types
import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, Limit, Offset, HasInvalidError, assertValid) import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, Limit, Offset, HasInvalidError, TODO, assertValid)
import Gargantext.Core.Types (TODO) import Gargantext.Core.Utils (something)
import Gargantext.Core.Viz.Graph.API (recomputeGraph) import Gargantext.Core.Viz.Graph.API (recomputeGraph)
import Gargantext.Core.Viz.Graph.Distances (Distance(Conditional)) import Gargantext.Core.Viz.Graph.Distances (Distance(Conditional))
import Gargantext.Database.Action.Metrics.NgramsByNode (getOccByNgramsOnlyFast') import Gargantext.Database.Action.Metrics.NgramsByNode (getOccByNgramsOnlyFast')
...@@ -180,17 +178,6 @@ mkChildrenGroups addOrRem nt patches = ...@@ -180,17 +178,6 @@ mkChildrenGroups addOrRem nt patches =
] ]
-} -}
ngramsTypeFromTabType :: TabType -> TableNgrams.NgramsType
ngramsTypeFromTabType tabType =
let lieu = "Garg.API.Ngrams: " :: Text in
case tabType of
Sources -> TableNgrams.Sources
Authors -> TableNgrams.Authors
Institutes -> TableNgrams.Institutes
Terms -> TableNgrams.NgramsTerms
_ -> panic $ lieu <> "No Ngrams for this tab"
-- TODO: This `panic` would disapear with custom NgramsType.
------------------------------------------------------------------------ ------------------------------------------------------------------------
saveRepo :: ( MonadReader env m, MonadBase IO m, HasRepoSaver env ) saveRepo :: ( MonadReader env m, MonadBase IO m, HasRepoSaver env )
...@@ -220,10 +207,6 @@ insertNewOnly :: a -> Maybe b -> a ...@@ -220,10 +207,6 @@ insertNewOnly :: a -> Maybe b -> a
insertNewOnly m = maybe m (const $ error "insertNewOnly: impossible") insertNewOnly m = maybe m (const $ error "insertNewOnly: impossible")
-- TODO error handling -- TODO error handling
something :: Monoid a => Maybe a -> a
something Nothing = mempty
something (Just a) = a
{- unused {- unused
-- TODO refactor with putListNgrams -- TODO refactor with putListNgrams
copyListNgrams :: RepoCmdM env err m copyListNgrams :: RepoCmdM env err m
...@@ -280,62 +263,6 @@ setListNgrams listId ngramsType ns = do ...@@ -280,62 +263,6 @@ setListNgrams listId ngramsType ns = do
) )
saveRepo saveRepo
-- NOTE
-- This is no longer part of the API.
-- This function is maintained for its usage in Database.Action.Flow.List.
-- If the given list of ngrams elements contains ngrams already in
-- the repo, they will be ignored.
putListNgrams :: (HasInvalidError err, RepoCmdM env err m)
=> NodeId
-> TableNgrams.NgramsType
-> [NgramsElement]
-> m ()
putListNgrams _ _ [] = pure ()
putListNgrams nodeId ngramsType nes = putListNgrams' nodeId ngramsType m
where
m = Map.fromList $ map (\n -> (n ^. ne_ngrams, ngramsElementToRepo n)) nes
putListNgrams' :: (HasInvalidError err, RepoCmdM env err m)
=> NodeId
-> TableNgrams.NgramsType
-> Map NgramsTerm NgramsRepoElement
-> m ()
putListNgrams' nodeId ngramsType ns = do
-- printDebug "[putListNgrams'] nodeId" nodeId
-- printDebug "[putListNgrams'] ngramsType" ngramsType
-- printDebug "[putListNgrams'] ns" ns
let p1 = NgramsTablePatch . PM.fromMap $ NgramsReplace Nothing . Just <$> ns
(p0, p0_validity) = PM.singleton nodeId p1
(p, p_validity) = PM.singleton ngramsType p0
assertValid p0_validity
assertValid p_validity
{-
-- TODO
v <- currentVersion
q <- commitStatePatch (Versioned v p)
assert empty q
-- What if another commit comes in between?
-- Shall we have a blindCommitStatePatch? It would not ask for a version but just a patch.
-- The modifyMVar_ would test the patch with applicable first.
-- If valid the rest would be atomic and no merge is required.
-}
var <- view repoVar
liftBase $ modifyMVar_ var $ \r -> do
pure $ r & r_version +~ 1
& r_history %~ (p :)
& r_state . at ngramsType %~
(Just .
(at nodeId %~
( Just
. (<> ns)
. something
)
)
. something
)
saveRepo
currentVersion :: RepoCmdM env err m currentVersion :: RepoCmdM env err m
=> m Version => m Version
...@@ -420,8 +347,30 @@ tableNgramsPut tabType listId (Versioned p_version p_table) ...@@ -420,8 +347,30 @@ tableNgramsPut tabType listId (Versioned p_version p_table)
node <- getNode listId node <- getNode listId
let nId = _node_id node let nId = _node_id node
uId = _node_userId node uId = _node_userId node
mCId = _node_parentId node
printDebug "[tableNgramsPut] updating graph with nId" nId
printDebug "[tableNgramsPut] updating graph with uId" uId
_ <- recomputeGraph uId nId Conditional _ <- recomputeGraph uId nId Conditional
_ <- case mCId of
Nothing -> do
printDebug "[tableNgramsPut] can't update charts, no parent, nId" nId
pure ()
Just cId -> do
printDebug "[tableNgramsPut] updating scatter cId" cId
_ <- Metrics.updateScatter cId Nothing tabType Nothing
printDebug "[tableNgramsPut] updating chart cId" cId
_ <- Metrics.updateChart cId Nothing tabType Nothing
printDebug "[tableNgramsPut] updating pie cId" cId
_ <- Metrics.updatePie cId Nothing tabType Nothing
printDebug "[tableNgramsPut] updating tree StopTerm, cId" cId
_ <- Metrics.updateTree cId Nothing tabType StopTerm
printDebug "[tableNgramsPut] updating tree CandidateTerm, cId" cId
_ <- Metrics.updateTree cId Nothing tabType CandidateTerm
printDebug "[tableNgramsPut] updating tree MapTerm, cId" cId
_ <- Metrics.updateTree cId Nothing tabType MapTerm
pure ()
pure ret pure ret
{- {-
......
...@@ -33,7 +33,7 @@ import Gargantext.API.Ngrams.Types (NgramsTableMap, RepoCmdM, Versioned(..)) ...@@ -33,7 +33,7 @@ import Gargantext.API.Ngrams.Types (NgramsTableMap, RepoCmdM, Versioned(..))
import Gargantext.API.Node.Corpus.New.File (FileType(..)) import Gargantext.API.Node.Corpus.New.File (FileType(..))
import Gargantext.API.Prelude (GargServer) import Gargantext.API.Prelude (GargServer)
import Gargantext.Core.Utils.Prefix (unPrefixSwagger) import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
import Gargantext.Database.Action.Flow (FlowCmdM) import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Schema.Ngrams (NgramsType(..), ngramsTypes) import Gargantext.Database.Schema.Ngrams (NgramsType(..), ngramsTypes)
import Gargantext.Prelude import Gargantext.Prelude
......
...@@ -725,3 +725,15 @@ instance Arbitrary NgramsRepoElement where ...@@ -725,3 +725,15 @@ instance Arbitrary NgramsRepoElement where
instance FromHttpApiData (Map TableNgrams.NgramsType (Versioned NgramsTableMap)) instance FromHttpApiData (Map TableNgrams.NgramsType (Versioned NgramsTableMap))
where where
parseUrlPiece x = maybeToEither x (decode $ cs x) parseUrlPiece x = maybeToEither x (decode $ cs x)
ngramsTypeFromTabType :: TabType -> TableNgrams.NgramsType
ngramsTypeFromTabType tabType =
let lieu = "Garg.API.Ngrams: " :: Text in
case tabType of
Sources -> TableNgrams.Sources
Authors -> TableNgrams.Authors
Institutes -> TableNgrams.Institutes
Terms -> TableNgrams.NgramsTerms
_ -> panic $ lieu <> "No Ngrams for this tab"
-- TODO: This `panic` would disapear with custom NgramsType.
...@@ -42,7 +42,8 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) ...@@ -42,7 +42,8 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import Gargantext.API.Admin.Auth (withAccess, PathId(..)) import Gargantext.API.Admin.Auth (withAccess, PathId(..))
import Gargantext.API.Metrics import Gargantext.API.Metrics
import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus) import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableCorpus)
import Gargantext.API.Ngrams.Types (TabType(..))
import Gargantext.API.Node.File import Gargantext.API.Node.File
import Gargantext.API.Node.New import Gargantext.API.Node.New
import Gargantext.API.Prelude import Gargantext.API.Prelude
......
...@@ -29,7 +29,7 @@ import qualified Gargantext.API.Node.Corpus.New.File as NewFile ...@@ -29,7 +29,7 @@ import qualified Gargantext.API.Node.Corpus.New.File as NewFile
import Gargantext.API.Admin.Orchestrator.Types hiding (AsyncJobs) import Gargantext.API.Admin.Orchestrator.Types hiding (AsyncJobs)
import Gargantext.Core (Lang(..)) import Gargantext.Core (Lang(..))
import Gargantext.Core.Utils.Prefix (unPrefixSwagger) import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
import Gargantext.Database.Action.Flow (FlowCmdM) -- flowAnnuaire import Gargantext.Database.Action.Flow.Types (FlowCmdM) -- flowAnnuaire
import Gargantext.Database.Admin.Types.Node (AnnuaireId) import Gargantext.Database.Admin.Types.Node (AnnuaireId)
import Gargantext.Prelude import Gargantext.Prelude
......
...@@ -33,7 +33,7 @@ import Servant.Swagger.Internal ...@@ -33,7 +33,7 @@ import Servant.Swagger.Internal
import Test.QuickCheck (elements) import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import Gargantext.API.Ngrams (TODO) import Gargantext.Core.Types (TODO)
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude -- (Cmd, CmdM) import Gargantext.Database.Prelude -- (Cmd, CmdM)
import Gargantext.Prelude import Gargantext.Prelude
......
{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-matches #-}
{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-matches -fno-warn-unused-imports #-}
module Gargantext.API.Node.File where module Gargantext.API.Node.File where
...@@ -8,21 +9,12 @@ import Control.Lens ((^.)) ...@@ -8,21 +9,12 @@ import Control.Lens ((^.))
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Lazy as BSL
import qualified Data.MIME.Types as DMT import qualified Data.MIME.Types as DMT
import Data.Monoid (mempty)
import Data.Swagger import Data.Swagger
import Data.Text import Data.Text
import Data.Text.Encoding
import qualified Data.Text.IO as TIO
import GHC.Generics (Generic) import GHC.Generics (Generic)
import qualified Network.HTTP.Media as M import qualified Network.HTTP.Media as M
import Network.Wai.Application.Static
import Servant import Servant
import Servant.API.Raw (Raw)
import Servant.Job.Async (JobFunction(..), serveJobsAPI) import Servant.Job.Async (JobFunction(..), serveJobsAPI)
import Servant.Job.Core
import Servant.Job.Types
import Servant.Job.Utils (jsonOptions)
import Servant.Server.Internal
import Gargantext.Prelude import Gargantext.Prelude
import qualified Gargantext.Prelude.Utils as GPU import qualified Gargantext.Prelude.Utils as GPU
......
...@@ -41,7 +41,7 @@ import Test.QuickCheck (elements) ...@@ -41,7 +41,7 @@ import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import Gargantext.API.HashedResponse import Gargantext.API.HashedResponse
import Gargantext.API.Ngrams (TabType(..)) import Gargantext.API.Ngrams.Types (TabType(..))
import Gargantext.API.Prelude (GargServer) import Gargantext.API.Prelude (GargServer)
import Gargantext.Core.Types (Offset, Limit, TableResult(..)) import Gargantext.Core.Types (Offset, Limit, TableResult(..))
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
......
...@@ -16,6 +16,7 @@ module Gargantext.Core.Flow.Types where ...@@ -16,6 +16,7 @@ module Gargantext.Core.Flow.Types where
import Control.Lens -- (Lens') import Control.Lens -- (Lens')
import Data.Map (Map) import Data.Map (Map)
import Gargantext.Core.Text (HasText(..)) import Gargantext.Core.Text (HasText(..))
import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
......
...@@ -26,7 +26,7 @@ import qualified Data.Map as Map ...@@ -26,7 +26,7 @@ import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Data.Text as Text import qualified Data.Text as Text
import Gargantext.API.Ngrams (NgramsElement, mkNgramsElement, NgramsTerm(..), RootParent(..), mSetFromList) import Gargantext.API.Ngrams.Types (NgramsElement, mkNgramsElement, NgramsTerm(..), RootParent(..), mSetFromList)
-- import Gargantext.API.Ngrams.Tools (getCoocByNgrams', Diagonal(..)) -- import Gargantext.API.Ngrams.Tools (getCoocByNgrams', Diagonal(..))
import Gargantext.Core (Lang(..)) import Gargantext.Core (Lang(..))
import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId) import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId)
......
...@@ -39,23 +39,24 @@ import Data.Map (Map) ...@@ -39,23 +39,24 @@ import Data.Map (Map)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Text (Text) import Data.Text (Text)
import Data.Traversable import Data.Traversable
import qualified Data.List as List
import qualified Data.Set as Set
import qualified Data.Text as Text
import GHC.Base (String) import GHC.Base (String)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.Core import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Core.Flow.Types import Gargantext.Core.Flow.Types
import Gargantext.Prelude
import Gargantext.Core.Text (sentences, HasText(..)) import Gargantext.Core.Text (sentences, HasText(..))
import Gargantext.Core.Text.Terms.Eleve (mainEleveWith, Tries, Token, buildTries, toToken) import Gargantext.Core.Text.Terms.Eleve (mainEleveWith, Tries, Token, buildTries, toToken)
import Gargantext.Database.Schema.Ngrams (Ngrams(..), NgramsType(..))
import Gargantext.Core.Text.Terms.Mono (monoTerms) import Gargantext.Core.Text.Terms.Mono (monoTerms)
import Gargantext.Database.Prelude (Cmd)
import Gargantext.Core.Text.Terms.Mono.Stem (stem) import Gargantext.Core.Text.Terms.Mono.Stem (stem)
import Gargantext.Core.Text.Terms.Mono.Token.En (tokenize) import Gargantext.Core.Text.Terms.Mono.Token.En (tokenize)
import Gargantext.Core.Text.Terms.Multi (multiterms) import Gargantext.Core.Text.Terms.Multi (multiterms)
import qualified Data.List as List import Gargantext.Core.Types
import qualified Data.Set as Set import Gargantext.Database.Prelude (Cmd)
import qualified Data.Text as Text import Gargantext.Database.Schema.Ngrams (Ngrams(..), NgramsType(..))
import Gargantext.Prelude
data TermType lang data TermType lang
......
...@@ -165,4 +165,3 @@ instance ToParamSchema TODO where ...@@ -165,4 +165,3 @@ instance ToParamSchema TODO where
---------------------------------------------------------------------------- ----------------------------------------------------------------------------
...@@ -15,6 +15,17 @@ commentary with @some markup@. ...@@ -15,6 +15,17 @@ commentary with @some markup@.
module Gargantext.Core.Utils ( module Gargantext.Core.Utils (
-- module Gargantext.Utils.Chronos -- module Gargantext.Utils.Chronos
module Gargantext.Core.Utils.Prefix module Gargantext.Core.Utils.Prefix
, something
) where ) where
import Data.Maybe
import Data.Monoid
-- import Gargantext.Utils.Chronos -- import Gargantext.Utils.Chronos
import Gargantext.Core.Utils.Prefix import Gargantext.Core.Utils.Prefix
something :: Monoid a => Maybe a -> a
something Nothing = mempty
something (Just a) = a
...@@ -60,36 +60,36 @@ import GHC.Generics (Generic) ...@@ -60,36 +60,36 @@ import GHC.Generics (Generic)
import System.FilePath (FilePath) import System.FilePath (FilePath)
import Gargantext.Core (Lang(..)) import Gargantext.Core (Lang(..))
import Gargantext.Core.Ext.IMT (toSchoolName)
import Gargantext.Core.Ext.IMTUser (deserialiseImtUsersFromFile)
import Gargantext.Core.Flow.Types import Gargantext.Core.Flow.Types
import Gargantext.Core.Text
import Gargantext.Core.Text.Corpus.Parsers (parseFile, FileFormat)
import Gargantext.Core.Text.List (buildNgramsLists,StopSize(..))
import Gargantext.Core.Text.Terms
import Gargantext.Core.Text.Terms.Mono.Stem.En (stemIt)
import Gargantext.Core.Types (Terms(..)) import Gargantext.Core.Types (Terms(..))
import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Core.Types.Main import Gargantext.Core.Types.Main
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Database.Action.Flow.List import Gargantext.Database.Action.Flow.List
import Gargantext.Database.Action.Flow.Types import Gargantext.Database.Action.Flow.Types
import Gargantext.Database.Action.Flow.Utils (insertDocNgrams) import Gargantext.Database.Action.Flow.Utils (insertDocNgrams)
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.Action.Search (searchDocInDatabase) import Gargantext.Database.Action.Search (searchDocInDatabase)
import Gargantext.Database.Admin.Config (userMaster, corpusMasterName) import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId) import Gargantext.Database.Admin.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
import Gargantext.Database.Prelude 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.Ngrams
import Gargantext.Database.Query.Table.NodeNgrams (listInsertDb , getCgramsId) import Gargantext.Database.Query.Table.NodeNgrams (listInsertDb , getCgramsId)
import Gargantext.Database.Query.Table.NodeNodeNgrams2 import Gargantext.Database.Query.Table.NodeNodeNgrams2
import Gargantext.Database.Prelude
import Gargantext.Database.Schema.Node (NodePoly(..)) import Gargantext.Database.Schema.Node (NodePoly(..))
import Gargantext.Core.Ext.IMT (toSchoolName)
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Core.Ext.IMTUser (deserialiseImtUsersFromFile)
import Gargantext.Core.Text
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Prelude.Crypto.Hash (Hash) import Gargantext.Prelude.Crypto.Hash (Hash)
import Gargantext.Core.Text.Corpus.Parsers (parseFile, FileFormat)
import Gargantext.Core.Text.List (buildNgramsLists,StopSize(..))
import Gargantext.Core.Text.Terms.Mono.Stem.En (stemIt)
import Gargantext.Core.Text.Terms
import qualified Gargantext.Database.Query.Table.Node.Document.Add as Doc (add) import qualified Gargantext.Database.Query.Table.Node.Document.Add as Doc (add)
import qualified Gargantext.Core.Text.Corpus.API as API import qualified Gargantext.Core.Text.Corpus.API as API
......
...@@ -9,8 +9,6 @@ Portability : POSIX ...@@ -9,8 +9,6 @@ Portability : POSIX
-} -}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ConstrainedClassMethods #-} {-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
...@@ -19,21 +17,28 @@ Portability : POSIX ...@@ -19,21 +17,28 @@ Portability : POSIX
module Gargantext.Database.Action.Flow.List module Gargantext.Database.Action.Flow.List
where where
import Control.Monad (mapM_) import Control.Concurrent
import Control.Lens (view, (^.), (+~), (%~), at)
import Control.Monad.Reader
import qualified Data.List as List import qualified Data.List as List
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Map (Map, toList) import Data.Map (Map, toList)
import qualified Data.Map.Strict.Patch as PM
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import Data.Text (Text) import Data.Text (Text)
import Gargantext.API.Ngrams (NgramsElement(..), NgramsTerm(..), putListNgrams) import Gargantext.API.Ngrams.Types (HasRepoSaver(..), NgramsElement(..), NgramsPatch(..), NgramsRepoElement(..), NgramsTablePatch(..), NgramsTerm(..), RepoCmdM, ne_ngrams, ngramsElementToRepo, r_history, r_state, r_version, repoVar)
import Gargantext.Core.Flow.Types import Gargantext.Core.Flow.Types
import Gargantext.Core.Types (HasInvalidError(..), assertValid)
import Gargantext.Core.Types.Main (ListType(CandidateTerm)) import Gargantext.Core.Types.Main (ListType(CandidateTerm))
import Gargantext.Database.Admin.Types.Node import Gargantext.Core.Utils (something)
import Gargantext.Database.Query.Table.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb, getCgramsId)
import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams, NgramsType(..), text2ngrams, ngramsTypeId)
import Gargantext.Database.Action.Flow.Types import Gargantext.Database.Action.Flow.Types
import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Query.Table.Node_NodeNgramsNodeNgrams import Gargantext.Database.Query.Table.Node_NodeNgramsNodeNgrams
import Gargantext.Database.Query.Table.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb, getCgramsId)
-- import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams, NgramsType(..), text2ngrams, ngramsTypeId)
import Gargantext.Database.Schema.Ngrams (Ngrams(..), NgramsType(..))
import Gargantext.Prelude import Gargantext.Prelude
-- FLOW LIST -- FLOW LIST
...@@ -145,3 +150,65 @@ listInsert lId ngs = mapM_ (\(typeList, ngElmts) ...@@ -145,3 +150,65 @@ listInsert lId ngs = mapM_ (\(typeList, ngElmts)
------------------------------------------------------------------------ ------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- NOTE
-- This is no longer part of the API.
-- This function is maintained for its usage in Database.Action.Flow.List.
-- If the given list of ngrams elements contains ngrams already in
-- the repo, they will be ignored.
putListNgrams :: (HasInvalidError err, RepoCmdM env err m)
=> NodeId
-> TableNgrams.NgramsType
-> [NgramsElement]
-> m ()
putListNgrams _ _ [] = pure ()
putListNgrams nodeId ngramsType nes = putListNgrams' nodeId ngramsType m
where
m = Map.fromList $ map (\n -> (n ^. ne_ngrams, ngramsElementToRepo n)) nes
putListNgrams' :: (HasInvalidError err, RepoCmdM env err m)
=> NodeId
-> TableNgrams.NgramsType
-> Map NgramsTerm NgramsRepoElement
-> m ()
putListNgrams' nodeId ngramsType ns = do
-- printDebug "[putListNgrams'] nodeId" nodeId
-- printDebug "[putListNgrams'] ngramsType" ngramsType
-- printDebug "[putListNgrams'] ns" ns
let p1 = NgramsTablePatch . PM.fromMap $ NgramsReplace Nothing . Just <$> ns
(p0, p0_validity) = PM.singleton nodeId p1
(p, p_validity) = PM.singleton ngramsType p0
assertValid p0_validity
assertValid p_validity
{-
-- TODO
v <- currentVersion
q <- commitStatePatch (Versioned v p)
assert empty q
-- What if another commit comes in between?
-- Shall we have a blindCommitStatePatch? It would not ask for a version but just a patch.
-- The modifyMVar_ would test the patch with applicable first.
-- If valid the rest would be atomic and no merge is required.
-}
var <- view repoVar
liftBase $ modifyMVar_ var $ \r -> do
pure $ r & r_version +~ 1
& r_history %~ (p :)
& r_state . at ngramsType %~
(Just .
(at nodeId %~
( Just
. (<> ns)
. something
)
)
. something
)
saveRepo
saveRepo :: ( MonadReader env m, MonadBase IO m, HasRepoSaver env )
=> m ()
saveRepo = liftBase =<< view repoSaver
...@@ -20,11 +20,12 @@ module Gargantext.Database.Action.Flow.Types ...@@ -20,11 +20,12 @@ module Gargantext.Database.Action.Flow.Types
where where
import Data.Aeson (ToJSON) import Data.Aeson (ToJSON)
import Gargantext.API.Ngrams.Types
import Gargantext.Core.Types (HasInvalidError) import Gargantext.Core.Types (HasInvalidError)
import Gargantext.Core.Flow.Types import Gargantext.Core.Flow.Types
import Gargantext.Core.Text import Gargantext.Core.Text
import Gargantext.Core.Text.Terms import Gargantext.Core.Text.Terms
import Gargantext.API.Ngrams (HasRepoVar, RepoCmdM)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError) import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Prelude (CmdM) import Gargantext.Database.Prelude (CmdM)
import Gargantext.Database.Query.Table.Node.Document.Insert import Gargantext.Database.Query.Table.Node.Document.Insert
......
...@@ -16,11 +16,13 @@ module Gargantext.Database.Action.Metrics ...@@ -16,11 +16,13 @@ module Gargantext.Database.Action.Metrics
where where
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as Map
import Data.Text (Text) import Data.Text (Text)
import Gargantext.API.Ngrams (TabType(..), ngramsTypeFromTabType)
import Gargantext.API.Ngrams.Types (TabType(..), ngramsTypeFromTabType)
import Gargantext.API.Ngrams.Tools (filterListWithRoot, groupNodesByNgrams, Diagonal(..), getCoocByNgrams, mapTermListRoot, RootTerm, getRepo) import Gargantext.API.Ngrams.Tools (filterListWithRoot, groupNodesByNgrams, Diagonal(..), getCoocByNgrams, mapTermListRoot, RootTerm, getRepo)
import Gargantext.Core.Types (ListType(..), Limit, NodeType(..)) import Gargantext.Core.Types (ListType(..), Limit, NodeType(..))
import Gargantext.Database.Action.Flow (FlowCmdM) import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsOnlyUser{-, getTficfWith-}) import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsOnlyUser{-, getTficfWith-})
import Gargantext.Database.Admin.Config (userMaster) import Gargantext.Database.Admin.Config (userMaster)
import Gargantext.Database.Admin.Types.Node (ListId, CorpusId) import Gargantext.Database.Admin.Types.Node (ListId, CorpusId)
...@@ -28,7 +30,6 @@ import Gargantext.Database.Query.Table.Node (defaultList) ...@@ -28,7 +30,6 @@ import Gargantext.Database.Query.Table.Node (defaultList)
import Gargantext.Database.Query.Table.Node.Select import Gargantext.Database.Query.Table.Node.Select
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Core.Text.Metrics (scored, Scored(..), {-localMetrics, toScored-}) import Gargantext.Core.Text.Metrics (scored, Scored(..), {-localMetrics, toScored-})
import qualified Data.Map as Map
getMetrics :: FlowCmdM env err m getMetrics :: FlowCmdM env err m
=> CorpusId -> Maybe ListId -> TabType -> Maybe Limit => CorpusId -> Maybe ListId -> TabType -> Maybe Limit
......
...@@ -19,15 +19,16 @@ Portability : POSIX ...@@ -19,15 +19,16 @@ Portability : POSIX
module Gargantext.Database.Action.Metrics.Lists module Gargantext.Database.Action.Metrics.Lists
where where
import Gargantext.API.Ngrams (TabType(..))
import Gargantext.Core.Types -- (NodePoly(..), NodeCorpus, ListId)
import Gargantext.Database.Action.Flow (FlowCmdM)
import Gargantext.Prelude hiding (sum, head)
import Gargantext.Core.Text.Metrics (Scored(..))
import Prelude hiding (null, id, map, sum) import Prelude hiding (null, id, map, sum)
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Vector as Vec import qualified Data.Vector as Vec
import qualified Gargantext.Database.Action.Metrics as Metrics import qualified Gargantext.Database.Action.Metrics as Metrics
import Gargantext.API.Ngrams.Types (TabType(..))
import Gargantext.Core.Types -- (NodePoly(..), NodeCorpus, ListId)
import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Prelude hiding (sum, head)
import Gargantext.Core.Text.Metrics (Scored(..))
{- {-
trainModel :: FlowCmdM env ServantErr m trainModel :: FlowCmdM env ServantErr m
......
...@@ -25,8 +25,9 @@ module Gargantext.Database.Admin.Types.Hyperdata.Contact ...@@ -25,8 +25,9 @@ module Gargantext.Database.Admin.Types.Hyperdata.Contact
import Data.Time.Segment (jour) import Data.Time.Segment (jour)
import Data.Time (UTCTime) import Data.Time (UTCTime)
import Gargantext.Prelude
import Gargantext.Database.Admin.Types.Hyperdata.Prelude import Gargantext.Database.Admin.Types.Hyperdata.Prelude
import Gargantext.Prelude
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
data HyperdataContact = data HyperdataContact =
...@@ -42,6 +43,7 @@ data HyperdataContact = ...@@ -42,6 +43,7 @@ data HyperdataContact =
} deriving (Eq, Show, Generic) } deriving (Eq, Show, Generic)
defaultHyperdataContact :: HyperdataContact defaultHyperdataContact :: HyperdataContact
defaultHyperdataContact = HyperdataContact (Just "bdd") defaultHyperdataContact = HyperdataContact (Just "bdd")
(Just defaultContactWho) (Just defaultContactWho)
......
...@@ -22,17 +22,18 @@ module Gargantext.Database.Query.Table.Ngrams ...@@ -22,17 +22,18 @@ module Gargantext.Database.Query.Table.Ngrams
where where
import Control.Lens ((^.)) import Control.Lens ((^.))
import Data.Text (Text) import Data.ByteString.Internal (ByteString)
import Data.Map (Map, fromList) import Data.Map (Map, fromList)
import Data.Text (Text)
import qualified Database.PostgreSQL.Simple as PGS
import Gargantext.Core.Types import Gargantext.Core.Types
import Data.ByteString.Internal (ByteString)
import Gargantext.Database.Prelude (runOpaQuery, Cmd) import Gargantext.Database.Prelude (runOpaQuery, Cmd)
import Gargantext.Database.Prelude (runPGSQuery, formatPGSQuery) import Gargantext.Database.Prelude (runPGSQuery, formatPGSQuery)
import Gargantext.Database.Query.Table.NodeNodeNgrams import Gargantext.Database.Query.Table.NodeNodeNgrams
import Gargantext.Database.Schema.Ngrams import Gargantext.Database.Schema.Ngrams
import Gargantext.Database.Schema.Prelude import Gargantext.Database.Schema.Prelude
import Gargantext.Prelude import Gargantext.Prelude
import qualified Database.PostgreSQL.Simple as PGS
queryNgramsTable :: Query NgramsRead queryNgramsTable :: Query NgramsRead
queryNgramsTable = queryTable ngramsTable queryNgramsTable = queryTable ngramsTable
...@@ -95,3 +96,4 @@ queryInsertNgrams = [sql| ...@@ -95,3 +96,4 @@ queryInsertNgrams = [sql|
JOIN ngrams c USING (terms); -- columns of unique index JOIN ngrams c USING (terms); -- columns of unique index
|] |]
...@@ -22,8 +22,9 @@ module Gargantext.Database.Schema.NodesNgramsRepo ...@@ -22,8 +22,9 @@ module Gargantext.Database.Schema.NodesNgramsRepo
where where
import Data.Map.Strict.Patch (PatchMap) import Data.Map.Strict.Patch (PatchMap)
import Gargantext.Database.Schema.Prelude import Gargantext.Database.Schema.Prelude
import Gargantext.API.Ngrams (NgramsStatePatch, NgramsTablePatch) import Gargantext.API.Ngrams.Types (NgramsStatePatch, NgramsTablePatch)
import Gargantext.Database.Schema.Ngrams (NgramsType) import Gargantext.Database.Schema.Ngrams (NgramsType)
import Gargantext.Database.Admin.Types.Node (NodeId) import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Prelude import Gargantext.Prelude
......
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