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
147
Issues
147
List
Board
Labels
Milestones
Merge Requests
9
Merge Requests
9
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
4500b970
Commit
4500b970
authored
Feb 08, 2019
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[DB] NodesNgramsRepo.
parent
f1f4726a
Changes
6
Show whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
121 additions
and
107 deletions
+121
-107
Ngrams.hs
src/Gargantext/API/Ngrams.hs
+10
-24
Flow.hs
src/Gargantext/Database/Flow.hs
+1
-2
Ngrams.hs
src/Gargantext/Database/Schema/Ngrams.hs
+5
-1
Node.hs
src/Gargantext/Database/Schema/Node.hs
+58
-50
schema.sql
src/Gargantext/Database/Schema/schema.sql
+31
-8
Node.hs
src/Gargantext/Database/Types/Node.hs
+16
-22
No files found.
src/Gargantext/API/Ngrams.hs
View file @
4500b970
...
...
@@ -71,6 +71,8 @@ import GHC.Generics (Generic)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
-- import Gargantext.Database.Schema.Ngrams (NgramsTypeId, ngramsTypeId, NgramsTableData(..))
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
)
import
Gargantext.Database.Utils
(
fromField'
)
import
Database.PostgreSQL.Simple.FromField
(
FromField
,
fromField
)
import
qualified
Gargantext.Database.Schema.Ngrams
as
Ngrams
-- import Gargantext.Database.Schema.NodeNgram hiding (Action)
import
Gargantext.Prelude
...
...
@@ -404,6 +406,14 @@ instance Action NgramsPatch (Maybe NgramsElement) where
newtype
NgramsTablePatch
=
NgramsTablePatch
(
PatchMap
NgramsTerm
NgramsPatch
)
deriving
(
Eq
,
Show
,
Generic
,
ToJSON
,
FromJSON
,
Semigroup
,
Monoid
,
Validity
,
Transformable
)
instance
FromField
NgramsTablePatch
where
fromField
=
fromField'
instance
FromField
(
PatchMap
NgramsType
(
PatchMap
NodeId
NgramsTablePatch
))
where
fromField
=
fromField'
--instance (Ord k, Action pv (Maybe v)) => Action (PatchMap k pv) (Map k v) where
--
type
instance
ConflictResolution
NgramsTablePatch
=
...
...
@@ -722,28 +732,4 @@ getTableNgrams _cId maybeTabType listIds mlimit moffset = do
getTableNgrams'
listIds
ngramsType
&
mapped
.
v_data
.
_NgramsTable
%~
(
take
limit_
.
drop
offset_
)
{-
v <- view repoVar
repo <- liftIO $ readMVar v
let ngrams = repo ^.. r_state
. at listId . _Just
. at ngramsType . _Just
. taking limit_ (dropping offset_ each)
let ngrams' = case List.null ngrams of
True -> [] -- buildRepoFromDb (TODO sync with DB at shutdown)
False -> ngrams
pure $ Versioned (repo ^. r_version) (NgramsTable ngrams')
-}
{-
buildRepoFromDb listId = do
ngramsTableDatas <-
Ngrams.getNgramsTableDb NodeDocument ngramsType (Ngrams.NgramsTableParam listId cId) limit_ offset_
-- printDebug "ngramsTableDatas" ngramsTableDatas
pure $ Versioned 1 $ NgramsTable (toNgramsElement ngramsTableDatas)
-}
src/Gargantext/Database/Flow.hs
View file @
4500b970
...
...
@@ -349,4 +349,3 @@ insertLists lId lngs = insertNodeNgrams [ NodeNgram lId (_ngramsId ng) Nothing (
|
(
l
,(
ngt
,
ng
))
<-
lngs
]
------------------------------------------------------------------------
src/Gargantext/Database/Schema/Ngrams.hs
View file @
4500b970
...
...
@@ -25,6 +25,7 @@ Ngrams connection to the Database.
module
Gargantext.Database.Schema.Ngrams
where
import
Data.Aeson
(
FromJSON
,
FromJSONKey
)
import
Control.Lens
(
makeLenses
,
view
,
over
)
import
Control.Monad
(
mzero
)
import
Data.ByteString.Internal
(
ByteString
)
...
...
@@ -100,7 +101,10 @@ dbGetNgramsDb = runOpaQuery queryNgramsTable
-- ngrams in authors field of document has Authors Type
-- ngrams in text (title or abstract) of documents has Terms Type
data
NgramsType
=
Authors
|
Institutes
|
Sources
|
NgramsTerms
deriving
(
Eq
,
Show
,
Ord
,
Enum
,
Bounded
)
deriving
(
Eq
,
Show
,
Ord
,
Enum
,
Bounded
,
Generic
)
instance
FromJSON
NgramsType
instance
FromJSONKey
NgramsType
newtype
NgramsTypeId
=
NgramsTypeId
Int
deriving
(
Eq
,
Show
,
Ord
,
Num
)
...
...
src/Gargantext/Database/Schema/Node.hs
View file @
4500b970
...
...
@@ -155,16 +155,17 @@ instance QueryRunnerColumnDefault PGInt4 NodeId
------------------------------------------------------------------------
$
(
makeAdaptorAndInstance
"pNode"
''
N
odePoly
)
$
(
makeLensesWith
abbreviatedFields
''
N
odePoly
)
$
(
makeAdaptorAndInstance
"pNodeSearch"
''
N
odePolySearch
)
$
(
makeLensesWith
abbreviatedFields
''
N
odePolySearch
)
type
NodeWrite
=
NodePoly
(
Maybe
(
Column
PGInt4
)
)
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Maybe
(
Column
PGInt4
)
)
(
Column
PGText
)
type
NodeWrite
=
NodePoly
(
Maybe
(
Column
PGInt4
)
)
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Maybe
(
Column
PGInt4
)
)
(
Column
PGText
)
(
Maybe
(
Column
PGTimestamptz
))
(
Column
PGJsonb
)
(
Column
PGJsonb
)
type
NodeRead
=
NodePoly
(
Column
PGInt4
)
(
Column
PGInt4
)
...
...
@@ -174,12 +175,12 @@ type NodeRead = NodePoly (Column PGInt4 )
(
Column
PGTimestamptz
)
(
Column
PGJsonb
)
type
NodeReadNull
=
NodePoly
(
Column
(
Nullable
PGInt4
))
(
Column
(
Nullable
PGInt4
))
(
Column
(
Nullable
PGInt4
))
(
Column
(
Nullable
PGInt4
))
(
Column
(
Nullable
PGText
))
(
Column
(
Nullable
PGTimestamptz
))
type
NodeReadNull
=
NodePoly
(
Column
(
Nullable
PGInt4
))
(
Column
(
Nullable
PGInt4
))
(
Column
(
Nullable
PGInt4
))
(
Column
(
Nullable
PGInt4
))
(
Column
(
Nullable
PGText
))
(
Column
(
Nullable
PGTimestamptz
))
(
Column
(
Nullable
PGJsonb
))
nodeTable
::
Table
NodeWrite
NodeRead
...
...
@@ -201,32 +202,38 @@ queryNodeTable = queryTable nodeTable
------------------------------------------------------------------------
-- | Node(Read|Write)Search is slower than Node(Write|Read) use it
-- for full text search only
type
NodeSearchWrite
=
NodePolySearch
(
Maybe
(
Column
PGInt4
))
type
NodeSearchWrite
=
NodePolySearch
(
Maybe
(
Column
PGInt4
)
)
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Column
(
Nullable
PGInt4
)
)
(
Column
(
PGText
)
)
(
Column
(
Nullable
PGInt4
)
)
(
Column
PGText
)
(
Maybe
(
Column
PGTimestamptz
))
(
Column
PGJsonb
)
(
Maybe
(
Column
PGTSVector
)
)
(
Maybe
(
Column
PGTSVector
)
)
type
NodeSearchRead
=
NodePolySearch
(
Column
PGInt4
)
type
NodeSearchRead
=
NodePolySearch
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Column
(
Nullable
PGInt4
))
(
Column
(
PGText
)
)
(
Column
PGText
)
(
Column
PGTimestamptz
)
(
Column
PGJsonb
)
(
Column
PGTSVector
)
type
NodeSearchReadNull
=
NodePolySearch
(
Column
(
Nullable
PGInt4
))
(
Column
(
Nullable
PGInt4
))
(
Column
(
Nullable
PGInt4
))
(
Column
(
Nullable
PGInt4
))
(
Column
(
Nullable
PGText
))
(
Column
(
Nullable
PGTimestamptz
))
(
Column
(
Nullable
PGJsonb
))
(
Column
(
Nullable
PGTSVector
))
(
Column
PGJsonb
)
(
Column
PGTSVector
)
type
NodeSearchReadNull
=
NodePolySearch
(
Column
(
Nullable
PGInt4
)
)
(
Column
(
Nullable
PGInt4
)
)
(
Column
(
Nullable
PGInt4
)
)
(
Column
(
Nullable
PGInt4
)
)
(
Column
(
Nullable
PGText
)
)
(
Column
(
Nullable
PGTimestamptz
))
(
Column
(
Nullable
PGJsonb
)
)
(
Column
(
Nullable
PGTSVector
)
)
--{-
nodeTableSearch
::
Table
NodeSearchWrite
NodeSearchRead
...
...
@@ -336,7 +343,8 @@ type JSONB = QueryRunnerColumnDefault PGJsonb
getNode
::
JSONB
a
=>
NodeId
->
proxy
a
->
Cmd
err
(
Node
a
)
getNode
nId
_
=
do
fromMaybe
(
error
$
"Node does node exist: "
<>
show
nId
)
.
headMay
<$>
runOpaQuery
(
limit
1
$
selectNode
(
pgNodeId
nId
))
fromMaybe
(
error
$
"Node does node exist: "
<>
show
nId
)
.
headMay
<$>
runOpaQuery
(
limit
1
$
selectNode
(
pgNodeId
nId
))
getNodesWithType
::
Column
PGInt4
->
Cmd
err
[
Node
HyperdataDocument
]
getNodesWithType
=
runOpaQuery
.
selectNodesWithType
...
...
src/Gargantext/Database/Schema/schema.sql
View file @
4500b970
CREATE
EXTENSION
IF
NOT
EXISTS
plpgsql
WITH
SCHEMA
pg_catalog
;
COMMENT
ON
EXTENSION
plpgsql
IS
'PL/pgSQL procedural language'
;
-- needed for rights management
-- CREATE EXTENSION IF NOT EXISTS acl WITH SCHEMA public;
-- CREATE USER WITH ...
-- createdb "gargandb"
...
...
@@ -23,6 +21,7 @@ CREATE TABLE public.auth_user (
ALTER
TABLE
public
.
auth_user
OWNER
TO
gargantua
;
-- TODO add publication_date
-- TODO typename -> type_id
CREATE
TABLE
public
.
nodes
(
...
...
@@ -40,7 +39,6 @@ CREATE TABLE public.nodes (
ALTER
TABLE
public
.
nodes
OWNER
TO
gargantua
;
CREATE
TABLE
public
.
ngrams
(
id
SERIAL
,
terms
character
varying
(
255
),
...
...
@@ -49,7 +47,9 @@ CREATE TABLE public.ngrams (
);
ALTER
TABLE
public
.
ngrams
OWNER
TO
gargantua
;
-- TODO: delete ID
--------------------------------------------------------------
--------------------------------------------------------------
-- TODO: delete delete this table
CREATE
TABLE
public
.
nodes_ngrams
(
id
SERIAL
,
node_id
integer
NOT
NULL
,
...
...
@@ -64,11 +64,19 @@ CREATE TABLE public.nodes_ngrams (
-- PRIMARY KEY (node_id,ngrams_id)
);
ALTER
TABLE
public
.
nodes_ngrams
OWNER
TO
gargantua
;
--------------------------------------------------------------
CREATE
TABLE
public
.
nodes_ngrams_repo
(
version
integer
NOT
NULL
,
patches
jsonb
DEFAULT
'{}'
::
jsonb
NOT
NULL
,
PRIMARY
KEY
(
version
)
);
ALTER
TABLE
public
.
nodes_ngrams_repo
OWNER
TO
gargantua
;
--------------------------------------------------------------
--
-- Name: nodes_ngrams_ngrams; Type: TABLE; Schema: public; Owner: gargantua
--
-- TODO: delete delete this table
CREATE
TABLE
public
.
nodes_ngrams_ngrams
(
node_id
integer
NOT
NULL
REFERENCES
public
.
nodes
(
id
)
ON
DELETE
CASCADE
,
ngram1_id
integer
NOT
NULL
REFERENCES
public
.
ngrams
(
id
)
ON
DELETE
CASCADE
,
...
...
@@ -79,7 +87,7 @@ CREATE TABLE public.nodes_ngrams_ngrams (
ALTER
TABLE
public
.
nodes_ngrams_ngrams
OWNER
TO
gargantua
;
---------------------------------------------------------
CREATE
TABLE
public
.
nodes_nodes
(
node1_id
integer
NOT
NULL
,
node2_id
integer
NOT
NULL
,
...
...
@@ -89,8 +97,23 @@ CREATE TABLE public.nodes_nodes (
PRIMARY
KEY
(
node1_id
,
node2_id
)
);
ALTER
TABLE
public
.
nodes_nodes
OWNER
TO
gargantua
;
---------------------------------------------------------
-- If needed for rights management at row level
-- CREATE EXTENSION IF NOT EXISTS acl WITH SCHEMA public;
CREATE
TABLE
public
.
rights
(
user_id
INTEGER
NOT
NULL
REFERENCES
public
.
auth_user
(
id
)
ON
DELETE
CASCADE
,
node_id
INTEGER
NOT
NULL
REFERENCES
public
.
nodes
(
id
)
ON
DELETE
CASCADE
,
rights
INTEGER
NOT
NULL
,
PRIMARY
KEY
(
user_id
,
node_id
)
);
ALTER
TABLE
public
.
rights
OWNER
TO
gargantua
;
CREATE
INDEX
rights_userId_nodeId
ON
public
.
rights
USING
btree
(
user_id
,
node_id
);
------------------------------------------------------------
-- INDEXES
CREATE
UNIQUE
INDEX
ON
public
.
auth_user
(
username
);
...
...
src/Gargantext/Database/Types/Node.hs
View file @
4500b970
...
...
@@ -28,8 +28,7 @@ import Prelude (Enum, Bounded, minBound, maxBound)
import
GHC.Generics
(
Generic
)
import
Control.Lens
hiding
(
elements
)
import
qualified
Control.Lens
as
L
import
Control.Lens
hiding
(
elements
,
(
&
))
import
Control.Applicative
((
<*>
))
import
Control.Monad
(
mzero
)
...
...
@@ -41,7 +40,7 @@ import Data.ByteString.Lazy (ByteString)
import
Data.Either
import
Data.Eq
(
Eq
)
import
Data.Monoid
(
mempty
)
import
Data.Text
(
Text
,
unpack
)
import
Data.Text
(
Text
,
unpack
,
pack
)
import
Data.Time
(
UTCTime
)
import
Data.Time.Segment
(
jour
,
timesAfter
,
Granularity
(
D
))
import
Data.Swagger
...
...
@@ -74,6 +73,7 @@ instance FromField NodeId where
instance
ToJSON
NodeId
instance
FromJSON
NodeId
instance
FromJSONKey
NodeId
instance
ToSchema
NodeId
instance
FromHttpApiData
NodeId
where
...
...
@@ -237,11 +237,8 @@ instance ToSchema Event where
declareNamedSchema
proxy
=
genericDeclareNamedSchema
defaultSchemaOptions
proxy
------------------------------------------------------------------------
type
Text'
=
Text
instance
Arbitrary
Text'
where
arbitrary
=
elements
[
"ici"
,
"la"
]
instance
Arbitrary
Text
where
arbitrary
=
elements
$
map
(
\
c
->
pack
[
c
])
[
'a'
..
'z'
]
data
Resource
=
Resource
{
resource_path
::
Maybe
Text
,
resource_scraper
::
Maybe
Text
...
...
@@ -500,27 +497,24 @@ docExample = "{\"doi\":\"sdfds\",\"publication_day\":6,\"language_iso2\":\"en\",
instance
ToSchema
HyperdataCorpus
where
declareNamedSchema
proxy
=
genericDeclareNamedSchema
defaultSchemaOptions
proxy
L
.&
mapped
.
schema
.
description
?~
"a corpus"
L
.&
mapped
.
schema
.
example
?~
toJSON
hyperdataCorpus
&
mapped
.
schema
.
description
?~
"a corpus"
&
mapped
.
schema
.
example
?~
toJSON
hyperdataCorpus
instance
ToSchema
HyperdataAnnuaire
where
declareNamedSchema
proxy
=
genericDeclareNamedSchema
defaultSchemaOptions
proxy
L
.&
mapped
.
schema
.
description
?~
"an annuaire"
L
.&
mapped
.
schema
.
example
?~
toJSON
hyperdataAnnuaire
&
mapped
.
schema
.
description
?~
"an annuaire"
&
mapped
.
schema
.
example
?~
toJSON
hyperdataAnnuaire
instance
ToSchema
HyperdataDocument
where
declareNamedSchema
proxy
=
genericDeclareNamedSchema
defaultSchemaOptions
proxy
L
.&
mapped
.
schema
.
description
?~
"a document"
L
.&
mapped
.
schema
.
example
?~
toJSON
hyperdataDocument
&
mapped
.
schema
.
description
?~
"a document"
&
mapped
.
schema
.
example
?~
toJSON
hyperdataDocument
instance
ToSchema
HyperdataAny
where
declareNamedSchema
proxy
=
pure
$
genericNameSchema
defaultSchemaOptions
proxy
mempty
L
.
&
schema
.
description
?~
"a node"
L
.
&
schema
.
example
?~
emptyObject
-- TODO
&
schema
.
description
?~
"a node"
&
schema
.
example
?~
emptyObject
-- TODO
instance
ToSchema
hyperdata
=>
...
...
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