Commit 18affbf7 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[MERGE]

parent 02035d16
......@@ -21,7 +21,6 @@ module Main where
import Prelude (read)
import Control.Exception (finally)
import Servant (ServantErr)
import Gargantext.Prelude
import Gargantext.Database.Flow (FlowCmdM, flowCorpusFile)
import Gargantext.Text.Corpus.Parsers (FileFormat(..))
......@@ -30,6 +29,7 @@ import Gargantext.Database.Types.Node (CorpusId, toHyperdataDocument)
import Gargantext.Database.Schema.User (insertUsersDemo)
import Gargantext.Text.Terms (TermType(..))
import Gargantext.Core (Lang(..))
import Gargantext.API -- (GargError)
import Gargantext.API.Node () -- instances
import Gargantext.API.Settings (withDevEnv, runCmdDev, DevEnv)
import System.Environment (getArgs)
......@@ -42,16 +42,16 @@ main = do
[userCreate, user, name, iniPath, limit, corpusPath] <- getArgs
--{-
let createUsers :: Cmd ServantErr Int64
let createUsers :: Cmd GargError Int64
createUsers = insertUsersDemo
let
--tt = (Unsupervised EN 6 0 Nothing)
tt = (Multi EN)
cmd :: forall m. FlowCmdM DevEnv ServantErr m => m CorpusId
cmd :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
cmd = flowCorpusFile (cs user) (cs name) (read limit :: Int) tt CsvGargV3 corpusPath
{-
let debatCorpus :: forall m. FlowCmdM DevEnv ServantErr m => m CorpusId
let debatCorpus :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
debatCorpus = do
docs <- liftIO ( splitEvery 500
<$> take (read limit :: Int)
......
......@@ -38,7 +38,7 @@ Node API
module Gargantext.API.Node
where
import Control.Lens (prism', (.~), (?~))
import Control.Lens ((.~), (?~))
import Control.Monad ((>>), forM)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (FromJSON, ToJSON)
......@@ -58,9 +58,9 @@ import Gargantext.Core.Types.Main (Tree, NodeTree, ListType)
import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..),runViewAuthorsDoc)
import Gargantext.Database.Node.Children (getChildren)
import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNode, getNode', deleteNode, deleteNodes, mkNodeWithParent, JSONB, NodeError(..), HasNodeError(..))
import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNode, getNode', deleteNode, deleteNodes, mkNodeWithParent, JSONB, HasNodeError(..))
import Gargantext.Database.Schema.NodeNode (nodesToFavorite, nodesToTrash)
import Gargantext.Database.Tree (treeDB, HasTreeError(..), TreeError(..))
import Gargantext.Database.Tree (treeDB)
import Gargantext.Database.Types.Node
import Gargantext.Database.Utils -- (Cmd, CmdM)
import Gargantext.Prelude
......@@ -302,7 +302,9 @@ type TreeApi = Summary " Tree API"
------------------------------------------------------------------------
{-
NOTE: These instances are not necessary. However, these messages could be part
of a display function for NodeError/TreeError.
instance HasNodeError ServantErr where
_NodeError = prism' mk (const Nothing) -- panic "HasNodeError ServantErr: not a prism")
where
......@@ -320,7 +322,6 @@ instance HasNodeError ServantErr where
mk ManyParents = err500 { errBody = e <> "Too many parents" }
mk ManyNodeUsers = err500 { errBody = e <> "Many userNode/user" }
-- TODO(orphan): There should be a proper APIError data type with a case TreeError.
instance HasTreeError ServantErr where
_TreeError = prism' mk (const Nothing) -- panic "HasTreeError ServantErr: not a prism")
where
......@@ -328,6 +329,7 @@ instance HasTreeError ServantErr where
mk NoRoot = err404 { errBody = e <> "Root node not found" }
mk EmptyRoot = err500 { errBody = e <> "Root node should not be empty" }
mk TooManyRoots = err500 { errBody = e <> "Too many root nodes" }
-}
type TreeAPI = Get '[JSON] (Tree NodeTree)
-- TODO-ACCESS: CanTree or CanGetNode
......
......@@ -70,7 +70,6 @@ import Gargantext.Text.Corpus.Parsers (parseFile, FileFormat)
import qualified Gargantext.Text.Corpus.API.Isidore as Isidore
import Gargantext.Text.Terms (TermType(..), tt_lang, extractTerms, uniText)
import Gargantext.Text.Terms.Mono.Stem.En (stemIt)
import Servant (ServantErr)
import System.FilePath (FilePath)
import qualified Data.List as List
import qualified Data.Map as Map
......@@ -98,7 +97,7 @@ getDataApi lang limit (ApiIsidoreQuery q) = Isidore.get lang limit (Just q) Noth
getDataApi lang limit (ApiIsidoreAuth q) = Isidore.get lang limit Nothing (Just q)
flowCorpusApi :: ( FlowCmdM env ServantErr m)
flowCorpusApi :: ( FlowCmdM env err m)
=> Username -> CorpusName
-> TermType Lang
-> Maybe Limit
......@@ -110,14 +109,14 @@ flowCorpusApi u n tt l q = do
------------------------------------------------------------------------
flowAnnuaire :: FlowCmdM env ServantErr m
flowAnnuaire :: FlowCmdM env err m
=> Username -> CorpusName -> (TermType Lang) -> FilePath -> m AnnuaireId
flowAnnuaire u n l filePath = do
docs <- liftIO $ (( splitEvery 500 <$> deserialiseImtUsersFromFile filePath) :: IO [[HyperdataContact]])
flow (Nothing :: Maybe HyperdataAnnuaire) u n l docs
flowCorpusDebat :: FlowCmdM env ServantErr m
flowCorpusDebat :: FlowCmdM env err m
=> Username -> CorpusName
-> Limit -> FilePath
-> m CorpusId
......@@ -129,7 +128,7 @@ flowCorpusDebat u n l fp = do
)
flowCorpus u n (Multi FR) (map (map toHyperdataDocument) docs)
flowCorpusFile :: FlowCmdM env ServantErr m
flowCorpusFile :: FlowCmdM env err m
=> Username -> CorpusName
-> Limit -- Limit the number of docs (for dev purpose)
-> TermType Lang -> FileFormat -> FilePath
......@@ -150,7 +149,7 @@ flowCorpusSearchInDatabase u la q = do
flowCorpusUser la u q (Nothing :: Maybe HyperdataCorpus) ids
flowCorpusSearchInDatabaseApi :: FlowCmdM env ServantErr m
flowCorpusSearchInDatabaseApi :: FlowCmdM env err m
=> Username -> Lang -> Text -> m CorpusId
flowCorpusSearchInDatabaseApi u la q = do
(_masterUserId, _masterRootId, cId) <- getOrMkRootWithCorpus userMaster "" (Nothing :: Maybe HyperdataCorpus)
......
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