[refactor] some more refactoring

parent c0adc078
...@@ -180,6 +180,19 @@ The good news is that you don't have to do all of this manually; during developm ...@@ -180,6 +180,19 @@ The good news is that you don't have to do all of this manually; during developm
./bin/update-project-dependencies ./bin/update-project-dependencies
``` ```
#### Using =ghcup=
If you want to use ghcup and haskell-language-server for development,
please keep in mind that we use custom GHC 9.4.7. By default ghcup
doesn't install hls for 9.4.7 but for 9.4.8 (as of 2024-02-23). So you
should invoke:
```sh
ghcup compile hls --version 2.5.0.0 --ghc 9.4.7
```
See https://www.haskell.org/ghcup/guide/#hls for more details.
## Initialization <a name="init"></a> ## Initialization <a name="init"></a>
#### 1. Docker-compose will configure your database and some NLP bricks (such as CoreNLP): #### 1. Docker-compose will configure your database and some NLP bricks (such as CoreNLP):
......
...@@ -109,6 +109,7 @@ library ...@@ -109,6 +109,7 @@ library
Gargantext.API.Ngrams.Prelude Gargantext.API.Ngrams.Prelude
Gargantext.API.Node Gargantext.API.Node
Gargantext.API.Node.Corpus.New Gargantext.API.Node.Corpus.New
Gargantext.API.Node.Corpus.New.Types
Gargantext.API.Node.Corpus.Types Gargantext.API.Node.Corpus.Types
Gargantext.API.Node.Corpus.Update Gargantext.API.Node.Corpus.Update
Gargantext.API.Node.File Gargantext.API.Node.File
...@@ -244,7 +245,6 @@ library ...@@ -244,7 +245,6 @@ library
Gargantext.API.Node.Corpus.Export Gargantext.API.Node.Corpus.Export
Gargantext.API.Node.Corpus.Export.Types Gargantext.API.Node.Corpus.Export.Types
Gargantext.API.Node.Corpus.New.File Gargantext.API.Node.Corpus.New.File
Gargantext.API.Node.Corpus.New.Types
Gargantext.API.Node.Corpus.Searx Gargantext.API.Node.Corpus.Searx
Gargantext.API.Node.Document.Export Gargantext.API.Node.Document.Export
Gargantext.API.Node.Document.Export.Types Gargantext.API.Node.Document.Export.Types
......
...@@ -129,7 +129,7 @@ api uid (Query q _ as) = do ...@@ -129,7 +129,7 @@ api uid (Query q _ as) = do
------------------------------------------------ ------------------------------------------------
-- TODO use this route for Client implementation -- TODO use this route for Client implementation
data ApiInfo = ApiInfo { api_info :: [API.ExternalAPIs]} newtype ApiInfo = ApiInfo { api_info :: [API.ExternalAPIs]}
deriving (Generic) deriving (Generic)
instance Arbitrary ApiInfo where instance Arbitrary ApiInfo where
arbitrary = ApiInfo <$> arbitrary arbitrary = ApiInfo <$> arbitrary
......
...@@ -13,16 +13,23 @@ Portability : POSIX ...@@ -13,16 +13,23 @@ Portability : POSIX
module Gargantext.API.Node.Corpus.Types where module Gargantext.API.Node.Corpus.Types where
import Control.Lens hiding (elements, Empty) import Control.Lens ( (?~) )
import Control.Monad.Fail (fail) import Control.Monad.Fail (fail)
import Data.Aeson import Data.Aeson
import Data.Swagger import Data.Swagger
( NamedSchema(NamedSchema),
genericDeclareNamedSchemaUnrestricted,
defaultSchemaOptions,
SwaggerType(SwaggerObject),
ToSchema(..),
HasType(type_) )
import Data.Text qualified as T import Data.Text qualified as T
import Gargantext.Core.Text.Corpus.Types qualified as Types import Gargantext.Core.Text.Corpus.Types qualified as Types
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Database.Action.Flow.Types (DataOrigin(..)) import Gargantext.Database.Action.Flow.Types (DataOrigin(..))
import Gargantext.Prelude import Gargantext.Prelude
import Test.QuickCheck import Test.QuickCheck
( Arbitrary(arbitrary), oneof, arbitraryBoundedEnum )
data Database = Empty data Database = Empty
| OpenAlex | OpenAlex
......
...@@ -43,7 +43,7 @@ TODO: ...@@ -43,7 +43,7 @@ TODO:
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Core.NodeStory module Gargantext.Core.NodeStory
( module Gargantext.Core.NodeStory.Types ( module Gargantext.Core.NodeStory.Types
...@@ -295,7 +295,7 @@ fromDBNodeStoryEnv pool = do ...@@ -295,7 +295,7 @@ fromDBNodeStoryEnv pool = do
, _nse_getter = \nId -> withResource pool $ \c -> , _nse_getter = \nId -> withResource pool $ \c ->
getNodeStory' c nId getNodeStory' c nId
, _nse_getter_multi = \nIds -> withResource pool $ \c -> , _nse_getter_multi = \nIds -> withResource pool $ \c ->
foldM (\m nId -> nodeStoryInc c m nId) (NodeStory Map.empty) nIds foldM (nodeStoryInc c) (NodeStory Map.empty) nIds
} }
currentVersion :: (HasNodeStory env err m) => ListId -> m Version currentVersion :: (HasNodeStory env err m) => ListId -> m Version
...@@ -347,7 +347,7 @@ fixNodeStoryVersions = do ...@@ -347,7 +347,7 @@ fixNodeStoryVersions = do
[PGS.Only (Just maxVersion)] -> do [PGS.Only (Just maxVersion)] -> do
_ <- runPGSExecute c updateVerQuery (maxVersion, nId, ngramsType) _ <- runPGSExecute c updateVerQuery (maxVersion, nId, ngramsType)
pure () pure ()
_ -> panicTrace "Should get only 1 result!" _other -> panicTrace "Should get only 1 result!"
----------------------------------------- -----------------------------------------
......
...@@ -9,9 +9,6 @@ Portability : POSIX ...@@ -9,9 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
module Gargantext.Core.Text.Corpus.Types module Gargantext.Core.Text.Corpus.Types
where where
......
...@@ -46,16 +46,14 @@ import Data.Conduit.List qualified as CList ...@@ -46,16 +46,14 @@ import Data.Conduit.List qualified as CList
import Data.HashMap.Strict qualified as HashMap import Data.HashMap.Strict qualified as HashMap
import Data.List qualified as List import Data.List qualified as List
import Data.Map.Strict qualified as Map import Data.Map.Strict qualified as Map
import Data.Proxy
import Data.Set qualified as Set import Data.Set qualified as Set
import Data.Text qualified as T import Data.Text qualified as T
import EPO.API.Client.Types qualified as EPO import EPO.API.Client.Types qualified as EPO
import Gargantext.Core (Lang(..), NLPServerConfig) import Gargantext.Core (Lang(..), NLPServerConfig, withDefaultLanguage)
import Gargantext.Core (withDefaultLanguage)
import Gargantext.Core.Ext.IMTUser (readFile_Annuaire) import Gargantext.Core.Ext.IMTUser (readFile_Annuaire)
import Gargantext.Core.Ngrams.Tools (getTermsWith)
import Gargantext.Core.NLP (HasNLPServer, nlpServerGet) import Gargantext.Core.NLP (HasNLPServer, nlpServerGet)
import Gargantext.Core.NodeStory (HasNodeStory) import Gargantext.Core.Ngrams.Tools (getTermsWith)
import Gargantext.Core.NodeStory.Types ( HasNodeStory )
import Gargantext.Core.Text.Corpus.API qualified as API import Gargantext.Core.Text.Corpus.API qualified as API
import Gargantext.Core.Text.Corpus.Parsers (parseFile) import Gargantext.Core.Text.Corpus.Parsers (parseFile)
import Gargantext.Core.Text.Corpus.Parsers.Types (FileFormat, FileType) import Gargantext.Core.Text.Corpus.Parsers.Types (FileFormat, FileType)
...@@ -66,30 +64,32 @@ import Gargantext.Core.Types (HasValidationError) ...@@ -66,30 +64,32 @@ import Gargantext.Core.Types (HasValidationError)
import Gargantext.Core.Types.Individu (User(UserName)) import Gargantext.Core.Types.Individu (User(UserName))
import Gargantext.Core.Types.Main (CorpusName, ListType(MapTerm)) import Gargantext.Core.Types.Main (CorpusName, ListType(MapTerm))
import Gargantext.Core.Types.Query (Limit) import Gargantext.Core.Types.Query (Limit)
import Gargantext.Database.Action.Flow.Utils (buildSocialList, createNodes, docNgrams, insertMasterDocs, saveDocNgramsWith)
import Gargantext.Database.Action.Flow.Types (DataOrigin(..), DataText(..), FlowCorpus, printDataText) import Gargantext.Database.Action.Flow.Types (DataOrigin(..), DataText(..), FlowCorpus, printDataText)
import Gargantext.Database.Action.Flow.Utils (buildSocialList, createNodes, docNgrams, insertMasterDocs, saveDocNgramsWith)
import Gargantext.Database.Action.Metrics (updateNgramsOccurrences, updateContextScore) import Gargantext.Database.Action.Metrics (updateNgramsOccurrences, updateContextScore)
import Gargantext.Database.Action.Search (searchDocInDatabase) import Gargantext.Database.Action.Search (searchDocInDatabase)
import Gargantext.Database.Admin.Config (userMaster) import Gargantext.Database.Admin.Config (userMaster)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAnnuaire, HyperdataContact, HyperdataCorpus, hc_lang, toHyperdataDocument) import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact )
import Gargantext.Database.Admin.Types.Node hiding (DEBUG) import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataAnnuaire, HyperdataCorpus, hc_lang )
import Gargantext.Database.Admin.Types.Hyperdata.Document ( toHyperdataDocument )
import Gargantext.Database.Admin.Types.Node ( AnnuaireId, DocId, ListId, CorpusId, nodeId2ContextId )
import Gargantext.Database.Prelude (DbCmd', DBCmd, hasConfig) import Gargantext.Database.Prelude (DbCmd', DBCmd, hasConfig)
import Gargantext.Database.Query.Table.Ngrams (NgramsType(NgramsTerms), text2ngrams)
import Gargantext.Database.Query.Table.Node (MkCorpus, getNodeWith) import Gargantext.Database.Query.Table.Node (MkCorpus, getNodeWith)
import Gargantext.Database.Query.Table.Node.Document.Add qualified as Doc (add) import Gargantext.Database.Query.Table.Node.Document.Add qualified as Doc (add)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..)) import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Query.Table.NodeContext (selectDocNodes) import Gargantext.Database.Query.Table.NodeContext (selectDocNodes)
import Gargantext.Database.Query.Tree.Root (getOrMk_RootWithCorpus) import Gargantext.Database.Query.Tree.Root (getOrMk_RootWithCorpus)
import Gargantext.Database.Schema.Ngrams ( NgramsType(NgramsTerms), text2ngrams )
import Gargantext.Database.Schema.Node (node_hyperdata) import Gargantext.Database.Schema.Node (node_hyperdata)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Prelude.Config (GargConfig(..)) import Gargantext.Prelude.Config (GargConfig(..))
import Gargantext.System.Logging (LogLevel(DEBUG), MonadLogger, logLocM) import Gargantext.System.Logging (LogLevel(DEBUG), MonadLogger, logLocM)
import Gargantext.Utils.Jobs (JobHandle, MonadJobStatus(..)) import Gargantext.Utils.Jobs.Monad ( JobHandle, MonadJobStatus(..) )
import PUBMED.Types qualified as PUBMED import PUBMED.Types qualified as PUBMED
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- Imports for upgrade function -- Imports for upgrade function
import Gargantext.Database.Query.Tree (HasTreeError) import Gargantext.Database.Query.Tree.Error ( HasTreeError )
--------------- ---------------
...@@ -150,7 +150,7 @@ flowDataText u (DataOld ids) tt cid mfslw _ = do ...@@ -150,7 +150,7 @@ flowDataText u (DataOld ids) tt cid mfslw _ = do
_ <- Doc.add userCorpusId (map nodeId2ContextId ids) _ <- Doc.add userCorpusId (map nodeId2ContextId ids)
flowCorpusUser (_tt_lang tt) u userCorpusId listId corpusType mfslw flowCorpusUser (_tt_lang tt) u userCorpusId listId corpusType mfslw
where where
corpusType = (Nothing :: Maybe HyperdataCorpus) corpusType = Nothing :: Maybe HyperdataCorpus
flowDataText u (DataNew (mLen, txtC)) tt cid mfslw jobHandle = do flowDataText u (DataNew (mLen, txtC)) tt cid mfslw jobHandle = do
$(logLocM) DEBUG $ T.pack $ "Found " <> show mLen <> " new documents to process" $(logLocM) DEBUG $ T.pack $ "Found " <> show mLen <> " new documents to process"
for_ (mLen <&> fromInteger) (`addMoreSteps` jobHandle) for_ (mLen <&> fromInteger) (`addMoreSteps` jobHandle)
...@@ -167,13 +167,13 @@ flowAnnuaire :: ( DbCmd' env err m ...@@ -167,13 +167,13 @@ flowAnnuaire :: ( DbCmd' env err m
, MonadJobStatus m ) , MonadJobStatus m )
=> User => User
-> Either CorpusName [CorpusId] -> Either CorpusName [CorpusId]
-> (TermType Lang) -> TermType Lang
-> FilePath -> FilePath
-> JobHandle m -> JobHandle m
-> m AnnuaireId -> m AnnuaireId
flowAnnuaire u n l filePath jobHandle = do flowAnnuaire u n l filePath jobHandle = do
-- TODO Conduit for file -- TODO Conduit for file
docs <- liftBase $ ((readFile_Annuaire filePath) :: IO [HyperdataContact]) docs <- liftBase (readFile_Annuaire filePath :: IO [HyperdataContact])
flow (Nothing :: Maybe HyperdataAnnuaire) u n l Nothing (fromIntegral $ length docs, yieldMany docs) jobHandle flow (Nothing :: Maybe HyperdataAnnuaire) u n l Nothing (fromIntegral $ length docs, yieldMany docs) jobHandle
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -342,5 +342,4 @@ reIndexWith cId lId nt lts = do ...@@ -342,5 +342,4 @@ reIndexWith cId lId nt lts = do
$ map (docNgrams corpusLang nt ts) docs $ map (docNgrams corpusLang nt ts) docs
-- Saving the indexation in database -- Saving the indexation in database
_ <- mapM (saveDocNgramsWith lId) ngramsByDoc mapM_ (saveDocNgramsWith lId) ngramsByDoc
pure ()
...@@ -25,10 +25,11 @@ import Gargantext.Core.Text (HasText(..)) ...@@ -25,10 +25,11 @@ import Gargantext.Core.Text (HasText(..))
import Gargantext.Core.Text.Corpus.Parsers (splitOn) import Gargantext.Core.Text.Corpus.Parsers (splitOn)
import Gargantext.Core.Text.Terms (ExtractNgramsT, ExtractedNgrams(..), TermType, cleanExtractedNgrams, enrichedTerms, extractNgramsT, extractTerms, tt_lang) import Gargantext.Core.Text.Terms (ExtractNgramsT, ExtractedNgrams(..), TermType, cleanExtractedNgrams, enrichedTerms, extractNgramsT, extractTerms, tt_lang)
import Gargantext.Core.Types (POS(NP), TermsCount) import Gargantext.Core.Types (POS(NP), TermsCount)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataContact, HyperdataDocument, cw_lastName, hc_who, hd_authors, hd_bdd, hd_institutes, hd_source) import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact, cw_lastName, hc_who )
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument, hd_authors, hd_bdd, hd_institutes, hd_source )
import Gargantext.Database.Admin.Types.Node ( Node )
import Gargantext.Database.Prelude (DBCmd) import Gargantext.Database.Prelude (DBCmd)
import Gargantext.Database.Schema.Ngrams import Gargantext.Database.Schema.Ngrams ( NgramsType(..), text2ngrams )
import Gargantext.Database.Schema.Node (NodePoly(..)) import Gargantext.Database.Schema.Node (NodePoly(..))
import Gargantext.Prelude import Gargantext.Prelude
...@@ -37,6 +38,11 @@ import Gargantext.Prelude ...@@ -37,6 +38,11 @@ import Gargantext.Prelude
------------------------------------------------------------------------ ------------------------------------------------------------------------
instance ExtractNgramsT HyperdataContact instance ExtractNgramsT HyperdataContact
where where
extractNgramsT :: HasText HyperdataContact =>
NLPServerConfig
-> TermType Lang
-> HyperdataContact
-> DBCmd err (HashMap.HashMap ExtractedNgrams (Map NgramsType Int, TermsCount))
extractNgramsT _ncs l hc = HashMap.mapKeys (cleanExtractedNgrams 255) <$> extract l hc extractNgramsT _ncs l hc = HashMap.mapKeys (cleanExtractedNgrams 255) <$> extract l hc
where where
extract :: TermType Lang -> HyperdataContact extract :: TermType Lang -> HyperdataContact
......
...@@ -11,30 +11,33 @@ Portability : POSIX ...@@ -11,30 +11,33 @@ Portability : POSIX
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ConstrainedClassMethods #-} {-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE InstanceSigs #-}
module Gargantext.Database.Action.Flow.List module Gargantext.Database.Action.Flow.List
( flowList_DbRepo ( flowList_DbRepo
, toNodeNgramsW' ) , toNodeNgramsW' )
where where
import Control.Lens ((+~), (%~), at) import Control.Lens ((+~), (%~), (?~), at)
import Control.Monad.Reader
import Data.List qualified as List
import Data.Map.Strict (toList) import Data.Map.Strict (toList)
import Data.Map.Strict qualified as Map import Data.Map.Strict qualified as Map
import Data.Map.Strict.Patch qualified as PM import Data.Map.Strict.Patch qualified as PM
import Gargantext.Core.Ngrams.Tools (getNodeStory) import Gargantext.Core.Ngrams.Tools (getNodeStory)
import Gargantext.Core.Ngrams.Types import Gargantext.Core.Ngrams.Types
import Gargantext.Core.NodeStory (HasNodeStory, a_history, a_state, a_version) ( NgramsTerm(NgramsTerm),
NgramsRepoElement,
NgramsElement(..),
ne_ngrams,
NgramsPatch(NgramsReplace),
NgramsTablePatch(NgramsTablePatch),
ngramsElementToRepo )
import Gargantext.Core.NodeStory.Types ( HasNodeStory, a_history, a_state, a_version )
import Gargantext.Core.NodeStory.Utils (saveNodeStory) import Gargantext.Core.NodeStory.Utils (saveNodeStory)
import Gargantext.Core.Types (HasValidationError(..), assertValid) import Gargantext.Core.Types (HasValidationError(..), assertValid)
import Gargantext.Core.Types.Main (ListType(CandidateTerm)) import Gargantext.Core.Types.Main (ListType(CandidateTerm))
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node ( ListId, NodeId )
import Gargantext.Database.Query.Table.Ngrams qualified as TableNgrams
import Gargantext.Database.Query.Table.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb,{- getCgramsId -}) import Gargantext.Database.Query.Table.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb,{- getCgramsId -})
import Gargantext.Database.Schema.Ngrams (NgramsType(..)) import Gargantext.Database.Schema.Ngrams (NgramsType(..))
import Gargantext.Database.Schema.Ngrams qualified as TableNgrams
import Gargantext.Prelude hiding (toList) import Gargantext.Prelude hiding (toList)
-- FLOW LIST -- FLOW LIST
...@@ -110,7 +113,7 @@ flowList_DbRepo lId ngs = do ...@@ -110,7 +113,7 @@ flowList_DbRepo lId ngs = do
toNodeNgramsW :: ListId toNodeNgramsW :: ListId
-> [(NgramsType, [NgramsElement])] -> [(NgramsType, [NgramsElement])]
-> [NodeNgramsW] -> [NodeNgramsW]
toNodeNgramsW l ngs = List.concat $ map (toNodeNgramsW'' l) ngs toNodeNgramsW l = concatMap (toNodeNgramsW'' l)
where where
toNodeNgramsW'' :: ListId toNodeNgramsW'' :: ListId
-> (NgramsType, [NgramsElement]) -> (NgramsType, [NgramsElement])
...@@ -159,8 +162,7 @@ listInsert :: (HasValidationError err, HasNodeStory env err m) ...@@ -159,8 +162,7 @@ listInsert :: (HasValidationError err, HasNodeStory env err m)
=> ListId => ListId
-> Map NgramsType [NgramsElement] -> Map NgramsType [NgramsElement]
-> m () -> m ()
listInsert lId ngs = mapM_ (\(typeList, ngElmts) listInsert lId ngs = mapM_ (uncurry (putListNgrams lId)) (toList ngs)
-> putListNgrams lId typeList ngElmts) (toList ngs)
------------------------------------------------------------------------ ------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -205,7 +207,7 @@ putListNgrams nodeId ngramsType nes = putListNgrams' nodeId ngramsType m ...@@ -205,7 +207,7 @@ putListNgrams nodeId ngramsType nes = putListNgrams' nodeId ngramsType m
a <- getNodeStory listId a <- getNodeStory listId
let a' = a & a_version +~ 1 let a' = a & a_version +~ 1
& a_history %~ (p :) & a_history %~ (p :)
& a_state . at ngramsType' .~ Just ns & ((a_state . at ngramsType') ?~ ns)
-- liftBase $ atomically $ do -- liftBase $ atomically $ do
-- r <- readTVar var -- r <- readTVar var
-- writeTVar var $ -- writeTVar var $
......
...@@ -12,7 +12,6 @@ Portability : POSIX ...@@ -12,7 +12,6 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-deprecations #-} {-# OPTIONS_GHC -fno-warn-deprecations #-}
{-# LANGUAGE Arrows #-} {-# LANGUAGE Arrows #-}
{-# LANGUAGE QuasiQuotes #-}
module Gargantext.Database.Action.Flow.Pairing module Gargantext.Database.Action.Flow.Pairing
( isPairedWith ( isPairedWith
...@@ -29,13 +28,13 @@ import Data.Text qualified as Text ...@@ -29,13 +28,13 @@ import Data.Text qualified as Text
import Gargantext.Core (toDBid) import Gargantext.Core (toDBid)
import Gargantext.Core.Ngrams.Tools (filterListWithRoot, getRepo, groupNodesByNgrams, mapTermListRoot) import Gargantext.Core.Ngrams.Tools (filterListWithRoot, getRepo, groupNodesByNgrams, mapTermListRoot)
import Gargantext.Core.Ngrams.Types (NgramsTerm(..)) import Gargantext.Core.Ngrams.Types (NgramsTerm(..))
import Gargantext.Core.NodeStory (HasNodeStory) import Gargantext.Core.NodeStory.Types ( HasNodeStory )
import Gargantext.Core.Text.Metrics.CharByChar (levenshtein) import Gargantext.Core.Text.Metrics.CharByChar (levenshtein)
import Gargantext.Core.Types (TableResult(..)) import Gargantext.Core.Types (TableResult(..))
import Gargantext.Core.Types.Main (ListType(..)) import Gargantext.Core.Types.Main (ListType(..))
import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOnlyUser) import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOnlyUser)
import Gargantext.Database.Admin.Config (userMaster) import Gargantext.Database.Admin.Config (userMaster)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataContact(..), cw_firstName, cw_lastName, hc_who) import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact(..), cw_firstName, cw_lastName, hc_who )
import Gargantext.Database.Admin.Types.Node (AnnuaireId, CorpusId, ListId, DocId, ContactId, Node, NodeId, NodeType(NodeList), contextId2NodeId, pgNodeId) import Gargantext.Database.Admin.Types.Node (AnnuaireId, CorpusId, ListId, DocId, ContactId, Node, NodeId, NodeType(NodeList), contextId2NodeId, pgNodeId)
import Gargantext.Database.Prelude (Cmd, DBCmd, runOpaQuery) import Gargantext.Database.Prelude (Cmd, DBCmd, runOpaQuery)
import Gargantext.Database.Query.Prelude (returnA, queryNodeNodeTable) import Gargantext.Database.Query.Prelude (returnA, queryNodeNodeTable)
...@@ -97,13 +96,11 @@ prepareInsert :: CorpusId -> AnnuaireId -> HashMap ContactId (Set DocId) ...@@ -97,13 +96,11 @@ prepareInsert :: CorpusId -> AnnuaireId -> HashMap ContactId (Set DocId)
-> [(CorpusId, AnnuaireId, DocId, ContactId)] -> [(CorpusId, AnnuaireId, DocId, ContactId)]
prepareInsert corpusId annuaireId mapContactDocs = prepareInsert corpusId annuaireId mapContactDocs =
map (\(contactId,docId) -> (corpusId, docId, annuaireId, contactId)) map (\(contactId,docId) -> (corpusId, docId, annuaireId, contactId))
$ List.concat $ concatMap (\(contactId, setDocIds)
$ map (\(contactId, setDocIds)
-> map (\setDocId -> map (\setDocId
-> (contactId, setDocId) -> (contactId, setDocId)
) $ Set.toList setDocIds ) $ Set.toList setDocIds
) ) (HM.toList mapContactDocs)
$ HM.toList mapContactDocs
------------------------------------------------------------------------ ------------------------------------------------------------------------
type ContactName = NgramsTerm type ContactName = NgramsTerm
...@@ -113,16 +110,14 @@ fusion :: HashMap ContactName (Set ContactId) ...@@ -113,16 +110,14 @@ fusion :: HashMap ContactName (Set ContactId)
-> HashMap DocAuthor (Set DocId) -> HashMap DocAuthor (Set DocId)
-> HashMap ContactId (Set DocId) -> HashMap ContactId (Set DocId)
fusion mc md = HM.fromListWith (<>) fusion mc md = HM.fromListWith (<>)
$ List.concat $ concatMap (\(docAuthor, docs)
$ map (\(docAuthor, docs) -> case getClosest Text.toLower docAuthor (HM.keys mc) of
-> case (getClosest Text.toLower docAuthor (HM.keys mc)) of
Nothing -> [] Nothing -> []
Just author -> case HM.lookup author mc of Just author -> case HM.lookup author mc of
Nothing -> [] Nothing -> []
Just contactIds -> map (\contactId -> (contactId, docs)) Just contactIds -> map (\contactId -> (contactId, docs))
$ Set.toList contactIds $ Set.toList contactIds
) ) (HM.toList md)
$ HM.toList md
getClosest :: (Text -> Text) -> NgramsTerm -> [NgramsTerm] -> Maybe NgramsTerm getClosest :: (Text -> Text) -> NgramsTerm -> [NgramsTerm] -> Maybe NgramsTerm
...@@ -147,7 +142,7 @@ getNgramsContactId aId = do ...@@ -147,7 +142,7 @@ getNgramsContactId aId = do
-- POC here, should be a probabilistic function (see the one used to find lang) -- POC here, should be a probabilistic function (see the one used to find lang)
toName :: Node HyperdataContact -> NgramsTerm toName :: Node HyperdataContact -> NgramsTerm
-- toName contact = NgramsTerm $ (Text.toTitle $ Text.take 1 firstName) <> ". " <> (Text.toTitle lastName) -- toName contact = NgramsTerm $ (Text.toTitle $ Text.take 1 firstName) <> ". " <> (Text.toTitle lastName)
toName contact = NgramsTerm $ (Text.toTitle firstName) <> " " <> (Text.toTitle lastName) toName contact = NgramsTerm $ Text.toTitle firstName <> " " <> Text.toTitle lastName
where where
firstName = fromMaybe "" $ contact^.(node_hyperdata . hc_who . _Just . cw_firstName) firstName = fromMaybe "" $ contact^.(node_hyperdata . hc_who . _Just . cw_firstName)
lastName = fromMaybe "" $ contact^.(node_hyperdata . hc_who . _Just . cw_lastName) lastName = fromMaybe "" $ contact^.(node_hyperdata . hc_who . _Just . cw_lastName)
......
...@@ -11,7 +11,6 @@ Portability : POSIX ...@@ -11,7 +11,6 @@ Portability : POSIX
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ConstrainedClassMethods #-} {-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
...@@ -24,16 +23,16 @@ import Data.Conduit.List qualified as CL ...@@ -24,16 +23,16 @@ import Data.Conduit.List qualified as CL
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
import Data.Swagger (ToSchema(..), genericDeclareNamedSchema) import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
import Gargantext.Core.Flow.Types (UniqId) import Gargantext.Core.Flow.Types (UniqId)
import Gargantext.Core.NodeStory (HasNodeStory) import Gargantext.Core.NodeStory.Types (HasNodeStory)
import Gargantext.Core.Text (HasText) import Gargantext.Core.Text (HasText)
import Gargantext.Core.Text.Corpus.API qualified as API import Gargantext.Core.Text.Corpus.Types qualified as API
import Gargantext.Core.Text.Terms (ExtractNgramsT) import Gargantext.Core.Text.Terms (ExtractNgramsT)
import Gargantext.Core.Types (HasValidationError, TermsCount) import Gargantext.Core.Types (HasValidationError, TermsCount)
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument) import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument )
import Gargantext.Database.Admin.Types.Node (NodeId) import Gargantext.Database.Admin.Types.Node (NodeId)
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 ( ToNode, UniqParameters, AddUniqId, InsertDb )
import Gargantext.Database.Query.Table.Node.Error (HasNodeError) import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Tree.Error (HasTreeError) import Gargantext.Database.Query.Tree.Error (HasTreeError)
import Gargantext.Database.Schema.Ngrams (NgramsType(..)) import Gargantext.Database.Schema.Ngrams (NgramsType(..))
......
...@@ -38,7 +38,7 @@ import Gargantext.Core (Lang, NLPServerConfig, toDBid) ...@@ -38,7 +38,7 @@ import Gargantext.Core (Lang, NLPServerConfig, toDBid)
import Gargantext.Core.Flow.Types (UniqId, uniqId) import Gargantext.Core.Flow.Types (UniqId, uniqId)
import Gargantext.Core.Ngrams.Types qualified as NT import Gargantext.Core.Ngrams.Types qualified as NT
import Gargantext.Core.NLP (HasNLPServer, nlpServerGet) import Gargantext.Core.NLP (HasNLPServer, nlpServerGet)
import Gargantext.Core.NodeStory (HasNodeStory) import Gargantext.Core.NodeStory.Types (HasNodeStory)
import Gargantext.Core.Text.List (buildNgramsLists) import Gargantext.Core.Text.List (buildNgramsLists)
import Gargantext.Core.Text.List.Group.WithStem (GroupParams(GroupWithPosTag)) import Gargantext.Core.Text.List.Group.WithStem (GroupParams(GroupWithPosTag))
import Gargantext.Core.Text.List.Social (FlowSocialListWith(..)) import Gargantext.Core.Text.List.Social (FlowSocialListWith(..))
...@@ -53,7 +53,7 @@ import Gargantext.Database.Action.Flow.Extract () -- ExtractNgramsT instances ...@@ -53,7 +53,7 @@ import Gargantext.Database.Action.Flow.Extract () -- ExtractNgramsT instances
import Gargantext.Database.Action.Flow.List (flowList_DbRepo, toNodeNgramsW') import Gargantext.Database.Action.Flow.List (flowList_DbRepo, toNodeNgramsW')
import Gargantext.Database.Action.Flow.Types (DocumentIdWithNgrams(..), FlowCorpus, FlowInsertDB) import Gargantext.Database.Action.Flow.Types (DocumentIdWithNgrams(..), FlowCorpus, FlowInsertDB)
import Gargantext.Database.Admin.Config (userMaster, corpusMasterName) import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument, hd_abstract, hd_title) import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument, hd_abstract, hd_title )
import Gargantext.Database.Admin.Types.Node (Context, ContextId, CorpusId, DocId, ListId, NodeId, NodeType(NodeGraph, NodeTexts), UserId, contextId2NodeId, nodeId2ContextId) import Gargantext.Database.Admin.Types.Node (Context, ContextId, CorpusId, DocId, ListId, NodeId, NodeType(NodeGraph, NodeTexts), UserId, contextId2NodeId, nodeId2ContextId)
import Gargantext.Database.Prelude (DBCmd, DbCmd') import Gargantext.Database.Prelude (DBCmd, DbCmd')
import Gargantext.Database.Query.Table.ContextNodeNgrams (ContextNodeNgramsPoly(ContextNodeNgrams), insertContextNodeNgrams) import Gargantext.Database.Query.Table.ContextNodeNgrams (ContextNodeNgramsPoly(ContextNodeNgrams), insertContextNodeNgrams)
...@@ -63,7 +63,7 @@ import Gargantext.Database.Query.Table.Node.Document.Add qualified as Doc (add) ...@@ -63,7 +63,7 @@ import Gargantext.Database.Query.Table.Node.Document.Add qualified as Doc (add)
import Gargantext.Database.Query.Table.Node.Document.Insert (ReturnId, addUniqId, insertDb, reId, reInserted, reUniqId, toNode) import Gargantext.Database.Query.Table.Node.Document.Insert (ReturnId, addUniqId, insertDb, reId, reInserted, reUniqId, toNode)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..)) import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Query.Table.NodeNgrams (getCgramsId, listInsertDb) import Gargantext.Database.Query.Table.NodeNgrams (getCgramsId, listInsertDb)
import Gargantext.Database.Query.Tree (HasTreeError) 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.Database.Schema.Context (context_hyperdata, context_id) import Gargantext.Database.Schema.Context (context_hyperdata, context_id)
import Gargantext.Database.Schema.ContextNodeNgrams2 (ContextNodeNgrams2Poly(ContextNodeNgrams2)) import Gargantext.Database.Schema.ContextNodeNgrams2 (ContextNodeNgrams2Poly(ContextNodeNgrams2))
...@@ -116,13 +116,13 @@ saveDocNgramsWith lId mapNgramsDocs' = do ...@@ -116,13 +116,13 @@ saveDocNgramsWith lId mapNgramsDocs' = do
-- new -- new
mapCgramsId <- listInsertDb lId toNodeNgramsW' mapCgramsId <- listInsertDb lId toNodeNgramsW'
$ map (first _ngramsTerms . second DM.keys) $ map (bimap _ngramsTerms DM.keys)
$ HashMap.toList mapNgramsDocs $ HashMap.toList mapNgramsDocs
--printDebug "saveDocNgramsWith" mapCgramsId --printDebug "saveDocNgramsWith" mapCgramsId
-- insertDocNgrams -- insertDocNgrams
let ngrams2insert = catMaybes [ ContextNodeNgrams2 <$> Just (nodeId2ContextId nId) let ngrams2insert = catMaybes [ ContextNodeNgrams2 <$> Just (nodeId2ContextId nId)
<*> (getCgramsId mapCgramsId ngrams_type (_ngramsTerms terms'')) <*> getCgramsId mapCgramsId ngrams_type (_ngramsTerms terms'')
<*> Just (fromIntegral w :: Double) <*> Just (fromIntegral w :: Double)
| (terms'', mapNgramsTypes) <- HashMap.toList mapNgramsDocs | (terms'', mapNgramsTypes) <- HashMap.toList mapNgramsDocs
, (ngrams_type, mapNodeIdWeight) <- DM.toList mapNgramsTypes , (ngrams_type, mapNodeIdWeight) <- DM.toList mapNgramsTypes
...@@ -152,9 +152,9 @@ docNgrams lang nt ts doc = ...@@ -152,9 +152,9 @@ docNgrams lang nt ts doc =
, doc ^. context_hyperdata . hd_abstract , doc ^. context_hyperdata . hd_abstract
] ]
) )
(List.cycle [DM.fromList $ [(nt, DM.singleton (doc ^. context_id) 1 )]]) (repeat (DM.fromList $ [(nt, DM.singleton (doc ^. context_id) 1 )]))
-- TODO Type NodeDocumentUnicised -- TODO Type NodeDocumentUnicised
insertDocs :: ( DbCmd' env err m insertDocs :: ( DbCmd' env err m
, FlowInsertDB a , FlowInsertDB a
...@@ -274,7 +274,7 @@ viewUniqId' d = maybe err (\h -> (h,d)) (d ^. uniqId) ...@@ -274,7 +274,7 @@ viewUniqId' d = maybe err (\h -> (h,d)) (d ^. uniqId)
mergeData :: Map Hash ReturnId mergeData :: Map Hash ReturnId
-> Map Hash a -> Map Hash a
-> [Indexed NodeId a] -> [Indexed NodeId a]
mergeData rs = catMaybes . map toDocumentWithId . DM.toList mergeData rs = mapMaybe toDocumentWithId . DM.toList
where where
toDocumentWithId (sha,hpd) = toDocumentWithId (sha,hpd) =
Indexed <$> fmap reId (DM.lookup sha rs) Indexed <$> fmap reId (DM.lookup sha rs)
...@@ -287,7 +287,7 @@ toInserted :: [ReturnId] ...@@ -287,7 +287,7 @@ toInserted :: [ReturnId]
-> Map Hash ReturnId -> Map Hash ReturnId
toInserted = toInserted =
DM.fromList . map (\r -> (reUniqId r, r) ) DM.fromList . map (\r -> (reUniqId r, r) )
. filter (\r -> reInserted r == True) . filter reInserted
...@@ -317,9 +317,9 @@ mapNodeIdNgrams = HashMap.unionsWith (DM.unionWith (DM.unionWith addTuples)) . f ...@@ -317,9 +317,9 @@ mapNodeIdNgrams = HashMap.unionsWith (DM.unionWith (DM.unionWith addTuples)) . f
-- document) is copied over to all its types. -- document) is copied over to all its types.
f :: DocumentIdWithNgrams a b f :: DocumentIdWithNgrams a b
-> HashMap.HashMap b (Map NgramsType (Map NodeId (Int, TermsCount))) -> HashMap.HashMap b (Map NgramsType (Map NodeId (Int, TermsCount)))
f d = fmap (\(ngramsTypeMap, cnt) -> fmap (\i -> DM.singleton nId (i, cnt)) ngramsTypeMap) $ documentNgrams d f d = (\(ngramsTypeMap, cnt) -> fmap (\i -> DM.singleton nId (i, cnt)) ngramsTypeMap) <$> documentNgrams d
where where
nId = (documentWithId d) ^. index nId = documentWithId d ^. index
......
...@@ -16,7 +16,7 @@ import Data.HashMap.Strict (HashMap) ...@@ -16,7 +16,7 @@ import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap import Data.HashMap.Strict qualified as HashMap
import Data.List qualified as List import Data.List qualified as List
import Gargantext.Core.Methods.Similarities (Similarity(..)) import Gargantext.Core.Methods.Similarities (Similarity(..))
import Gargantext.CoreAPI.Ngrams.Types (NgramsTerm(..)) import Gargantext.Core.Ngrams.Types (NgramsTerm(..))
import Gargantext.Core.Viz.Graph.Tools (doSimilarityMap) import Gargantext.Core.Viz.Graph.Tools (doSimilarityMap)
import Gargantext.Core.Viz.Graph.Tools.IGraph (spinglass) import Gargantext.Core.Viz.Graph.Tools.IGraph (spinglass)
import Gargantext.Core.Viz.Graph.Types import Gargantext.Core.Viz.Graph.Types
......
...@@ -10,6 +10,7 @@ import Data.Aeson ...@@ -10,6 +10,7 @@ import Data.Aeson
import Data.Either import Data.Either
import Gargantext.API.Errors import Gargantext.API.Errors
import Gargantext.API.Node.Corpus.New import Gargantext.API.Node.Corpus.New
import Gargantext.API.Node.Corpus.New.Types (WithQuery(..))
import Gargantext.API.Node.Corpus.Types import Gargantext.API.Node.Corpus.Types
import Gargantext.Core.Types.Phylo import Gargantext.Core.Types.Phylo
import Gargantext.Core.Viz.Phylo.API import Gargantext.Core.Viz.Phylo.API
......
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