Commit 6dcedcdc authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Clean] before factoring

parent 30386057
...@@ -54,6 +54,7 @@ import Test.QuickCheck.Arbitrary ...@@ -54,6 +54,7 @@ import Test.QuickCheck.Arbitrary
import Web.FormUrlEncoded (FromForm) import Web.FormUrlEncoded (FromForm)
import qualified Gargantext.Text.Corpus.API as API import qualified Gargantext.Text.Corpus.API as API
------------------------------------------------------------------------
data Query = Query { query_query :: Text data Query = Query { query_query :: Text
, query_corpus_id :: Int , query_corpus_id :: Int
, query_databases :: [API.ExternalAPIs] , query_databases :: [API.ExternalAPIs]
...@@ -64,7 +65,8 @@ deriveJSON (unPrefix "query_") 'Query ...@@ -64,7 +65,8 @@ deriveJSON (unPrefix "query_") 'Query
instance Arbitrary Query where instance Arbitrary Query where
arbitrary = elements [ Query q n fs arbitrary = elements [ Query q n fs
| q <- ["a","b"] | q <- ["honeybee* AND collopase"
,"covid 19"]
, n <- [0..10] , n <- [0..10]
, fs <- take 3 $ repeat API.externalAPIs , fs <- take 3 $ repeat API.externalAPIs
] ]
...@@ -85,6 +87,7 @@ type GetApi = Get '[JSON] ApiInfo ...@@ -85,6 +87,7 @@ type GetApi = Get '[JSON] ApiInfo
-- | TODO manage several apis -- | TODO manage several apis
-- TODO-ACCESS -- TODO-ACCESS
-- TODO this is only the POST -- TODO this is only the POST
{-
api :: (FlowCmdM env err m) => UserId -> Query -> m CorpusId api :: (FlowCmdM env err m) => UserId -> Query -> m CorpusId
api uid (Query q _ as) = do api uid (Query q _ as) = do
cId <- case head as of cId <- case head as of
...@@ -96,8 +99,10 @@ api uid (Query q _ as) = do ...@@ -96,8 +99,10 @@ api uid (Query q _ as) = do
pure cId' pure cId'
pure cId pure cId
-}
------------------------------------------------ ------------------------------------------------
-- TODO use this route for Client implementation
data ApiInfo = ApiInfo { api_info :: [API.ExternalAPIs]} data ApiInfo = ApiInfo { api_info :: [API.ExternalAPIs]}
deriving (Generic) deriving (Generic)
instance Arbitrary ApiInfo where instance Arbitrary ApiInfo where
...@@ -147,35 +152,35 @@ type AsyncJobs event ctI input output = ...@@ -147,35 +152,35 @@ type AsyncJobs event ctI input output =
type Upload = Summary "Corpus Upload endpoint" type Upload = Summary "Corpus Upload endpoint"
:> "corpus" :> "corpus"
:> Capture "corpus_id" CorpusId :> Capture "corpus_id" CorpusId
:<|> "addWithquery" :> AsyncJobsAPI ScraperStatus WithQuery ScraperStatus :<|> "addWithquery" :> AsyncJobsAPI ScraperStatus WithQuery ScraperStatus
:<|> "addWithfile" :> AsyncJobs ScraperStatus '[FormUrlEncoded] WithForm ScraperStatus :<|> "addWithfile" :> AsyncJobs ScraperStatus '[FormUrlEncoded] WithForm ScraperStatus
type AddWithQuery = Summary "Add with Query to corpus endpoint" type AddWithQuery = Summary "Add with Query to corpus endpoint"
:> "corpus" :> "corpus"
:> Capture "corpus_id" CorpusId :> Capture "corpus_id" CorpusId
:> "add" :> "add"
:> "query" :> "query"
:> "async" :> "async"
:> AsyncJobsAPI ScraperStatus WithQuery ScraperStatus :> AsyncJobsAPI ScraperStatus WithQuery ScraperStatus
type AddWithFile = Summary "Add with MultipartData to corpus endpoint" type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
:> "corpus" :> "corpus"
:> Capture "corpus_id" CorpusId :> Capture "corpus_id" CorpusId
:> "add" :> "add"
:> "file" :> "file"
:> MultipartForm Mem (MultipartData Mem) :> MultipartForm Mem (MultipartData Mem)
:> QueryParam "fileType" FileType :> QueryParam "fileType" FileType
:> "async" :> "async"
:> AsyncJobs ScraperStatus '[JSON] () ScraperStatus :> AsyncJobs ScraperStatus '[JSON] () ScraperStatus
type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint" type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint"
:> "corpus" :> "corpus"
:> Capture "corpus_id" CorpusId :> Capture "corpus_id" CorpusId
:> "add" :> "add"
:> "form" :> "form"
:> "async" :> "async"
:> AsyncJobs ScraperStatus '[FormUrlEncoded] WithForm ScraperStatus :> AsyncJobs ScraperStatus '[FormUrlEncoded] WithForm ScraperStatus
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- TODO WithQuery also has a corpus id -- TODO WithQuery also has a corpus id
...@@ -227,23 +232,6 @@ addToCorpusWithFile cid input filetype logStatus = do ...@@ -227,23 +232,6 @@ addToCorpusWithFile cid input filetype logStatus = do
, _scst_events = Just [] , _scst_events = Just []
} }
{- | Model to fork the flow
-- This is not really optimized since it increases the need RAM
-- and freezes the whole system
-- This is mainly for documentation (see a better solution in the function below)
-- Each process has to be tailored
addToCorpusWithForm' :: FlowCmdM env err m
=> CorpusId
-> WithForm
-> (ScraperStatus -> m ())
-> m ScraperStatus
addToCorpusWithForm' cid (WithForm ft d l) logStatus = do
newStatus <- liftBase newEmptyMVar
s <- addToCorpusWithForm cid (WithForm ft d l) logStatus
_ <- liftBase $ forkIO $ putMVar newStatus s
s' <- liftBase $ takeMVar newStatus
pure s'
-}
addToCorpusWithForm :: FlowCmdM env err m addToCorpusWithForm :: FlowCmdM env err m
=> User => User
-> CorpusId -> CorpusId
......
...@@ -71,7 +71,6 @@ import Gargantext.Database.Schema.NodeNodeNgrams2 -- (NodeNodeNgrams2, insertNod ...@@ -71,7 +71,6 @@ import Gargantext.Database.Schema.NodeNodeNgrams2 -- (NodeNodeNgrams2, insertNod
import Gargantext.Ext.IMT (toSchoolName) import Gargantext.Ext.IMT (toSchoolName)
import Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile) import Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Prelude.Utils hiding (sha)
import Gargantext.Text.Corpus.Parsers (parseFile, FileFormat) import Gargantext.Text.Corpus.Parsers (parseFile, FileFormat)
import Gargantext.Text.List (buildNgramsLists,StopSize(..)) import Gargantext.Text.List (buildNgramsLists,StopSize(..))
import Gargantext.Text.Terms (TermType(..), tt_lang, extractTerms, uniText) import Gargantext.Text.Terms (TermType(..), tt_lang, extractTerms, uniText)
...@@ -84,7 +83,6 @@ import qualified Data.Map as Map ...@@ -84,7 +83,6 @@ import qualified Data.Map as Map
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Gargantext.Database.Action.Query.Node.Document.Add as Doc (add) import qualified Gargantext.Database.Action.Query.Node.Document.Add as Doc (add)
import qualified Gargantext.Text.Corpus.API.Isidore as Isidore import qualified Gargantext.Text.Corpus.API.Isidore as Isidore
import qualified Gargantext.Text.Corpus.Parsers.GrandDebat as GD
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -111,7 +109,6 @@ _flowCorpusApi u n tt l q = do ...@@ -111,7 +109,6 @@ _flowCorpusApi u n tt l q = do
flowCorpus u n tt docs flowCorpus u n tt docs
------------------------------------------------------------------------ ------------------------------------------------------------------------
flowAnnuaire :: FlowCmdM env err m flowAnnuaire :: FlowCmdM env err m
=> User => User
-> Either CorpusName [CorpusId] -> Either CorpusName [CorpusId]
...@@ -121,19 +118,7 @@ flowAnnuaire :: FlowCmdM env err m ...@@ -121,19 +118,7 @@ flowAnnuaire :: FlowCmdM env err m
flowAnnuaire u n l filePath = do flowAnnuaire u n l filePath = do
docs <- liftBase $ (( splitEvery 500 <$> deserialiseImtUsersFromFile filePath) :: IO [[HyperdataContact]]) docs <- liftBase $ (( splitEvery 500 <$> deserialiseImtUsersFromFile filePath) :: IO [[HyperdataContact]])
flow (Nothing :: Maybe HyperdataAnnuaire) u n l docs flow (Nothing :: Maybe HyperdataAnnuaire) u n l docs
------------------------------------------------------------------------
-- UNUSED
_flowCorpusDebat :: FlowCmdM env err m
=> User -> Either CorpusName [CorpusId]
-> Limit -> FilePath
-> m CorpusId
_flowCorpusDebat u n l fp = do
docs <- liftBase ( splitEvery 500
<$> take l
<$> readFile' fp
:: IO [[GD.GrandDebatReference ]]
)
flowCorpus u n (Multi FR) (map (map toHyperdataDocument) docs)
flowCorpusFile :: FlowCmdM env err m flowCorpusFile :: FlowCmdM env err m
=> User -> Either CorpusName [CorpusId] => User -> Either CorpusName [CorpusId]
......
...@@ -44,13 +44,13 @@ moreLike cId o l order ft = do ...@@ -44,13 +44,13 @@ moreLike cId o l order ft = do
--------------------------------------------------------------------------- ---------------------------------------------------------------------------
getPriors :: FavOrTrash -> CorpusId -> Cmd err (Events Bool) getPriors :: FavOrTrash -> CorpusId -> Cmd err (Events Bool)
getPriors ft cId = do getPriors ft cId = do
docs_fav <- filter (\(FacetDoc _ _ _ _ f _) -> f == Just 2) docs_fav <- filter (\(FacetDoc _ _ _ _ f _) -> f == Just 2)
<$> runViewDocuments cId False Nothing Nothing Nothing <$> runViewDocuments cId False Nothing Nothing Nothing
docs_trash <- List.take (List.length docs_fav) docs_trash <- List.take (List.length docs_fav)
<$> runViewDocuments cId True Nothing Nothing Nothing <$> runViewDocuments cId True Nothing Nothing Nothing
let priors = priorEventsWith text (fav2bool ft) ( List.zip (repeat False) docs_fav let priors = priorEventsWith text (fav2bool ft) ( List.zip (repeat False) docs_fav
<> List.zip (repeat True ) docs_trash <> List.zip (repeat True ) docs_trash
......
...@@ -34,6 +34,16 @@ import Gargantext.Database.Admin.Types.Node (NodeId, NodeType, DocId, allNodeTyp ...@@ -34,6 +34,16 @@ import Gargantext.Database.Admin.Types.Node (NodeId, NodeType, DocId, allNodeTyp
import Gargantext.Database.Admin.Utils (Cmd, runPGSQuery) import Gargantext.Database.Admin.Utils (Cmd, runPGSQuery)
import Gargantext.Prelude import Gargantext.Prelude
------------------------------------------------------------------------
findCorpus :: RootId -> Cmd err (Maybe CorpusId)
findCorpus r = do
_mapNodes <- toTreeParent <$> dbTree r []
pure Nothing
------------------------------------------------------------------------ ------------------------------------------------------------------------
data TreeError = NoRoot | EmptyRoot | TooManyRoots data TreeError = NoRoot | EmptyRoot | TooManyRoots
deriving (Show) deriving (Show)
......
...@@ -7,7 +7,18 @@ Maintainer : team@gargantext.org ...@@ -7,7 +7,18 @@ Maintainer : team@gargantext.org
Stability : experimental Stability : experimental
Portability : POSIX Portability : POSIX
TODO: create a separate Lib. _flowCorpusDebat :: FlowCmdM env err m
=> User -> Either CorpusName [CorpusId]
-> Limit -> FilePath
-> m CorpusId
_flowCorpusDebat u n l fp = do
docs <- liftBase ( splitEvery 500
<$> take l
<$> readFile' fp
:: IO [[GD.GrandDebatReference ]]
)
flowCorpus u n (Multi FR) (map (map toHyperdataDocument) docs)
-} -}
......
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