Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
145
Issues
145
List
Board
Labels
Milestones
Merge Requests
6
Merge Requests
6
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
gargantext
haskell-gargantext
Commits
7408a02c
Commit
7408a02c
authored
Dec 10, 2018
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[NGRAMS][LIST] getOrMk List.
parent
cadd8650
Pipeline
#52
failed with stage
Changes
4
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
50 additions
and
29 deletions
+50
-29
Ngrams.hs
src/Gargantext/API/Ngrams.hs
+2
-1
Flow.hs
src/Gargantext/Database/Flow.hs
+17
-17
Ngrams.hs
src/Gargantext/Database/Schema/Ngrams.hs
+1
-7
Node.hs
src/Gargantext/Database/Schema/Node.hs
+30
-4
No files found.
src/Gargantext/API/Ngrams.hs
View file @
7408a02c
...
@@ -57,6 +57,7 @@ import GHC.Generics (Generic)
...
@@ -57,6 +57,7 @@ import GHC.Generics (Generic)
--import Gargantext.Core.Types.Main (Tree(..))
--import Gargantext.Core.Types.Main (Tree(..))
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
import
Gargantext.Database.Types.Node
(
NodeType
(
..
))
import
Gargantext.Database.Types.Node
(
NodeType
(
..
))
import
Gargantext.Database.Schema.Node
(
defaultList
)
import
qualified
Gargantext.Database.Schema.Ngrams
as
Ngrams
import
qualified
Gargantext.Database.Schema.Ngrams
as
Ngrams
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Core.Types
(
ListType
(
..
),
ListId
,
CorpusId
)
import
Gargantext.Core.Types
(
ListType
(
..
),
ListId
,
CorpusId
)
...
@@ -295,7 +296,7 @@ getTableNgrams c cId maybeTabType maybeListId = do
...
@@ -295,7 +296,7 @@ getTableNgrams c cId maybeTabType maybeListId = do
_
->
panic
$
lieu
<>
"No Ngrams for this tab"
_
->
panic
$
lieu
<>
"No Ngrams for this tab"
listId
<-
case
maybeListId
of
listId
<-
case
maybeListId
of
Nothing
->
Ngrams
.
defaultList
c
cId
Nothing
->
defaultList
c
cId
Just
lId
->
pure
lId
Just
lId
->
pure
lId
(
ngramsTableDatas
,
mapToParent
,
mapToChildren
)
<-
(
ngramsTableDatas
,
mapToParent
,
mapToChildren
)
<-
...
...
src/Gargantext/Database/Flow.hs
View file @
7408a02c
...
@@ -16,37 +16,37 @@ Portability : POSIX
...
@@ -16,37 +16,37 @@ Portability : POSIX
module
Gargantext.Database.Flow
-- (flowDatabase, ngrams2list)
module
Gargantext.Database.Flow
-- (flowDatabase, ngrams2list)
where
where
import
GHC.Show
(
Show
)
--import Control.Lens (view)
--import Control.Lens (view)
import
System.FilePath
(
FilePath
)
--import Gargantext.Core.Types
--import Gargantext.Database.Node.Contact (HyperdataContact(..))
import
Data.Map
(
Map
,
lookup
)
import
Data.Maybe
(
Maybe
(
..
),
catMaybes
)
import
Data.Maybe
(
Maybe
(
..
),
catMaybes
)
import
Data.Text
(
Text
,
splitOn
)
import
Data.Text
(
Text
,
splitOn
)
import
Data.Map
(
Map
,
lookup
)
import
Data.Tuple.Extra
(
both
,
second
)
import
Data.Tuple.Extra
(
both
,
second
)
import
qualified
Data.Map
as
DM
import
GHC.Show
(
Show
)
import
Gargantext.Core.Types
(
NodePoly
(
..
),
ListType
(
..
),
listTypeId
)
import
Gargantext.Core.Types
(
NodePoly
(
..
),
ListType
(
..
),
listTypeId
)
import
Gargantext.Core.Types.Individu
(
Username
)
import
Gargantext.Core.Types.Main
import
Gargantext.Database.Bashql
(
runCmd'
)
-- , del)
import
Gargantext.Database.Bashql
(
runCmd'
)
-- , del)
import
Gargantext.Database.Config
(
userMaster
,
userArbitrary
,
corpusMasterName
)
import
Gargantext.Database.Config
(
userMaster
,
userArbitrary
,
corpusMasterName
)
import
Gargantext.Database.Schema.Ngrams
(
insertNgrams
,
Ngrams
(
..
),
NgramsT
(
..
),
NgramsIndexed
(
..
),
indexNgramsT
,
NgramsType
(
..
),
text2ngrams
)
import
Gargantext.Database.Flow.Utils
(
insertToNodeNgrams
)
import
Gargantext.Database.Schema.Node
(
mkRoot
,
mkCorpus
,
mkList
,
mkGraph
,
mkDashboard
,
mkAnnuaire
,
getCorporaWithParentId'
)
import
Gargantext.Database.Root
(
getRootCmd
)
import
Gargantext.Database.Types.Node
(
NodeType
(
..
),
NodeId
)
import
Gargantext.Database.Node.Document.Add
(
add
)
import
Gargantext.Database.Node.Document.Add
(
add
)
import
Gargantext.Database.Node.Document.Insert
(
insertDocuments
,
ReturnId
(
..
),
addUniqIdsDoc
,
addUniqIdsContact
,
ToDbData
(
..
))
import
Gargantext.Database.Node.Document.Insert
(
insertDocuments
,
ReturnId
(
..
),
addUniqIdsDoc
,
addUniqIdsContact
,
ToDbData
(
..
))
import
Gargantext.Database.Root
(
getRootCmd
)
import
Gargantext.Database.Schema.Ngrams
(
insertNgrams
,
Ngrams
(
..
),
NgramsT
(
..
),
NgramsIndexed
(
..
),
indexNgramsT
,
NgramsType
(
..
),
text2ngrams
)
import
Gargantext.Database.Schema.Node
(
mkRoot
,
mkCorpus
,
getOrMkList
,
mkGraph
,
mkDashboard
,
mkAnnuaire
,
getCorporaWithParentId'
)
import
Gargantext.Database.Schema.NodeNgram
(
NodeNgramPoly
(
..
),
insertNodeNgrams
)
import
Gargantext.Database.Schema.NodeNgram
(
NodeNgramPoly
(
..
),
insertNodeNgrams
)
import
Gargantext.Database.Schema.NodeNgramsNgrams
(
NodeNgramsNgramsPoly
(
..
),
insertNodeNgramsNgramsNew
)
import
Gargantext.Database.Schema.NodeNgramsNgrams
(
NodeNgramsNgramsPoly
(
..
),
insertNodeNgramsNgramsNew
)
import
Gargantext.Database.Schema.User
(
getUser
,
UserLight
(
..
))
import
Gargantext.Database.Types.Node
(
HyperdataDocument
(
..
))
import
Gargantext.Database.Types.Node
(
HyperdataDocument
(
..
))
import
Gargantext.Database.Types.Node
(
NodeType
(
..
),
NodeId
)
import
Gargantext.Database.Utils
(
Cmd
(
..
))
import
Gargantext.Database.Utils
(
Cmd
(
..
))
--import Gargantext.Database.Node.Contact (HyperdataContact(..))
import
Gargantext.Database.Schema.User
(
getUser
,
UserLight
(
..
))
import
Gargantext.Core.Types.Individu
(
Username
)
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.Text.Parsers
(
parseDocs
,
FileFormat
)
import
Gargantext.Text.Parsers
(
parseDocs
,
FileFormat
)
import
Gargantext.Core.Types.Main
import
System.FilePath
(
FilePath
)
--import Gargantext.Core.Types
import
qualified
Data.Map
as
DM
import
Gargantext.Database.Flow.Utils
(
insertToNodeNgrams
)
flowCorpus
::
FileFormat
->
FilePath
->
CorpusName
->
IO
CorpusId
flowCorpus
::
FileFormat
->
FilePath
->
CorpusName
->
IO
CorpusId
flowCorpus
ff
fp
cName
=
do
flowCorpus
ff
fp
cName
=
do
...
@@ -264,7 +264,7 @@ indexNgrams ng2nId = do
...
@@ -264,7 +264,7 @@ indexNgrams ng2nId = do
flowList
::
UserId
->
CorpusId
->
Map
(
NgramsT
NgramsIndexed
)
(
Map
NodeId
Int
)
->
Cmd
ListId
flowList
::
UserId
->
CorpusId
->
Map
(
NgramsT
NgramsIndexed
)
(
Map
NodeId
Int
)
->
Cmd
ListId
flowList
uId
cId
ngs
=
do
flowList
uId
cId
ngs
=
do
-- printDebug "ngs:" ngs
-- printDebug "ngs:" ngs
lId
<-
maybe
(
panic
"mkList error"
)
identity
<$>
head
<$>
m
kList
cId
uId
lId
<-
getOrM
kList
cId
uId
--printDebug "ngs" (DM.keys ngs)
--printDebug "ngs" (DM.keys ngs)
-- TODO add stemming equivalence of 2 ngrams
-- TODO add stemming equivalence of 2 ngrams
let
groupEd
=
groupNgramsBy
(
\
(
NgramsT
t1
n1
)
(
NgramsT
t2
n2
)
->
if
(((
==
)
t1
t2
)
&&
((
==
)
n1
n2
))
then
(
Just
(
n1
,
n2
))
else
Nothing
)
ngs
let
groupEd
=
groupNgramsBy
(
\
(
NgramsT
t1
n1
)
(
NgramsT
t2
n2
)
->
if
(((
==
)
t1
t2
)
&&
((
==
)
n1
n2
))
then
(
Just
(
n1
,
n2
))
else
Nothing
)
ngs
...
@@ -279,8 +279,8 @@ flowList uId cId ngs = do
...
@@ -279,8 +279,8 @@ flowList uId cId ngs = do
pure
lId
pure
lId
flowListUser
::
UserId
->
CorpusId
->
Cmd
[
Int
]
flowListUser
::
UserId
->
CorpusId
->
Cmd
Int
flowListUser
uId
cId
=
m
kList
cId
uId
flowListUser
uId
cId
=
getOrM
kList
cId
uId
------------------------------------------------------------------------
------------------------------------------------------------------------
...
...
src/Gargantext/Database/Schema/Ngrams.hs
View file @
7408a02c
...
@@ -24,7 +24,7 @@ Ngrams connection to the Database.
...
@@ -24,7 +24,7 @@ Ngrams connection to the Database.
module
Gargantext.Database.Schema.Ngrams
where
module
Gargantext.Database.Schema.Ngrams
where
import
Control.Lens
(
makeLenses
,
view
)
import
Control.Lens
(
makeLenses
,
view
,
_Just
,
traverse
)
import
Data.ByteString.Internal
(
ByteString
)
import
Data.ByteString.Internal
(
ByteString
)
import
Data.Map
(
Map
,
fromList
,
lookup
,
fromListWith
)
import
Data.Map
(
Map
,
fromList
,
lookup
,
fromListWith
)
import
Data.Profunctor.Product.TH
(
makeAdaptorAndInstance
)
import
Data.Profunctor.Product.TH
(
makeAdaptorAndInstance
)
...
@@ -193,12 +193,6 @@ queryInsertNgrams = [sql|
...
@@ -193,12 +193,6 @@ queryInsertNgrams = [sql|
JOIN ngrams c USING (terms); -- columns of unique index
JOIN ngrams c USING (terms); -- columns of unique index
|]
|]
defaultList
::
DPS
.
Connection
->
CorpusId
->
IO
ListId
defaultList
c
cId
=
view
node_id
<$>
maybe
(
panic
errMessage
)
identity
<$>
head
<$>
getListsWithParentId
c
cId
where
errMessage
=
"Gargantext.API.Ngrams.defaultList: no list found"
-- | Ngrams Table
-- | Ngrams Table
-- TODO: the way we are getting main Master Corpus and List ID is not clean
-- TODO: the way we are getting main Master Corpus and List ID is not clean
...
...
src/Gargantext/Database/Schema/Node.hs
View file @
7408a02c
...
@@ -564,13 +564,11 @@ childWith uId pId (Node' NodeContact txt v []) = node2table uId (Just pId) (Nod
...
@@ -564,13 +564,11 @@ childWith uId pId (Node' NodeContact txt v []) = node2table uId (Just pId) (Nod
childWith
_
_
(
Node'
_
_
_
_
)
=
panic
"This NodeType can not be a child"
childWith
_
_
(
Node'
_
_
_
_
)
=
panic
"This NodeType can not be a child"
-- TODO: remove hardcoded userId (with Reader)
-- TODO: user Reader in the API and adapt this function
userId
::
Int
userId
=
1
mk
::
Connection
->
NodeType
->
Maybe
ParentId
->
Text
->
IO
[
Int
]
mk
::
Connection
->
NodeType
->
Maybe
ParentId
->
Text
->
IO
[
Int
]
mk
c
nt
pId
name
=
mk'
c
nt
userId
pId
name
mk
c
nt
pId
name
=
mk'
c
nt
userId
pId
name
where
userId
=
1
mk'
::
Connection
->
NodeType
->
UserId
->
Maybe
ParentId
->
Text
->
IO
[
Int
]
mk'
::
Connection
->
NodeType
->
UserId
->
Maybe
ParentId
->
Text
->
IO
[
Int
]
mk'
c
nt
uId
pId
name
=
map
fromIntegral
<$>
insertNodesWithParentR
pId
[
node
nt
name
hd
pId
uId
]
c
mk'
c
nt
uId
pId
name
=
map
fromIntegral
<$>
insertNodesWithParentR
pId
[
node
nt
name
hd
pId
uId
]
c
...
@@ -594,6 +592,34 @@ mkRoot uname uId = case uId > 0 of
...
@@ -594,6 +592,34 @@ mkRoot uname uId = case uId > 0 of
mkCorpus
::
Maybe
Name
->
Maybe
HyperdataCorpus
->
ParentId
->
UserId
->
Cmd
[
Int
]
mkCorpus
::
Maybe
Name
->
Maybe
HyperdataCorpus
->
ParentId
->
UserId
->
Cmd
[
Int
]
mkCorpus
n
h
p
u
=
insertNodesR'
[
nodeCorpusW
n
h
p
u
]
mkCorpus
n
h
p
u
=
insertNodesR'
[
nodeCorpusW
n
h
p
u
]
--{-
getOrMkList
::
ParentId
->
UserId
->
Cmd
Int
getOrMkList
pId
uId
=
do
maybeList
<-
defaultListSafe'
pId
case
maybeList
of
Nothing
->
maybe
(
panic
"no list"
)
identity
<$>
headMay
<$>
mkList
pId
uId
Just
x
->
pure
x
defaultListSafe'
::
CorpusId
->
Cmd
(
Maybe
ListId
)
defaultListSafe'
cId
=
mkCmd
$
\
c
->
do
maybeNode
<-
headMay
<$>
getListsWithParentId
c
cId
case
maybeNode
of
Nothing
->
pure
Nothing
(
Just
node
)
->
pure
$
Just
$
_node_id
node
--}
defaultListSafe
::
Connection
->
CorpusId
->
IO
(
Maybe
ListId
)
defaultListSafe
c
cId
=
do
maybeNode
<-
headMay
<$>
getListsWithParentId
c
cId
case
maybeNode
of
Nothing
->
pure
Nothing
(
Just
node
)
->
pure
$
Just
$
_node_id
node
defaultList
::
Connection
->
CorpusId
->
IO
ListId
defaultList
c
cId
=
maybe
(
panic
errMessage
)
identity
<$>
defaultListSafe
c
cId
where
errMessage
=
"Gargantext.API.Ngrams.defaultList: no list found"
mkList
::
ParentId
->
UserId
->
Cmd
[
Int
]
mkList
::
ParentId
->
UserId
->
Cmd
[
Int
]
mkList
p
u
=
insertNodesR'
[
nodeListW
Nothing
Nothing
p
u
]
mkList
p
u
=
insertNodesR'
[
nodeListW
Nothing
Nothing
p
u
]
...
...
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