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
158
Issues
158
List
Board
Labels
Milestones
Merge Requests
10
Merge Requests
10
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
dc098b15
Commit
dc098b15
authored
Nov 08, 2018
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[API][NGRAMS] Tree Ngrams for Mock.
parent
689ace0f
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
38 additions
and
8 deletions
+38
-8
Ngrams.hs
src/Gargantext/API/Ngrams.hs
+36
-7
Main.hs
src/Gargantext/Core/Types/Main.hs
+2
-1
No files found.
src/Gargantext/API/Ngrams.hs
View file @
dc098b15
...
...
@@ -50,15 +50,15 @@ import Gargantext.Core.Types.Main (Tree(..))
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
import
Gargantext.Database.Ngrams
(
NgramsId
)
import
Gargantext.Database.Node
(
getListsWithParentId
)
import
Gargantext.Database.NodeNgram
-- (NodeNgram(..), NodeNgram, updateNodeNgrams, NodeNgramPoly)
--
import Gargantext.Database.NodeNgram -- (NodeNgram(..), NodeNgram, updateNodeNgrams, NodeNgramPoly)
import
Gargantext.Database.NodeNgramsNgrams
-- (NodeNgramsNgramsPoly(NodeNgramsNgrams))
import
Gargantext.Prelude
import
Gargantext.Text.List.Types
(
ListType
(
..
),
listTypeId
,
ListId
,
ListTypeId
)
import
Gargantext.Text.List.Types
(
ListType
(
..
),
ListId
,
ListTypeId
)
--,listTypeId
)
import
Prelude
(
Enum
,
Bounded
,
minBound
,
maxBound
)
import
Servant
hiding
(
Patch
)
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
(
Arbitrary
,
arbitrary
)
import
qualified
Data.Set
as
Set
--
import qualified Data.Set as Set
------------------------------------------------------------------------
--data FacetFormat = Table | Chart
...
...
@@ -87,14 +87,37 @@ data NgramsElement =
NgramsElement
{
_ne_ngrams
::
Text
,
_ne_list
::
ListType
}
deriving
(
Ord
,
Eq
,
Show
)
deriving
(
Ord
,
Eq
,
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"_ne_"
)
''
N
gramsElement
)
instance
ToSchema
NgramsElement
instance
Arbitrary
NgramsElement
where
arbitrary
=
elements
[
NgramsElement
"sport"
StopList
]
------------------------------------------------------------------------
data
NgramsTable
=
NgramsTable
{
_ngramsTable
::
[
Tree
NgramsElement
]
}
deriving
(
Ord
,
Eq
,
Generic
)
$
(
deriveJSON
(
unPrefix
"_"
)
''
N
gramsTable
)
instance
Arbitrary
NgramsTable
where
arbitrary
=
NgramsTable
<$>
arbitrary
-- TODO
instance
Arbitrary
(
Tree
NgramsElement
)
where
arbitrary
=
elements
[
TreeN
(
NgramsElement
"animal"
GraphList
)
[
TreeN
(
NgramsElement
"dog"
GraphList
)
[]
,
TreeN
(
NgramsElement
"object"
CandidateList
)
[]
,
TreeN
(
NgramsElement
"cat"
GraphList
)
[]
,
TreeN
(
NgramsElement
"nothing"
StopList
)
[]
]
,
TreeN
(
NgramsElement
"plant"
GraphList
)
[
TreeN
(
NgramsElement
"flower"
GraphList
)
[]
,
TreeN
(
NgramsElement
"moon"
CandidateList
)
[]
,
TreeN
(
NgramsElement
"cat"
GraphList
)
[]
,
TreeN
(
NgramsElement
"sky"
StopList
)
[]
]
]
instance
ToSchema
NgramsTable
------------------------------------------------------------------------
-- On the Client side:
...
...
@@ -180,7 +203,7 @@ type TableNgramsApi = Summary " Table Ngrams API Change"
type
TableNgramsApiGet
=
Summary
" Table Ngrams API Get"
:>
QueryParam
"ngramsType"
TabType
:>
QueryParam
"list"
ListId
:>
Get
'[
J
SON
]
Ngrams
IdPatchsBack
:>
Get
'[
J
SON
]
Ngrams
Table
type
NgramsIdPatchsFeed
=
NgramsIdPatchs
type
NgramsIdPatchsBack
=
NgramsIdPatchs
...
...
@@ -197,18 +220,23 @@ toLists :: ListId -> NgramsIdPatchs -> [(ListId, NgramsId, ListTypeId)]
toLists
lId
np
=
map
(
toList
lId
)
(
_nip_ngramsIdPatchs
np
)
toList
::
ListId
->
NgramsIdPatch
->
(
ListId
,
NgramsId
,
ListTypeId
)
toList
lId
(
NgramsIdPatch
ngId
(
NgramsPatch
lt
_
_
))
=
(
lId
,
ngId
,
listTypeId
lt
)
toList
=
undefined
-- toList lId (NgramsIdPatch ngId (NgramsPatch lt _ _)) = (lId,ngId,listTypeId lt)
toGroups
::
ListId
->
(
NgramsPatch
->
Set
NgramsId
)
->
NgramsIdPatchs
->
[
NodeNgramsNgrams
]
toGroups
lId
addOrRem
ps
=
concat
$
map
(
toGroup
lId
addOrRem
)
$
_nip_ngramsIdPatchs
ps
toGroup
::
ListId
->
(
NgramsPatch
->
Set
NgramsId
)
->
NgramsIdPatch
->
[
NodeNgramsNgrams
]
toGroup
=
undefined
{-
toGroup lId addOrRem (NgramsIdPatch ngId patch) =
map (\ng -> (NodeNgramsNgrams lId ngId ng (Just 1))) (Set.toList $ addOrRem patch)
-}
tableNgramsPatch
::
Connection
->
CorpusId
->
Maybe
ListId
->
NgramsIdPatchsFeed
->
IO
NgramsIdPatchsBack
tableNgramsPatch
=
undefined
{-
tableNgramsPatch conn corpusId maybeList patchs = do
listId <- case maybeList of
Nothing -> defaultList conn corpusId
...
...
@@ -217,6 +245,7 @@ tableNgramsPatch conn corpusId maybeList patchs = do
_ <- ngramsGroup' conn Del $ toGroups listId _np_rem_children patchs
_ <- updateNodeNgrams conn (toLists listId patchs)
pure (NgramsIdPatchs [])
-}
getTableNgramsPatch
::
Connection
->
CorpusId
->
Maybe
TabType
->
Maybe
ListId
->
IO
NgramsTable
getTableNgramsPatch
=
undefined
src/Gargantext/Core/Types/Main.hs
View file @
dc098b15
...
...
@@ -142,10 +142,11 @@ instance ToJSON a => ToJSON (Tree a) where
instance
FromJSON
a
=>
FromJSON
(
Tree
a
)
instance
ToSchema
NodeTree
instance
ToSchema
(
Tree
NodeTree
)
instance
ToSchema
a
=>
ToSchema
(
Tree
a
)
instance
Arbitrary
(
Tree
NodeTree
)
where
arbitrary
=
elements
[
userTree
,
userTree
]
-- data Tree a = NodeT a [Tree a]
-- same as Data.Tree
leafT
::
a
->
Tree
a
...
...
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