Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Przemyslaw Kaminski
haskell-gargantext
Commits
18affbf7
Commit
18affbf7
authored
Jul 12, 2019
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[MERGE]
parent
02035d16
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
16 additions
and
15 deletions
+16
-15
Main.hs
bin/gargantext-import/Main.hs
+4
-4
Node.hs
src/Gargantext/API/Node.hs
+7
-5
Flow.hs
src/Gargantext/Database/Flow.hs
+5
-6
No files found.
bin/gargantext-import/Main.hs
View file @
18affbf7
...
...
@@ -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
ServantEr
r
Int64
let
createUsers
::
Cmd
GargErro
r
Int64
createUsers
=
insertUsersDemo
let
--tt = (Unsupervised EN 6 0 Nothing)
tt
=
(
Multi
EN
)
cmd
::
forall
m
.
FlowCmdM
DevEnv
ServantEr
r
m
=>
m
CorpusId
cmd
::
forall
m
.
FlowCmdM
DevEnv
GargErro
r
m
=>
m
CorpusId
cmd
=
flowCorpusFile
(
cs
user
)
(
cs
name
)
(
read
limit
::
Int
)
tt
CsvGargV3
corpusPath
{-
let debatCorpus :: forall m. FlowCmdM DevEnv
ServantEr
r m => m CorpusId
let debatCorpus :: forall m. FlowCmdM DevEnv
GargErro
r m => m CorpusId
debatCorpus = do
docs <- liftIO ( splitEvery 500
<$> take (read limit :: Int)
...
...
src/Gargantext/API/Node.hs
View file @
18affbf7
...
...
@@ -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
'[
J
SON
]
(
Tree
NodeTree
)
-- TODO-ACCESS: CanTree or CanGetNode
...
...
src/Gargantext/Database/Flow.hs
View file @
18affbf7
...
...
@@ -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
ServantE
rr
m
)
flowCorpusApi
::
(
FlowCmdM
env
e
rr
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
ServantE
rr
m
flowCorpusDebat
::
FlowCmdM
env
e
rr
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
ServantE
rr
m
flowCorpusFile
::
FlowCmdM
env
e
rr
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
ServantE
rr
m
flowCorpusSearchInDatabaseApi
::
FlowCmdM
env
e
rr
m
=>
Username
->
Lang
->
Text
->
m
CorpusId
flowCorpusSearchInDatabaseApi
u
la
q
=
do
(
_masterUserId
,
_masterRootId
,
cId
)
<-
getOrMkRootWithCorpus
userMaster
""
(
Nothing
::
Maybe
HyperdataCorpus
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment