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

[FIX] removing debug prints

parent 0312960a
...@@ -5,7 +5,7 @@ cabal-version: 1.12 ...@@ -5,7 +5,7 @@ cabal-version: 1.12
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
name: gargantext name: gargantext
version: 0.0.6.9.4.9 version: 0.0.6.9.4.9
synopsis: Search, map, share synopsis: Search, map, share
description: Please see README.md description: Please see README.md
category: Data category: Data
......
...@@ -283,7 +283,7 @@ forgotPasswordAsync' (ForgotPasswordAsyncParams { email }) logStatus = do ...@@ -283,7 +283,7 @@ forgotPasswordAsync' (ForgotPasswordAsyncParams { email }) logStatus = do
} }
logStatus jobLog logStatus jobLog
printDebug "[forgotPasswordAsync'] email" email -- printDebug "[forgotPasswordAsync'] email" email
_ <- forgotPasswordPost $ ForgotPasswordRequest { _fpReq_email = email } _ <- forgotPasswordPost $ ForgotPasswordRequest { _fpReq_email = email }
......
...@@ -41,15 +41,15 @@ resolveJobLogs JobLogArgs { job_log_id } = dbJobLogs job_log_id ...@@ -41,15 +41,15 @@ resolveJobLogs JobLogArgs { job_log_id } = dbJobLogs job_log_id
dbJobLogs dbJobLogs
:: (HasConnectionPool env, HasConfig env, HasJobEnv' env) :: (HasConnectionPool env, HasConfig env, HasJobEnv' env)
=> Int -> GqlM e env (Map Int JobLog) => Int -> GqlM e env (Map Int JobLog)
dbJobLogs job_log_id = do dbJobLogs _job_log_id = do
--getJobLogs job_log_id --getJobLogs job_log_id
lift $ do lift $ do
env <- ask env <- ask
--val <- liftBase $ readMVar $ env ^. job_env . jenv_jobs . env_state_mvar --val <- liftBase $ readMVar $ env ^. job_env . jenv_jobs . env_state_mvar
var <- liftIO $ readMVar (env ^. job_env . jenv_jobs . env_state_mvar) var <- liftIO $ readMVar (env ^. job_env . jenv_jobs . env_state_mvar)
let envItems = var ^. env_map let envItems = var ^. env_map
printDebug "[dbJobLogs] env ^. job_env ^. jenv_jobs" $ length $ IntMap.keys envItems -- printDebug "[dbJobLogs] env ^. job_env ^. jenv_jobs" $ length $ IntMap.keys envItems
printDebug "[dbJobLogs] job_log_id" job_log_id -- printDebug "[dbJobLogs] job_log_id" job_log_id
--pure $ IntMap.elems val --pure $ IntMap.elems val
liftIO $ do liftIO $ do
let jobsList = IntMap.toList $ IntMap.map (\e -> e ^. env_item . job_async) envItems let jobsList = IntMap.toList $ IntMap.map (\e -> e ^. env_item . job_async) envItems
......
...@@ -94,10 +94,10 @@ updateScatter :: FlowCmdM env err m => ...@@ -94,10 +94,10 @@ updateScatter :: FlowCmdM env err m =>
-> Maybe Limit -> Maybe Limit
-> m () -> m ()
updateScatter cId maybeListId tabType maybeLimit = do updateScatter cId maybeListId tabType maybeLimit = do
printDebug "[updateScatter] cId" cId -- printDebug "[updateScatter] cId" cId
printDebug "[updateScatter] maybeListId" maybeListId -- printDebug "[updateScatter] maybeListId" maybeListId
printDebug "[updateScatter] tabType" tabType -- printDebug "[updateScatter] tabType" tabType
printDebug "[updateScatter] maybeLimit" maybeLimit -- printDebug "[updateScatter] maybeLimit" maybeLimit
_ <- updateScatter' cId maybeListId tabType maybeLimit _ <- updateScatter' cId maybeListId tabType maybeLimit
pure () pure ()
......
...@@ -372,7 +372,7 @@ tableNgramsPull :: HasNodeStory env err m ...@@ -372,7 +372,7 @@ tableNgramsPull :: HasNodeStory env err m
-> Version -> Version
-> m (Versioned NgramsTablePatch) -> m (Versioned NgramsTablePatch)
tableNgramsPull listId ngramsType p_version = do tableNgramsPull listId ngramsType p_version = do
printDebug "[tableNgramsPull]" (listId, ngramsType) -- printDebug "[tableNgramsPull]" (listId, ngramsType)
var <- getNodeStoryVar [listId] var <- getNodeStoryVar [listId]
r <- liftBase $ readMVar var r <- liftBase $ readMVar var
...@@ -403,12 +403,12 @@ tableNgramsPut :: ( HasNodeStory env err m ...@@ -403,12 +403,12 @@ tableNgramsPut :: ( HasNodeStory env err m
-> m (Versioned NgramsTablePatch) -> m (Versioned NgramsTablePatch)
tableNgramsPut tabType listId (Versioned p_version p_table) tableNgramsPut tabType listId (Versioned p_version p_table)
| p_table == mempty = do | p_table == mempty = do
printDebug "[tableNgramsPut]" ("TableEmpty" :: Text) -- printDebug "[tableNgramsPut]" ("TableEmpty" :: Text)
let ngramsType = ngramsTypeFromTabType tabType let ngramsType = ngramsTypeFromTabType tabType
tableNgramsPull listId ngramsType p_version tableNgramsPull listId ngramsType p_version
| otherwise = do | otherwise = do
printDebug "[tableNgramsPut]" ("TableNonEmpty" :: Text) -- printDebug "[tableNgramsPut]" ("TableNonEmpty" :: Text)
let ngramsType = ngramsTypeFromTabType tabType let ngramsType = ngramsTypeFromTabType tabType
(p, p_validity) = PM.singleton ngramsType p_table (p, p_validity) = PM.singleton ngramsType p_table
...@@ -434,7 +434,7 @@ tableNgramsPostChartsAsync utn logStatus = do ...@@ -434,7 +434,7 @@ tableNgramsPostChartsAsync utn logStatus = do
let listId = utn ^. utn_list_id let listId = utn ^. utn_list_id
node <- getNode listId node <- getNode listId
let nId = node ^. node_id let _nId = node ^. node_id
_uId = node ^. node_user_id _uId = node ^. node_user_id
mCId = node ^. node_parent_id mCId = node ^. node_parent_id
...@@ -443,7 +443,7 @@ tableNgramsPostChartsAsync utn logStatus = do ...@@ -443,7 +443,7 @@ tableNgramsPostChartsAsync utn logStatus = do
case mCId of case mCId of
Nothing -> do Nothing -> do
printDebug "[tableNgramsPostChartsAsync] can't update charts, no parent, nId" nId -- printDebug "[tableNgramsPostChartsAsync] can't update charts, no parent, nId" nId
pure $ jobLogFail $ jobLogInit 1 pure $ jobLogFail $ jobLogInit 1
Just cId -> do Just cId -> do
case tabType of case tabType of
...@@ -499,7 +499,7 @@ tableNgramsPostChartsAsync utn logStatus = do ...@@ -499,7 +499,7 @@ tableNgramsPostChartsAsync utn logStatus = do
getRef getRef
_ -> do _ -> do
printDebug "[tableNgramsPostChartsAsync] no update for tabType = " tabType -- printDebug "[tableNgramsPostChartsAsync] no update for tabType = " tabType
pure $ jobLogFail $ jobLogInit 1 pure $ jobLogFail $ jobLogInit 1
{- {-
......
...@@ -135,7 +135,7 @@ setList :: FlowCmdM env err m ...@@ -135,7 +135,7 @@ setList :: FlowCmdM env err m
-> m Bool -> m Bool
setList l m = do setList l m = do
-- TODO check with Version for optim -- TODO check with Version for optim
printDebug "New list as file" l -- printDebug "New list as file" l
_ <- mapM (\(nt, Versioned _v ns) -> setListNgrams l nt ns) $ toList m _ <- mapM (\(nt, Versioned _v ns) -> setListNgrams l nt ns) $ toList m
-- TODO reindex -- TODO reindex
pure True pure True
...@@ -151,7 +151,7 @@ reIndexWith :: ( HasNodeStory env err m ...@@ -151,7 +151,7 @@ reIndexWith :: ( HasNodeStory env err m
-> Set ListType -> Set ListType
-> m () -> m ()
reIndexWith cId lId nt lts = do reIndexWith cId lId nt lts = do
printDebug "(cId,lId,nt,lts)" (cId, lId, nt, lts) -- printDebug "(cId,lId,nt,lts)" (cId, lId, nt, lts)
-- Getting [NgramsTerm] -- Getting [NgramsTerm]
ts <- List.concat ts <- List.concat
......
...@@ -235,9 +235,9 @@ migrateFromDirToDb = do ...@@ -235,9 +235,9 @@ migrateFromDirToDb = do
pool <- view connPool pool <- view connPool
withResource pool $ \c -> do withResource pool $ \c -> do
listIds <- liftBase $ getNodesIdWithType c NodeList listIds <- liftBase $ getNodesIdWithType c NodeList
printDebug "[migrateFromDirToDb] listIds" listIds -- printDebug "[migrateFromDirToDb] listIds" listIds
(NodeStory nls) <- NSF.getRepoReadConfig listIds (NodeStory nls) <- NSF.getRepoReadConfig listIds
printDebug "[migrateFromDirToDb] nls" nls -- printDebug "[migrateFromDirToDb] nls" nls
_ <- mapM (\(nId, a) -> do _ <- mapM (\(nId, a) -> do
n <- liftBase $ nodeExists c nId n <- liftBase $ nodeExists c nId
case n of case n of
......
...@@ -46,7 +46,7 @@ import Gargantext.Database.Action.Flow.Types (FlowCmdM) ...@@ -46,7 +46,7 @@ import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAnnuaire(..), HyperdataContact) import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAnnuaire(..), HyperdataContact)
import Gargantext.Database.Admin.Types.Hyperdata.Contact (hyperdataContact) import Gargantext.Database.Admin.Types.Hyperdata.Contact (hyperdataContact)
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Prelude (($), liftBase, (.), printDebug, pure) import Gargantext.Prelude (($), liftBase, (.), {-printDebug,-} pure)
import qualified Gargantext.Utils.Aeson as GUA import qualified Gargantext.Utils.Aeson as GUA
import Gargantext.Utils.Jobs (serveJobsAPI) import Gargantext.Utils.Jobs (serveJobsAPI)
...@@ -76,7 +76,7 @@ api_async u nId = ...@@ -76,7 +76,7 @@ api_async u nId =
serveJobsAPI AddContactJob $ \p log -> serveJobsAPI AddContactJob $ \p log ->
let let
log' x = do log' x = do
printDebug "addContact" x -- printDebug "addContact" x
liftBase $ log x liftBase $ log x
in addContact u nId p (liftBase . log') in addContact u nId p (liftBase . log')
......
...@@ -76,7 +76,7 @@ addToAnnuaireWithForm :: FlowCmdM env err m ...@@ -76,7 +76,7 @@ addToAnnuaireWithForm :: FlowCmdM env err m
-> m JobLog -> m JobLog
addToAnnuaireWithForm _cid (AnnuaireWithForm { _wf_filetype }) logStatus = do addToAnnuaireWithForm _cid (AnnuaireWithForm { _wf_filetype }) logStatus = do
printDebug "ft" _wf_filetype -- printDebug "ft" _wf_filetype
logStatus JobLog { _scst_succeeded = Just 1 logStatus JobLog { _scst_succeeded = Just 1
, _scst_failed = Just 0 , _scst_failed = Just 0
......
...@@ -198,13 +198,13 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q ...@@ -198,13 +198,13 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
, _scst_remaining = Just 3 , _scst_remaining = Just 3
, _scst_events = Just [] , _scst_events = Just []
} }
printDebug "[addToCorpusWithQuery] (cid, dbs)" (cid, dbs) -- printDebug "[addToCorpusWithQuery] (cid, dbs)" (cid, dbs)
printDebug "[addToCorpusWithQuery] datafield" datafield -- printDebug "[addToCorpusWithQuery] datafield" datafield
printDebug "[addToCorpusWithQuery] flowListWith" flw -- printDebug "[addToCorpusWithQuery] flowListWith" flw
case datafield of case datafield of
Just Web -> do Just Web -> do
printDebug "[addToCorpusWithQuery] processing web request" datafield -- printDebug "[addToCorpusWithQuery] processing web request" datafield
_ <- triggerSearxSearch user cid q l logStatus _ <- triggerSearxSearch user cid q l logStatus
...@@ -219,12 +219,12 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q ...@@ -219,12 +219,12 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
-- TODO if cid is folder -> create Corpus -- TODO if cid is folder -> create Corpus
-- if cid is corpus -> add to corpus -- if cid is corpus -> add to corpus
-- if cid is root -> create corpus in Private -- if cid is root -> create corpus in Private
printDebug "[G.A.N.C.New] getDataText with query" q -- printDebug "[G.A.N.C.New] getDataText with query" q
databaseOrigin <- database2origin dbs databaseOrigin <- database2origin dbs
eTxts <- mapM (\db -> getDataText db (Multi l) q maybeLimit) [databaseOrigin] eTxts <- mapM (\db -> getDataText db (Multi l) q maybeLimit) [databaseOrigin]
let lTxts = lefts eTxts let lTxts = lefts eTxts
printDebug "[G.A.N.C.New] lTxts" lTxts -- printDebug "[G.A.N.C.New] lTxts" lTxts
case lTxts of case lTxts of
[] -> do [] -> do
let txts = rights eTxts let txts = rights eTxts
...@@ -235,10 +235,10 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q ...@@ -235,10 +235,10 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
, _scst_events = Just [] , _scst_events = Just []
} }
cids <- mapM (\txt -> do _cids <- mapM (\txt -> do
flowDataText user txt (Multi l) cid (Just flw) logStatus) txts flowDataText user txt (Multi l) cid (Just flw) logStatus) txts
printDebug "corpus id" cids -- printDebug "corpus id" cids
printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text) -- printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text)
sendMail user sendMail user
-- TODO ... -- TODO ...
pure JobLog { _scst_succeeded = Just 3 pure JobLog { _scst_succeeded = Just 3
...@@ -248,7 +248,7 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q ...@@ -248,7 +248,7 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
} }
(err:_) -> do (err:_) -> do
printDebug "Error: " err -- printDebug "Error: " err
let jl = addEvent "ERROR" (T.pack $ show err) $ let jl = addEvent "ERROR" (T.pack $ show err) $
JobLog { _scst_succeeded = Just 2 JobLog { _scst_succeeded = Just 2
, _scst_failed = Just 1 , _scst_failed = Just 1
...@@ -275,9 +275,9 @@ addToCorpusWithForm :: (FlowCmdM env err m) ...@@ -275,9 +275,9 @@ addToCorpusWithForm :: (FlowCmdM env err m)
-> JobLog -> JobLog
-> m JobLog -> m JobLog
addToCorpusWithForm user cid (NewWithForm ft ff d l _n sel) logStatus jobLog = do addToCorpusWithForm user cid (NewWithForm ft ff d l _n sel) logStatus jobLog = do
printDebug "[addToCorpusWithForm] Parsing corpus: " cid -- printDebug "[addToCorpusWithForm] Parsing corpus: " cid
printDebug "[addToCorpusWithForm] fileType" ft -- printDebug "[addToCorpusWithForm] fileType" ft
printDebug "[addToCorpusWithForm] fileFormat" ff -- printDebug "[addToCorpusWithForm] fileFormat" ff
logStatus jobLog logStatus jobLog
limit' <- view $ hasConfig . gc_max_docs_parsers limit' <- view $ hasConfig . gc_max_docs_parsers
let limit = fromIntegral limit' :: Integer let limit = fromIntegral limit' :: Integer
...@@ -320,7 +320,7 @@ addToCorpusWithForm user cid (NewWithForm ft ff d l _n sel) logStatus jobLog = d ...@@ -320,7 +320,7 @@ addToCorpusWithForm user cid (NewWithForm ft ff d l _n sel) logStatus jobLog = d
--printDebug "Starting extraction : " cid --printDebug "Starting extraction : " cid
-- TODO granularity of the logStatus -- TODO granularity of the logStatus
printDebug "flowCorpus with (corpus_id, lang)" (cid, l) -- printDebug "flowCorpus with (corpus_id, lang)" (cid, l)
_cid' <- flowCorpus user _cid' <- flowCorpus user
(Right [cid]) (Right [cid])
...@@ -331,8 +331,8 @@ addToCorpusWithForm user cid (NewWithForm ft ff d l _n sel) logStatus jobLog = d ...@@ -331,8 +331,8 @@ addToCorpusWithForm user cid (NewWithForm ft ff d l _n sel) logStatus jobLog = d
--(map (map toHyperdataDocument) docs) --(map (map toHyperdataDocument) docs)
logStatus logStatus
printDebug "Extraction finished : " cid -- printDebug "Extraction finished : " cid
printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text) -- printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text)
-- TODO uncomment this -- TODO uncomment this
--sendMail user --sendMail user
......
...@@ -70,23 +70,24 @@ postUpload :: NodeId ...@@ -70,23 +70,24 @@ postUpload :: NodeId
-> Cmd err [Hash] -> Cmd err [Hash]
postUpload _ Nothing _ _ = panic "fileType is a required parameter" postUpload _ Nothing _ _ = panic "fileType is a required parameter"
postUpload _ _ Nothing _ = panic "fileFormat is a required parameter" postUpload _ _ Nothing _ = panic "fileFormat is a required parameter"
postUpload _ (Just fileType) (Just fileFormat) multipartData = do postUpload _ (Just _fileType) (Just _fileFormat) multipartData = do
printDebug "File Type: " fileType -- printDebug "File Type: " fileType
printDebug "File format: " fileFormat -- printDebug "File format: " fileFormat
is <- liftBase $ do is <- liftBase $ do
printDebug "Inputs:" () -- printDebug "Inputs:" ()
forM (inputs multipartData) $ \input -> do forM (inputs multipartData) $ \input -> do
printDebug "iName " (iName input) -- printDebug "iName " (iName input)
printDebug "iValue " (iValue input) -- printDebug "iValue " (iValue input)
pure $ iName input pure $ iName input
{-
_ <- forM (files multipartData) $ \file -> do _ <- forM (files multipartData) $ \file -> do
let content = fdPayload file -- let content = fdPayload file
printDebug "XXX " (fdFileName file) -- printDebug "XXX " (fdFileName file)
printDebug "YYY " content -- printDebug "YYY " content
--pure $ cs content pure () -- $ cs content
-- is <- inputs multipartData -- is <- inputs multipartData
-}
pure $ map hash is pure $ map hash is
------------------------------------------------------------------- -------------------------------------------------------------------
...@@ -120,16 +120,18 @@ insertSearxResponse :: (MonadBase IO m, FlowCmdM env err m) ...@@ -120,16 +120,18 @@ insertSearxResponse :: (MonadBase IO m, FlowCmdM env err m)
-> m () -> m ()
insertSearxResponse _ _ _ _ (Left _) = pure () insertSearxResponse _ _ _ _ (Left _) = pure ()
insertSearxResponse user cId listId l (Right (SearxResponse { _srs_results })) = do insertSearxResponse user cId listId l (Right (SearxResponse { _srs_results })) = do
-- docs :: [Either Text HyperdataDocument]
let docs = hyperdataDocumentFromSearxResult l <$> _srs_results let docs = hyperdataDocumentFromSearxResult l <$> _srs_results
--printDebug "[triggerSearxSearch] docs" docs --printDebug "[triggerSearxSearch] docs" docs
-- docs :: [Either Text HyperdataDocument]
let docs' = catMaybes $ rightToMaybe <$> docs let docs' = catMaybes $ rightToMaybe <$> docs
{-
Prelude.mapM_ (\(HyperdataDocument { _hd_title, _hd_publication_year, _hd_publication_date }) -> do Prelude.mapM_ (\(HyperdataDocument { _hd_title, _hd_publication_year, _hd_publication_date }) -> do
printDebug "[triggerSearxSearch] doc time" $ printDebug "[triggerSearxSearch] doc time" $
"[title] " <> (show _hd_title) <> "[title] " <> (show _hd_title) <>
" :: [publication_year] " <> (show _hd_publication_year) <> " :: [publication_year] " <> (show _hd_publication_year) <>
" :: [publication_date] " <> (show _hd_publication_date) " :: [publication_date] " <> (show _hd_publication_date)
) docs' ) docs'
-}
--_ <- flowDataText user (DataNew [docs']) (Multi l) cId Nothing logStatus --_ <- flowDataText user (DataNew [docs']) (Multi l) cId Nothing logStatus
let mCorpus = Nothing :: Maybe HyperdataCorpus let mCorpus = Nothing :: Maybe HyperdataCorpus
ids <- insertMasterDocs mCorpus (Multi l) docs' ids <- insertMasterDocs mCorpus (Multi l) docs'
...@@ -162,13 +164,13 @@ triggerSearxSearch user cId q l logStatus = do ...@@ -162,13 +164,13 @@ triggerSearxSearch user cId q l logStatus = do
} }
logStatus jobLog logStatus jobLog
printDebug "[triggerSearxSearch] cId" cId -- printDebug "[triggerSearxSearch] cId" cId
printDebug "[triggerSearxSearch] q" q -- printDebug "[triggerSearxSearch] q" q
printDebug "[triggerSearxSearch] l" l -- printDebug "[triggerSearxSearch] l" l
cfg <- view hasConfig cfg <- view hasConfig
uId <- getUserId user uId <- getUserId user
let surl = _gc_frame_searx_url cfg let surl = _gc_frame_searx_url cfg
printDebug "[triggerSearxSearch] surl" surl -- printDebug "[triggerSearxSearch] surl" surl
mListId <- defaultListMaybe cId mListId <- defaultListMaybe cId
listId <- case mListId of listId <- case mListId of
Nothing -> do Nothing -> do
...@@ -176,7 +178,7 @@ triggerSearxSearch user cId q l logStatus = do ...@@ -176,7 +178,7 @@ triggerSearxSearch user cId q l logStatus = do
pure listId pure listId
Just listId -> pure listId Just listId -> pure listId
printDebug "[triggerSearxSearch] listId" listId -- printDebug "[triggerSearxSearch] listId" listId
manager <- liftBase $ newManager tlsManagerSettings manager <- liftBase $ newManager tlsManagerSettings
_ <- mapM (\page -> do _ <- mapM (\page -> do
......
...@@ -84,8 +84,8 @@ documentUploadAsync _uId nId doc logStatus = do ...@@ -84,8 +84,8 @@ documentUploadAsync _uId nId doc logStatus = do
, _scst_remaining = Just 1 , _scst_remaining = Just 1
, _scst_events = Just [] } , _scst_events = Just [] }
logStatus jl logStatus jl
docIds <- documentUpload nId doc _docIds <- documentUpload nId doc
printDebug "documentUploadAsync" docIds -- printDebug "documentUploadAsync" docIds
pure $ jobLogSuccess jl pure $ jobLogSuccess jl
......
...@@ -21,7 +21,9 @@ import Conduit ...@@ -21,7 +21,9 @@ import Conduit
import Control.Lens ((^.)) import Control.Lens ((^.))
import Data.Aeson import Data.Aeson
import Data.Either (Either(..), rights) import Data.Either (Either(..), rights)
import Data.Maybe (fromMaybe)
import Data.Swagger import Data.Swagger
import Data.Text (Text)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.API.Admin.EnvTypes (Env, GargJob(..)) import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs) import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
...@@ -44,6 +46,7 @@ import Gargantext.Prelude ...@@ -44,6 +46,7 @@ import Gargantext.Prelude
import Gargantext.Utils.Jobs (serveJobsAPI) import Gargantext.Utils.Jobs (serveJobsAPI)
import Gargantext.Core.Text.Corpus.Parsers.Date (split') import Gargantext.Core.Text.Corpus.Parsers.Date (split')
import Servant import Servant
import Text.Read (readMaybe)
import qualified Data.List as List import qualified Data.List as List
import qualified Data.Text as T import qualified Data.Text as T
-- import qualified Gargantext.Defaults as Defaults -- import qualified Gargantext.Defaults as Defaults
...@@ -54,7 +57,7 @@ type API = Summary " Documents from Write nodes." ...@@ -54,7 +57,7 @@ type API = Summary " Documents from Write nodes."
------------------------------------------------------------------------ ------------------------------------------------------------------------
data Params = Params data Params = Params
{ id :: Int { id :: Int
, paragraphs :: Int , paragraphs :: Text
, lang :: Lang , lang :: Lang
, selection :: FlowSocialListWith , selection :: FlowSocialListWith
} }
...@@ -106,10 +109,11 @@ documentsFromWriteNodes uId nId Params { selection, lang, paragraphs } logStatus ...@@ -106,10 +109,11 @@ documentsFromWriteNodes uId nId Params { selection, lang, paragraphs } logStatus
pure (node, contents) pure (node, contents)
) frameWrites ) frameWrites
let paragraphs' = fromMaybe (7 :: Int) $ (readMaybe $ T.unpack paragraphs)
let parsedE = (\(node, contents) let parsedE = (\(node, contents)
-> hyperdataDocumentFromFrameWrite lang paragraphs (node, contents)) <$> frameWritesWithContents -> hyperdataDocumentFromFrameWrite lang paragraphs' (node, contents)) <$> frameWritesWithContents
let parsed = List.concat $ rights parsedE let parsed = List.concat $ rights parsedE
printDebug "DocumentsFromWriteNodes: uId" uId -- printDebug "DocumentsFromWriteNodes: uId" uId
_ <- flowDataText (RootId (NodeId uId)) _ <- flowDataText (RootId (NodeId uId))
(DataNew (Just $ fromIntegral $ length parsed, yieldMany parsed)) (DataNew (Just $ fromIntegral $ length parsed, yieldMany parsed))
(Multi lang) (Multi lang)
......
...@@ -70,8 +70,8 @@ fileDownload :: (HasSettings env, FlowCmdM env err m) ...@@ -70,8 +70,8 @@ fileDownload :: (HasSettings env, FlowCmdM env err m)
-> NodeId -> NodeId
-> m (Headers '[Servant.Header "Content-Type" Text] BSResponse) -> m (Headers '[Servant.Header "Content-Type" Text] BSResponse)
fileDownload uId nId = do fileDownload uId nId = do
printDebug "[fileDownload] uId" uId -- printDebug "[fileDownload] uId" uId
printDebug "[fileDownload] nId" nId -- printDebug "[fileDownload] nId" nId
node <- getNodeWith nId (Proxy :: Proxy HyperdataFile) node <- getNodeWith nId (Proxy :: Proxy HyperdataFile)
let (HyperdataFile { _hff_name = name' let (HyperdataFile { _hff_name = name'
...@@ -105,7 +105,7 @@ fileAsyncApi uId nId = ...@@ -105,7 +105,7 @@ fileAsyncApi uId nId =
serveJobsAPI AddFileJob $ \i l -> serveJobsAPI AddFileJob $ \i l ->
let let
log' x = do log' x = do
printDebug "addWithFile" x -- printDebug "addWithFile" x
liftBase $ l x liftBase $ l x
in addWithFile uId nId i log' in addWithFile uId nId i log'
...@@ -118,7 +118,7 @@ addWithFile :: (HasSettings env, FlowCmdM env err m) ...@@ -118,7 +118,7 @@ addWithFile :: (HasSettings env, FlowCmdM env err m)
-> m JobLog -> m JobLog
addWithFile uId nId nwf@(NewWithFile _d _l fName) logStatus = do addWithFile uId nId nwf@(NewWithFile _d _l fName) logStatus = do
printDebug "[addWithFile] Uploading file: " nId -- printDebug "[addWithFile] Uploading file: " nId
logStatus JobLog { _scst_succeeded = Just 0 logStatus JobLog { _scst_succeeded = Just 0
, _scst_failed = Just 0 , _scst_failed = Just 0
, _scst_remaining = Just 1 , _scst_remaining = Just 1
...@@ -126,7 +126,7 @@ addWithFile uId nId nwf@(NewWithFile _d _l fName) logStatus = do ...@@ -126,7 +126,7 @@ addWithFile uId nId nwf@(NewWithFile _d _l fName) logStatus = do
} }
fPath <- GargDB.writeFile nwf fPath <- GargDB.writeFile nwf
printDebug "[addWithFile] File saved as: " fPath -- printDebug "[addWithFile] File saved as: " fPath
nIds <- mkNodeWithParent NodeFile (Just nId) uId fName nIds <- mkNodeWithParent NodeFile (Just nId) uId fName
...@@ -137,10 +137,11 @@ addWithFile uId nId nwf@(NewWithFile _d _l fName) logStatus = do ...@@ -137,10 +137,11 @@ addWithFile uId nId nwf@(NewWithFile _d _l fName) logStatus = do
_ <- updateHyperdata nId' $ hl { _hff_name = fName _ <- updateHyperdata nId' $ hl { _hff_name = fName
, _hff_path = pack fPath } , _hff_path = pack fPath }
printDebug "[addWithFile] Created node with id: " nId' -- printDebug "[addWithFile] Created node with id: " nId'
pure ()
_ -> pure () _ -> pure ()
printDebug "[addWithFile] File upload finished: " nId -- printDebug "[addWithFile] File upload finished: " nId
pure $ JobLog { _scst_succeeded = Just 1 pure $ JobLog { _scst_succeeded = Just 1
, _scst_failed = Just 0 , _scst_failed = Just 0
, _scst_remaining = Just 0 , _scst_remaining = Just 0
......
...@@ -89,7 +89,7 @@ postNodeAsync :: FlowCmdM env err m ...@@ -89,7 +89,7 @@ postNodeAsync :: FlowCmdM env err m
-> m JobLog -> m JobLog
postNodeAsync uId nId (PostNode nodeName tn) logStatus = do postNodeAsync uId nId (PostNode nodeName tn) logStatus = do
printDebug "postNodeAsync" nId -- printDebug "postNodeAsync" nId
logStatus JobLog { _scst_succeeded = Just 1 logStatus JobLog { _scst_succeeded = Just 1
, _scst_failed = Just 0 , _scst_failed = Just 0
, _scst_remaining = Just 2 , _scst_remaining = Just 2
......
...@@ -69,13 +69,13 @@ api userInviting nId (ShareTeamParams user') = do ...@@ -69,13 +69,13 @@ api userInviting nId (ShareTeamParams user') = do
isRegistered <- getUserId' (UserName u) isRegistered <- getUserId' (UserName u)
case isRegistered of case isRegistered of
Just _ -> do Just _ -> do
printDebug "[G.A.N.Share.api]" ("Team shared with " <> u) -- printDebug "[G.A.N.Share.api]" ("Team shared with " <> u)
pure u pure u
Nothing -> do Nothing -> do
username' <- getUsername userInviting username' <- getUsername userInviting
_ <- case List.elem username' arbitraryUsername of _ <- case List.elem username' arbitraryUsername of
True -> do True -> do
printDebug "[G.A.N.Share.api]" ("Demo users are not allowed to invite" :: Text) -- printDebug "[G.A.N.Share.api]" ("Demo users are not allowed to invite" :: Text)
pure () pure ()
False -> do False -> do
-- TODO better analysis of the composition of what is shared -- TODO better analysis of the composition of what is shared
...@@ -86,10 +86,10 @@ api userInviting nId (ShareTeamParams user') = do ...@@ -86,10 +86,10 @@ api userInviting nId (ShareTeamParams user') = do
] ]
_ <- case List.null children of _ <- case List.null children of
True -> do True -> do
printDebug "[G.A.N.Share.api]" ("Invitation is enabled if you share a corpus at least" :: Text) -- printDebug "[G.A.N.Share.api]" ("Invitation is enabled if you share a corpus at least" :: Text)
pure 0 pure 0
False -> do False -> do
printDebug "[G.A.N.Share.api]" ("Your invitation is sent to: " <> user'') -- printDebug "[G.A.N.Share.api]" ("Your invitation is sent to: " <> user'')
newUsers [user''] newUsers [user'']
pure () pure ()
pure u pure u
......
...@@ -43,7 +43,7 @@ import Gargantext.Database.Query.Table.Node (defaultList, getNode) ...@@ -43,7 +43,7 @@ import Gargantext.Database.Query.Table.Node (defaultList, getNode)
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata) import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Schema.Ngrams (NgramsType(NgramsTerms)) import Gargantext.Database.Schema.Ngrams (NgramsType(NgramsTerms))
import Gargantext.Database.Schema.Node (node_parent_id) import Gargantext.Database.Schema.Node (node_parent_id)
import Gargantext.Prelude (Bool(..), Ord, Eq, (<$>), ($), liftBase, (.), printDebug, pure, show, cs, (<>), panic, (<*>)) import Gargantext.Prelude (Bool(..), Ord, Eq, (<$>), ($), liftBase, (.), {-printDebug,-} pure, show, cs, (<>), panic, (<*>))
import Gargantext.Utils.Jobs (serveJobsAPI) import Gargantext.Utils.Jobs (serveJobsAPI)
import Prelude (Enum, Bounded, minBound, maxBound) import Prelude (Enum, Bounded, minBound, maxBound)
import Servant import Servant
...@@ -97,7 +97,7 @@ api uId nId = ...@@ -97,7 +97,7 @@ api uId nId =
serveJobsAPI UpdateNodeJob $ \p log'' -> serveJobsAPI UpdateNodeJob $ \p log'' ->
let let
log' x = do log' x = do
printDebug "updateNode" x -- printDebug "updateNode" x
liftBase $ log'' x liftBase $ log'' x
in updateNode uId nId p (liftBase . log') in updateNode uId nId p (liftBase . log')
......
...@@ -164,5 +164,5 @@ simuTask logStatus cur total = do ...@@ -164,5 +164,5 @@ simuTask logStatus cur total = do
, _scst_remaining = (-) <$> Just total <*> Just cur , _scst_remaining = (-) <$> Just total <*> Just cur
, _scst_events = Just [] , _scst_events = Just []
} }
printDebug "status" status -- printDebug "status" status
logStatus status logStatus status
...@@ -304,7 +304,7 @@ addCorpusWithFile user cid = ...@@ -304,7 +304,7 @@ addCorpusWithFile user cid =
serveJobsAPI AddCorpusFileJob $ \i log' -> serveJobsAPI AddCorpusFileJob $ \i log' ->
let let
log'' x = do log'' x = do
printDebug "[addToCorpusWithFile]" x -- printDebug "[addToCorpusWithFile]" x
liftBase $ log' x liftBase $ log' x
in New.addToCorpusWithFile user cid i log'' in New.addToCorpusWithFile user cid i log''
......
...@@ -53,7 +53,7 @@ api nId (SearchQuery q SearchDoc) o l order = ...@@ -53,7 +53,7 @@ api nId (SearchQuery q SearchDoc) o l order =
<$> searchInCorpus nId False q o l order <$> searchInCorpus nId False q o l order
-- <$> searchInCorpus nId False (concat q) o l order -- <$> searchInCorpus nId False (concat q) o l order
api nId (SearchQuery q SearchContact) o l order = do api nId (SearchQuery q SearchContact) o l order = do
printDebug "isPairedWith" nId -- printDebug "isPairedWith" nId
aIds <- isPairedWith nId NodeAnnuaire aIds <- isPairedWith nId NodeAnnuaire
-- TODO if paired with several corpus -- TODO if paired with several corpus
case head aIds of case head aIds of
......
...@@ -110,8 +110,8 @@ getTableApi :: NodeId ...@@ -110,8 +110,8 @@ getTableApi :: NodeId
-> Maybe Text -> Maybe Text
-> Cmd err (HashedResponse FacetTableResult) -> Cmd err (HashedResponse FacetTableResult)
getTableApi cId tabType _mListId mLimit mOffset mOrderBy mQuery mYear = do getTableApi cId tabType _mListId mLimit mOffset mOrderBy mQuery mYear = do
printDebug "[getTableApi] mQuery" mQuery -- printDebug "[getTableApi] mQuery" mQuery
printDebug "[getTableApi] mYear" mYear -- printDebug "[getTableApi] mYear" mYear
t <- getTable cId tabType mOffset mLimit mOrderBy mQuery mYear t <- getTable cId tabType mOffset mLimit mOrderBy mQuery mYear
pure $ constructHashedResponse t pure $ constructHashedResponse t
......
...@@ -534,11 +534,11 @@ updateNodeStory c nodeId@(NodeId _nId) currentArchive newArchive = do ...@@ -534,11 +534,11 @@ updateNodeStory c nodeId@(NodeId _nId) currentArchive newArchive = do
let currentSet = archiveStateSet currentList let currentSet = archiveStateSet currentList
let newSet = archiveStateSet newList let newSet = archiveStateSet newList
printDebug "[updateNodeStory] new - current = " $ Set.difference newSet currentSet -- printDebug "[updateNodeStory] new - current = " $ Set.difference newSet currentSet
let inserts = archiveStateListFilterFromSet (Set.difference newSet currentSet) newList let inserts = archiveStateListFilterFromSet (Set.difference newSet currentSet) newList
-- printDebug "[updateNodeStory] inserts" inserts -- printDebug "[updateNodeStory] inserts" inserts
printDebug "[updateNodeStory] current - new" $ Set.difference currentSet newSet -- printDebug "[updateNodeStory] current - new" $ Set.difference currentSet newSet
let deletes = archiveStateListFilterFromSet (Set.difference currentSet newSet) currentList let deletes = archiveStateListFilterFromSet (Set.difference currentSet newSet) currentList
-- printDebug "[updateNodeStory] deletes" deletes -- printDebug "[updateNodeStory] deletes" deletes
...@@ -547,7 +547,7 @@ updateNodeStory c nodeId@(NodeId _nId) currentArchive newArchive = do ...@@ -547,7 +547,7 @@ updateNodeStory c nodeId@(NodeId _nId) currentArchive newArchive = do
let commonNewList = archiveStateListFilterFromSet commonSet newList let commonNewList = archiveStateListFilterFromSet commonSet newList
let commonCurrentList = archiveStateListFilterFromSet commonSet currentList let commonCurrentList = archiveStateListFilterFromSet commonSet currentList
let updates = Set.toList $ Set.difference (Set.fromList commonNewList) (Set.fromList commonCurrentList) let updates = Set.toList $ Set.difference (Set.fromList commonNewList) (Set.fromList commonCurrentList)
printDebug "[updateNodeStory] updates" $ Text.unlines $ (Text.pack . show) <$> updates -- printDebug "[updateNodeStory] updates" $ Text.unlines $ (Text.pack . show) <$> updates
-- 2. Perform inserts/deletes/updates -- 2. Perform inserts/deletes/updates
--printDebug "[updateNodeStory] applying insert" () --printDebug "[updateNodeStory] applying insert" ()
...@@ -580,9 +580,9 @@ updateNodeStory c nodeId@(NodeId _nId) currentArchive newArchive = do ...@@ -580,9 +580,9 @@ updateNodeStory c nodeId@(NodeId _nId) currentArchive newArchive = do
upsertNodeStories :: PGS.Connection -> NodeId -> ArchiveList -> IO () upsertNodeStories :: PGS.Connection -> NodeId -> ArchiveList -> IO ()
upsertNodeStories c nodeId@(NodeId nId) newArchive = do upsertNodeStories c nodeId@(NodeId nId) newArchive = do
printDebug "[upsertNodeStories] START nId" nId -- printDebug "[upsertNodeStories] START nId" nId
PGS.withTransaction c $ do PGS.withTransaction c $ do
printDebug "[upsertNodeStories] locking nId" nId -- printDebug "[upsertNodeStories] locking nId" nId
runPGSAdvisoryXactLock c nId runPGSAdvisoryXactLock c nId
(NodeStory m) <- getNodeStory c nodeId (NodeStory m) <- getNodeStory c nodeId
...@@ -597,7 +597,7 @@ upsertNodeStories c nodeId@(NodeId nId) newArchive = do ...@@ -597,7 +597,7 @@ upsertNodeStories c nodeId@(NodeId nId) newArchive = do
-- 3. Now we need to set versions of all node state to be the same -- 3. Now we need to set versions of all node state to be the same
fixNodeStoryVersion c nodeId newArchive fixNodeStoryVersion c nodeId newArchive
printDebug "[upsertNodeStories] STOP nId" nId -- printDebug "[upsertNodeStories] STOP nId" nId
fixNodeStoryVersion :: PGS.Connection -> NodeId -> ArchiveList -> IO () fixNodeStoryVersion :: PGS.Connection -> NodeId -> ArchiveList -> IO ()
fixNodeStoryVersion c nodeId newArchive = do fixNodeStoryVersion c nodeId newArchive = do
...@@ -738,9 +738,9 @@ fixNodeStoryVersions = do ...@@ -738,9 +738,9 @@ fixNodeStoryVersions = do
pool <- view connPool pool <- view connPool
_ <- withResource pool $ \c -> liftBase $ PGS.withTransaction c $ do _ <- withResource pool $ \c -> liftBase $ PGS.withTransaction c $ do
nIds <- runPGSQuery c [sql| SELECT id FROM nodes WHERE ? |] (PGS.Only True) :: IO [PGS.Only Int64] nIds <- runPGSQuery c [sql| SELECT id FROM nodes WHERE ? |] (PGS.Only True) :: IO [PGS.Only Int64]
printDebug "[fixNodeStoryVersions] nIds" nIds -- printDebug "[fixNodeStoryVersions] nIds" nIds
mapM_ (\(PGS.Only nId) -> do mapM_ (\(PGS.Only nId) -> do
printDebug "[fixNodeStoryVersions] nId" nId -- printDebug "[fixNodeStoryVersions] nId" nId
updateVer c TableNgrams.Authors nId updateVer c TableNgrams.Authors nId
updateVer c TableNgrams.Institutes nId updateVer c TableNgrams.Institutes nId
......
...@@ -58,7 +58,7 @@ get la query' maxResults = do ...@@ -58,7 +58,7 @@ get la query' maxResults = do
-- in that case we suppose user is knowing what s.he is doing -- in that case we suppose user is knowing what s.he is doing
eDocs <- ISTEX.getMetadataWith query (fromIntegral <$> maxResults) eDocs <- ISTEX.getMetadataWith query (fromIntegral <$> maxResults)
printDebug "[Istex.get] will print length" (0 :: Int) -- printDebug "[Istex.get] will print length" (0 :: Int)
case eDocs of case eDocs of
Left _ -> pure () Left _ -> pure ()
Right (ISTEX.Documents { _documents_hits }) -> printDebug "[Istex.get] length docs" $ length _documents_hits Right (ISTEX.Documents { _documents_hits }) -> printDebug "[Istex.get] length docs" $ length _documents_hits
......
...@@ -188,7 +188,7 @@ toDoc ff d = do ...@@ -188,7 +188,7 @@ toDoc ff d = do
let lang = EN -- maybe EN identity (join $ detectLangDefault <$> (fmap (DT.take 50) abstract)) let lang = EN -- maybe EN identity (join $ detectLangDefault <$> (fmap (DT.take 50) abstract))
let dateToParse = DT.replace " " "" <$> lookup "PY" d -- <> Just " " <> lookup "publication_date" d let dateToParse = DT.replace " " "" <$> lookup "PY" d -- <> Just " " <> lookup "publication_date" d
printDebug "[G.C.T.C.Parsers] dateToParse" dateToParse -- printDebug "[G.C.T.C.Parsers] dateToParse" dateToParse
(utcTime, (pub_year, pub_month, pub_day)) <- Date.dateSplit lang dateToParse (utcTime, (pub_year, pub_month, pub_day)) <- Date.dateSplit lang dateToParse
let hd = HyperdataDocument { _hd_bdd = Just $ DT.pack $ show ff let hd = HyperdataDocument { _hd_bdd = Just $ DT.pack $ show ff
...@@ -210,7 +210,7 @@ toDoc ff d = do ...@@ -210,7 +210,7 @@ toDoc ff d = do
, _hd_publication_minute = Nothing , _hd_publication_minute = Nothing
, _hd_publication_second = Nothing , _hd_publication_second = Nothing
, _hd_language_iso2 = Just $ (DT.pack . show) lang } , _hd_language_iso2 = Just $ (DT.pack . show) lang }
printDebug "[G.C.T.C.Parsers] HyperdataDocument" hd -- printDebug "[G.C.T.C.Parsers] HyperdataDocument" hd
pure hd pure hd
enrichWith :: FileType enrichWith :: FileType
......
...@@ -146,9 +146,9 @@ parseRawSafe lang text = do ...@@ -146,9 +146,9 @@ parseRawSafe lang text = do
let triedParseRaw = parseRaw lang text let triedParseRaw = parseRaw lang text
dateStr' <- case triedParseRaw of dateStr' <- case triedParseRaw of
--Left (CE.SomeException err) -> do --Left (CE.SomeException err) -> do
Left err -> do Left _err -> do
envLang <- getEnv "LANG" _envLang <- getEnv "LANG"
printDebug "[G.C.T.C.P.Date] Exception: " (err, envLang, lang, text) -- printDebug "[G.C.T.C.P.Date] Exception: " (err, envLang, lang, text)
pure $ DucklingFailure text pure $ DucklingFailure text
Right res -> pure $ DucklingSuccess res Right res -> pure $ DucklingSuccess res
pure dateStr' pure dateStr'
......
...@@ -23,7 +23,7 @@ import Data.Map.Strict (Map) ...@@ -23,7 +23,7 @@ import Data.Map.Strict (Map)
import Data.Monoid (mempty) import Data.Monoid (mempty)
import Data.Ord (Down(..)) import Data.Ord (Down(..))
import Data.Set (Set) import Data.Set (Set)
import Data.Text (Text) -- import Data.Text (Text)
import Data.Tuple.Extra (both) import Data.Tuple.Extra (both)
import Gargantext.API.Ngrams.Types (NgramsElement, NgramsTerm(..)) import Gargantext.API.Ngrams.Types (NgramsElement, NgramsTerm(..))
import Gargantext.Core.NodeStory import Gargantext.Core.NodeStory
...@@ -163,12 +163,12 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi ...@@ -163,12 +163,12 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi
-- Filter 0 With Double -- Filter 0 With Double
-- Computing global speGen score -- Computing global speGen score
printDebug "[buildNgramsTermsList: Sample List] / start" nt -- printDebug "[buildNgramsTermsList: Sample List] / start" nt
!(allTerms :: HashMap NgramsTerm Double) <- getTficf_withSample uCid mCid nt !(allTerms :: HashMap NgramsTerm Double) <- getTficf_withSample uCid mCid nt
printDebug "[buildNgramsTermsList: Sample List / end]" (nt, HashMap.size allTerms) -- printDebug "[buildNgramsTermsList: Sample List / end]" (nt, HashMap.size allTerms)
printDebug "[buildNgramsTermsList: Flow Social List / start]" nt -- printDebug "[buildNgramsTermsList: Flow Social List / start]" nt
-- PrivateFirst for first developments since Public NodeMode is not implemented yet -- PrivateFirst for first developments since Public NodeMode is not implemented yet
!(socialLists :: FlowCont NgramsTerm FlowListScores) !(socialLists :: FlowCont NgramsTerm FlowListScores)
...@@ -177,18 +177,18 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi ...@@ -177,18 +177,18 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi
$ List.zip (HashMap.keys allTerms) $ List.zip (HashMap.keys allTerms)
(List.cycle [mempty]) (List.cycle [mempty])
) )
printDebug "[buildNgramsTermsList: Flow Social List / end]" nt -- printDebug "[buildNgramsTermsList: Flow Social List / end]" nt
let !ngramsKeys = HashSet.fromList let !ngramsKeys = HashSet.fromList
$ List.take mapListSize $ List.take mapListSize
$ HashSet.toList $ HashSet.toList
$ HashMap.keysSet allTerms $ HashMap.keysSet allTerms
printDebug "[buildNgramsTermsList: ngramsKeys]" (HashSet.size ngramsKeys) -- printDebug "[buildNgramsTermsList: ngramsKeys]" (HashSet.size ngramsKeys)
!groupParams' <- getGroupParams groupParams (HashSet.map (text2ngrams . unNgramsTerm) ngramsKeys) !groupParams' <- getGroupParams groupParams (HashSet.map (text2ngrams . unNgramsTerm) ngramsKeys)
printDebug "[buildNgramsTermsList: groupParams']" ("" :: Text) -- printDebug "[buildNgramsTermsList: groupParams']" ("" :: Text)
let let
!socialLists_Stemmed = addScoreStem groupParams' ngramsKeys socialLists !socialLists_Stemmed = addScoreStem groupParams' ngramsKeys socialLists
...@@ -199,10 +199,10 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi ...@@ -199,10 +199,10 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi
!(groupedMono, groupedMult) = HashMap.partitionWithKey (\(NgramsTerm t) _v -> size t < 2) candidateTerms !(groupedMono, groupedMult) = HashMap.partitionWithKey (\(NgramsTerm t) _v -> size t < 2) candidateTerms
printDebug "[buildNgramsTermsList] socialLists" socialLists -- printDebug "[buildNgramsTermsList] socialLists" socialLists
printDebug "[buildNgramsTermsList] socialLists with scores" socialLists_Stemmed -- printDebug "[buildNgramsTermsList] socialLists with scores" socialLists_Stemmed
printDebug "[buildNgramsTermsList] groupedWithList" groupedWithList -- printDebug "[buildNgramsTermsList] groupedWithList" groupedWithList
printDebug "[buildNgramsTermsList] stopTerms" stopTerms -- printDebug "[buildNgramsTermsList] stopTerms" stopTerms
-- splitting monterms and multiterms to take proportional candidates -- splitting monterms and multiterms to take proportional candidates
-- use % of list if to big, or Int if too small -- use % of list if to big, or Int if too small
...@@ -223,7 +223,7 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi ...@@ -223,7 +223,7 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi
-- Filter 1 With Set NodeId and SpeGen -- Filter 1 With Set NodeId and SpeGen
!selectedTerms = Set.toList $ hasTerms (groupedMonoHead <> groupedMultHead) !selectedTerms = Set.toList $ hasTerms (groupedMonoHead <> groupedMultHead)
printDebug "[buildNgramsTermsList: selectedTerms]" selectedTerms -- printDebug "[buildNgramsTermsList: selectedTerms]" selectedTerms
-- TODO remove (and remove HasNodeError instance) -- TODO remove (and remove HasNodeError instance)
!userListId <- defaultList uCid !userListId <- defaultList uCid
...@@ -235,7 +235,7 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi ...@@ -235,7 +235,7 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi
selectedTerms selectedTerms
printDebug "[buildNgramsTermsList: mapTextDocIds]" mapTextDocIds -- printDebug "[buildNgramsTermsList: mapTextDocIds]" mapTextDocIds
let let
groupedTreeScores_SetNodeId :: HashMap NgramsTerm (GroupedTreeScores (Set NodeId)) groupedTreeScores_SetNodeId :: HashMap NgramsTerm (GroupedTreeScores (Set NodeId))
...@@ -243,7 +243,7 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi ...@@ -243,7 +243,7 @@ buildNgramsTermsList user uCid mCid mfslw groupParams (nt, MapListSize mapListSi
$ setScoresWithMap mapTextDocIds (groupedMonoHead <> groupedMultHead) $ setScoresWithMap mapTextDocIds (groupedMonoHead <> groupedMultHead)
printDebug "[buildNgramsTermsList: groupedTreeScores_SetNodeId]" groupedTreeScores_SetNodeId -- printDebug "[buildNgramsTermsList: groupedTreeScores_SetNodeId]" groupedTreeScores_SetNodeId
-- Coocurrences computation -- Coocurrences computation
--, t1 >= t2 -- permute byAxis diag -- since matrix symmetric --, t1 >= t2 -- permute byAxis diag -- since matrix symmetric
......
...@@ -124,8 +124,8 @@ grid s e tr te = do ...@@ -124,8 +124,8 @@ grid s e tr te = do
<$> mapM (\(x,y) -> grid' x y tr te) <$> mapM (\(x,y) -> grid' x y tr te)
[(x,y) | x <- [s..e], y <- [s..e]] [(x,y) | x <- [s..e], y <- [s..e]]
printDebug "GRID SEARCH" (map fst r) -- printDebug "GRID SEARCH" (map fst r)
--printDebug "file" fp -- printDebug "file" fp
--fp <- saveFile (ModelSVM model') --fp <- saveFile (ModelSVM model')
--save best result --save best result
pure $ snd <$> r pure $ snd <$> r
...@@ -108,7 +108,7 @@ corpusIdtoDocuments timeUnit corpusId = do ...@@ -108,7 +108,7 @@ corpusIdtoDocuments timeUnit corpusId = do
-> context2phyloDocument timeUnit doc (ngs_terms, ngs_sources) -> context2phyloDocument timeUnit doc (ngs_terms, ngs_sources)
) docs ) docs
printDebug "corpusIdtoDocuments" (Prelude.map date docs') -- printDebug "corpusIdtoDocuments" (Prelude.map date docs')
case termList of case termList of
Nothing -> panic "[G.C.V.Phylo.API] no termList found" Nothing -> panic "[G.C.V.Phylo.API] no termList found"
......
...@@ -295,7 +295,7 @@ flow c u cn la mfslw (mLength, docsC) logStatus = do ...@@ -295,7 +295,7 @@ flow c u cn la mfslw (mLength, docsC) logStatus = do
insertDocs' :: [(Integer, a)] -> m [NodeId] insertDocs' :: [(Integer, a)] -> m [NodeId]
insertDocs' [] = pure [] insertDocs' [] = pure []
insertDocs' docs = do insertDocs' docs = do
printDebug "[flow] calling insertDoc, ([idx], mLength) = " (fst <$> docs, mLength) -- printDebug "[flow] calling insertDoc, ([idx], mLength) = " (fst <$> docs, mLength)
ids <- insertMasterDocs c la (snd <$> docs) ids <- insertMasterDocs c la (snd <$> docs)
let maxIdx = maximum (fst <$> docs) let maxIdx = maximum (fst <$> docs)
case mLength of case mLength of
...@@ -354,7 +354,7 @@ flowCorpusUser l user userCorpusId listId ctype mfslw = do ...@@ -354,7 +354,7 @@ flowCorpusUser l user userCorpusId listId ctype mfslw = do
-- Here the PosTagAlgo should be chosen according to the Lang -- Here the PosTagAlgo should be chosen according to the Lang
_ <- case mfslw of _ <- case mfslw of
(Just (NoList _)) -> do (Just (NoList _)) -> do
printDebug "Do not build list" mfslw -- printDebug "Do not build list" mfslw
pure () pure ()
_ -> do _ -> do
ngs <- buildNgramsLists user userCorpusId masterCorpusId mfslw ngs <- buildNgramsLists user userCorpusId masterCorpusId mfslw
...@@ -431,7 +431,7 @@ saveDocNgramsWith lId mapNgramsDocs' = do ...@@ -431,7 +431,7 @@ saveDocNgramsWith lId mapNgramsDocs' = do
, (ngrams_type, mapNodeIdWeight) <- Map.toList mapNgramsTypes , (ngrams_type, mapNodeIdWeight) <- Map.toList mapNgramsTypes
, (nId, (w, _cnt)) <- Map.toList mapNodeIdWeight , (nId, (w, _cnt)) <- Map.toList mapNodeIdWeight
] ]
printDebug "Ngrams2Insert" ngrams2insert -- printDebug "Ngrams2Insert" ngrams2insert
_return <- insertContextNodeNgrams2 ngrams2insert _return <- insertContextNodeNgrams2 ngrams2insert
-- to be removed -- to be removed
......
...@@ -93,10 +93,10 @@ tfidfAll cId ngramIds = do ...@@ -93,10 +93,10 @@ tfidfAll cId ngramIds = do
let docsWithAllNgrams = let docsWithAllNgrams =
List.filter (\(ctxId, _, _) -> List.filter (\(ctxId, _, _) ->
Set.member ctxId docsWithAllNgramsS) docsWithNgrams Set.member ctxId docsWithAllNgramsS) docsWithNgrams
printDebug "[tfidfAll] docsWithAllNgrams" docsWithAllNgrams -- printDebug "[tfidfAll] docsWithAllNgrams" docsWithAllNgrams
let docsWithCounts = Map.fromListWith (+) [ (ctxId, doc_count) let docsWithCounts = Map.fromListWith (+) [ (ctxId, doc_count)
| (ctxId, _, doc_count) <- docsWithAllNgrams] | (ctxId, _, doc_count) <- docsWithAllNgrams]
printDebug "[tfidfAll] docsWithCounts" docsWithCounts -- printDebug "[tfidfAll] docsWithCounts" docsWithCounts
let totals = [ ( ctxId let totals = [ ( ctxId
, ngrams_id , ngrams_id
, fromIntegral doc_count :: Double , fromIntegral doc_count :: Double
......
...@@ -79,7 +79,7 @@ newUsers' cfg us = do ...@@ -79,7 +79,7 @@ newUsers' cfg us = do
r <- insertUsers $ map toUserWrite us' r <- insertUsers $ map toUserWrite us'
_ <- mapM getOrMkRoot $ map (\u -> UserName (_nu_username u)) us _ <- mapM getOrMkRoot $ map (\u -> UserName (_nu_username u)) us
_ <- mapM (\u -> mail cfg (Invitation u)) us _ <- mapM (\u -> mail cfg (Invitation u)) us
printDebug "newUsers'" us -- printDebug "newUsers'" us
pure r pure r
------------------------------------------------------------------------ ------------------------------------------------------------------------
updateUser :: HasNodeError err updateUser :: HasNodeError err
......
...@@ -55,7 +55,7 @@ import Gargantext.Database.Prelude ...@@ -55,7 +55,7 @@ import Gargantext.Database.Prelude
import Gargantext.Database.Schema.Context import Gargantext.Database.Schema.Context
import Gargantext.Database.Schema.Node import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.NodeContext import Gargantext.Database.Schema.NodeContext
import Gargantext.Prelude (printDebug) -- import Gargantext.Prelude (printDebug)
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -124,7 +124,7 @@ runViewDocuments :: HasDBid NodeType ...@@ -124,7 +124,7 @@ runViewDocuments :: HasDBid NodeType
-> Maybe Text -> Maybe Text
-> Cmd err [FacetDoc] -> Cmd err [FacetDoc]
runViewDocuments cId t o l order query year = do runViewDocuments cId t o l order query year = do
printDebug "[runViewDocuments] sqlQuery" $ showSql sqlQuery -- printDebug "[runViewDocuments] sqlQuery" $ showSql sqlQuery
runOpaQuery $ filterWith o l order sqlQuery runOpaQuery $ filterWith o l order sqlQuery
where where
sqlQuery = viewDocuments cId t (toDBid NodeDocument) query year sqlQuery = viewDocuments cId t (toDBid NodeDocument) query year
......
...@@ -72,7 +72,7 @@ getChildrenNode :: (JSONB a, HasDBid NodeType) ...@@ -72,7 +72,7 @@ getChildrenNode :: (JSONB a, HasDBid NodeType)
-> Maybe Limit -> Maybe Limit
-> Cmd err (NodeTableResult a) -> Cmd err (NodeTableResult a)
getChildrenNode pId _ maybeNodeType maybeOffset maybeLimit = do getChildrenNode pId _ maybeNodeType maybeOffset maybeLimit = do
printDebug "getChildrenNode" (pId, maybeNodeType) -- printDebug "getChildrenNode" (pId, maybeNodeType)
let query = selectChildrenNode pId maybeNodeType let query = selectChildrenNode pId maybeNodeType
docs <- runOpaQuery docs <- runOpaQuery
$ limit' maybeLimit $ limit' maybeLimit
...@@ -103,7 +103,7 @@ getChildrenContext :: (JSONB a, HasDBid NodeType) ...@@ -103,7 +103,7 @@ getChildrenContext :: (JSONB a, HasDBid NodeType)
-> Maybe Limit -> Maybe Limit
-> Cmd err (NodeTableResult a) -> Cmd err (NodeTableResult a)
getChildrenContext pId _ maybeNodeType maybeOffset maybeLimit = do getChildrenContext pId _ maybeNodeType maybeOffset maybeLimit = do
printDebug "getChildrenContext" (pId, maybeNodeType) -- printDebug "getChildrenContext" (pId, maybeNodeType)
let query = selectChildren' pId maybeNodeType let query = selectChildren' pId maybeNodeType
docs <- runOpaQuery docs <- runOpaQuery
......
...@@ -175,7 +175,7 @@ waitForJsTask jsTask = wait' 0 ...@@ -175,7 +175,7 @@ waitForJsTask jsTask = wait' 0
if counter > 60 then if counter > 60 then
panic "[waitForJsTask] waited for 1 minute and still no answer from JohnSnow NLP" panic "[waitForJsTask] waited for 1 minute and still no answer from JohnSnow NLP"
else do else do
printDebug "[waitForJsTask] task not ready, waiting" counter -- printDebug "[waitForJsTask] task not ready, waiting" counter
_ <- threadDelay $ 1000000*1 _ <- threadDelay $ 1000000*1
wait' $ counter + 1 wait' $ counter + 1
......
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