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
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(..))
...
@@ -50,15 +50,15 @@ import Gargantext.Core.Types.Main (Tree(..))
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
import
Gargantext.Database.Ngrams
(
NgramsId
)
import
Gargantext.Database.Ngrams
(
NgramsId
)
import
Gargantext.Database.Node
(
getListsWithParentId
)
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.Database.NodeNgramsNgrams
-- (NodeNgramsNgramsPoly(NodeNgramsNgrams))
import
Gargantext.Prelude
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
Prelude
(
Enum
,
Bounded
,
minBound
,
maxBound
)
import
Servant
hiding
(
Patch
)
import
Servant
hiding
(
Patch
)
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
(
Arbitrary
,
arbitrary
)
import
Test.QuickCheck.Arbitrary
(
Arbitrary
,
arbitrary
)
import
qualified
Data.Set
as
Set
--
import qualified Data.Set as Set
------------------------------------------------------------------------
------------------------------------------------------------------------
--data FacetFormat = Table | Chart
--data FacetFormat = Table | Chart
...
@@ -87,14 +87,37 @@ data NgramsElement =
...
@@ -87,14 +87,37 @@ data NgramsElement =
NgramsElement
{
_ne_ngrams
::
Text
NgramsElement
{
_ne_ngrams
::
Text
,
_ne_list
::
ListType
,
_ne_list
::
ListType
}
}
deriving
(
Ord
,
Eq
,
Show
)
deriving
(
Ord
,
Eq
,
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"_ne_"
)
''
N
gramsElement
)
$
(
deriveJSON
(
unPrefix
"_ne_"
)
''
N
gramsElement
)
instance
ToSchema
NgramsElement
instance
Arbitrary
NgramsElement
where
arbitrary
=
elements
[
NgramsElement
"sport"
StopList
]
------------------------------------------------------------------------
data
NgramsTable
=
NgramsTable
{
_ngramsTable
::
[
Tree
NgramsElement
]
}
data
NgramsTable
=
NgramsTable
{
_ngramsTable
::
[
Tree
NgramsElement
]
}
deriving
(
Ord
,
Eq
,
Generic
)
deriving
(
Ord
,
Eq
,
Generic
)
$
(
deriveJSON
(
unPrefix
"_"
)
''
N
gramsTable
)
$
(
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:
-- On the Client side:
...
@@ -180,7 +203,7 @@ type TableNgramsApi = Summary " Table Ngrams API Change"
...
@@ -180,7 +203,7 @@ type TableNgramsApi = Summary " Table Ngrams API Change"
type
TableNgramsApiGet
=
Summary
" Table Ngrams API Get"
type
TableNgramsApiGet
=
Summary
" Table Ngrams API Get"
:>
QueryParam
"ngramsType"
TabType
:>
QueryParam
"ngramsType"
TabType
:>
QueryParam
"list"
ListId
:>
QueryParam
"list"
ListId
:>
Get
'[
J
SON
]
Ngrams
IdPatchsBack
:>
Get
'[
J
SON
]
Ngrams
Table
type
NgramsIdPatchsFeed
=
NgramsIdPatchs
type
NgramsIdPatchsFeed
=
NgramsIdPatchs
type
NgramsIdPatchsBack
=
NgramsIdPatchs
type
NgramsIdPatchsBack
=
NgramsIdPatchs
...
@@ -197,18 +220,23 @@ toLists :: ListId -> NgramsIdPatchs -> [(ListId, NgramsId, ListTypeId)]
...
@@ -197,18 +220,23 @@ toLists :: ListId -> NgramsIdPatchs -> [(ListId, NgramsId, ListTypeId)]
toLists
lId
np
=
map
(
toList
lId
)
(
_nip_ngramsIdPatchs
np
)
toLists
lId
np
=
map
(
toList
lId
)
(
_nip_ngramsIdPatchs
np
)
toList
::
ListId
->
NgramsIdPatch
->
(
ListId
,
NgramsId
,
ListTypeId
)
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
::
ListId
->
(
NgramsPatch
->
Set
NgramsId
)
->
NgramsIdPatchs
->
[
NodeNgramsNgrams
]
toGroups
lId
addOrRem
ps
=
concat
$
map
(
toGroup
lId
addOrRem
)
$
_nip_ngramsIdPatchs
ps
toGroups
lId
addOrRem
ps
=
concat
$
map
(
toGroup
lId
addOrRem
)
$
_nip_ngramsIdPatchs
ps
toGroup
::
ListId
->
(
NgramsPatch
->
Set
NgramsId
)
->
NgramsIdPatch
->
[
NodeNgramsNgrams
]
toGroup
::
ListId
->
(
NgramsPatch
->
Set
NgramsId
)
->
NgramsIdPatch
->
[
NodeNgramsNgrams
]
toGroup
=
undefined
{-
toGroup lId addOrRem (NgramsIdPatch ngId patch) =
toGroup lId addOrRem (NgramsIdPatch ngId patch) =
map (\ng -> (NodeNgramsNgrams lId ngId ng (Just 1))) (Set.toList $ addOrRem patch)
map (\ng -> (NodeNgramsNgrams lId ngId ng (Just 1))) (Set.toList $ addOrRem patch)
-}
tableNgramsPatch
::
Connection
->
CorpusId
->
Maybe
ListId
->
NgramsIdPatchsFeed
->
IO
NgramsIdPatchsBack
tableNgramsPatch
::
Connection
->
CorpusId
->
Maybe
ListId
->
NgramsIdPatchsFeed
->
IO
NgramsIdPatchsBack
tableNgramsPatch
=
undefined
{-
tableNgramsPatch conn corpusId maybeList patchs = do
tableNgramsPatch conn corpusId maybeList patchs = do
listId <- case maybeList of
listId <- case maybeList of
Nothing -> defaultList conn corpusId
Nothing -> defaultList conn corpusId
...
@@ -217,6 +245,7 @@ tableNgramsPatch conn corpusId maybeList patchs = do
...
@@ -217,6 +245,7 @@ tableNgramsPatch conn corpusId maybeList patchs = do
_ <- ngramsGroup' conn Del $ toGroups listId _np_rem_children patchs
_ <- ngramsGroup' conn Del $ toGroups listId _np_rem_children patchs
_ <- updateNodeNgrams conn (toLists listId patchs)
_ <- updateNodeNgrams conn (toLists listId patchs)
pure (NgramsIdPatchs [])
pure (NgramsIdPatchs [])
-}
getTableNgramsPatch
::
Connection
->
CorpusId
->
Maybe
TabType
->
Maybe
ListId
->
IO
NgramsTable
getTableNgramsPatch
::
Connection
->
CorpusId
->
Maybe
TabType
->
Maybe
ListId
->
IO
NgramsTable
getTableNgramsPatch
=
undefined
getTableNgramsPatch
=
undefined
src/Gargantext/Core/Types/Main.hs
View file @
dc098b15
...
@@ -142,10 +142,11 @@ instance ToJSON a => ToJSON (Tree a) where
...
@@ -142,10 +142,11 @@ instance ToJSON a => ToJSON (Tree a) where
instance
FromJSON
a
=>
FromJSON
(
Tree
a
)
instance
FromJSON
a
=>
FromJSON
(
Tree
a
)
instance
ToSchema
NodeTree
instance
ToSchema
NodeTree
instance
ToSchema
(
Tree
NodeTree
)
instance
ToSchema
a
=>
ToSchema
(
Tree
a
)
instance
Arbitrary
(
Tree
NodeTree
)
where
instance
Arbitrary
(
Tree
NodeTree
)
where
arbitrary
=
elements
[
userTree
,
userTree
]
arbitrary
=
elements
[
userTree
,
userTree
]
-- data Tree a = NodeT a [Tree a]
-- data Tree a = NodeT a [Tree a]
-- same as Data.Tree
-- same as Data.Tree
leafT
::
a
->
Tree
a
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