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
c9d2df42
Commit
c9d2df42
authored
Oct 13, 2018
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[BASHQL] rename + mv.
parent
233539c3
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
44 additions
and
69 deletions
+44
-69
Bashql.hs
src/Gargantext/Database/Bashql.hs
+26
-49
Import.hs
src/Gargantext/Database/Node/Document/Import.hs
+7
-8
TextSearch.hs
src/Gargantext/Database/TextSearch.hs
+11
-12
No files found.
src/Gargantext/Database/Bashql.hs
View file @
c9d2df42
...
...
@@ -60,37 +60,48 @@ AMS, and by SIAM.
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
module
Gargantext.Database.Bashql
(
get
,
get'
,
ls
,
ls'
,
home
,
home'
,
post
,
post'
,
del
,
del'
,
tree
,
tree'
,
postCorpus
,
postAnnuaire
module
Gargantext.Database.Bashql
(
get
,
ls
,
home
,
post
,
del
,
mv
,
put
,
rename
,
tree
,
mkCorpus
,
postAnnuaire
,
runCmd'
)
where
import
Control.Monad.Reader
-- (Reader, ask)
import
Data.Text
(
Text
,
pack
)
import
Data.Text
(
Text
)
import
Data.Aeson
import
Data.Aeson.Types
import
Data.List
(
last
,
concat
)
import
Database.PostgreSQL.Simple
(
Only
)
import
Gargantext.Core.Types
import
Gargantext.Database.Utils
(
connectGargandb
)
import
Gargantext.Database.Node
import
qualified
Gargantext.Database.Node.Update
as
U
(
Update
(
..
),
update
)
import
Gargantext.Prelude
import
Opaleye
hiding
(
FromField
)
--type UserId = Int
--type NodeId = Int
-- List of NodeId
-- type PWD a = PWD UserId [a]
type
PWD
=
[
NodeId
]
--data PWD' a = a | PWD' [a]
rename
::
NodeId
->
Text
->
Cmd
[
Only
Int
]
rename
n
t
=
mkCmd
$
\
conn
->
U
.
update
(
U
.
Rename
n
t
)
conn
mv
::
NodeId
->
ParentId
->
Cmd
[
Only
Int
]
mv
n
p
=
mkCmd
$
\
conn
->
U
.
update
(
U
.
Move
n
p
)
conn
-- | TODO get Children or Node
get
::
PWD
->
Cmd
[
Node
Value
]
get
[]
=
pure
[]
...
...
@@ -129,8 +140,8 @@ del [] = pure 0
del
ns
=
deleteNodes
ns
-- | TODO
--put :: Connection -> PWD -> [a] -> IO Int64
--put = undefined
put
::
U
.
Update
->
Cmd
[
Only
Int
]
put
u
=
mkCmd
$
U
.
update
u
-- | TODO
-- cd (Home UserId) | (Node NodeId)
...
...
@@ -140,8 +151,8 @@ del ns = deleteNodes ns
type
CorpusName
=
Text
post
Corpus
::
ToJSON
a
=>
CorpusName
->
(
a
->
Text
)
->
[
a
]
->
Cmd
NewNode
post
Corpus
corpusName
title
ns
=
do
mk
Corpus
::
ToJSON
a
=>
CorpusName
->
(
a
->
Text
)
->
[
a
]
->
Cmd
NewNode
mk
Corpus
corpusName
title
ns
=
do
pid
<-
last
<$>
home
let
uid
=
1
postNode
uid
pid
(
Node'
NodeCorpus
corpusName
emptyObject
...
...
@@ -160,46 +171,12 @@ postAnnuaire corpusName title ns = do
)
--------------------------------------------------------------
-- Tests
--------------------------------------------------------------
get'
::
PWD
->
IO
[
Node
Value
]
get'
=
runCmd'
.
get
home'
::
IO
PWD
home'
=
runCmd'
home
ls'
::
IO
[
Node
Value
]
ls'
=
runCmd'
$
do
h
<-
home
ls
h
tree'
::
IO
[
Node
Value
]
tree'
=
runCmd'
$
do
h
<-
home
tree
h
post'
::
IO
NewNode
post'
=
runCmd'
$
do
pid
<-
last
<$>
home
let
uid
=
1
postNode
uid
pid
(
Node'
NodeCorpus
(
pack
"Premier corpus"
)
emptyObject
[
Node'
Document
(
pack
"Doc1"
)
emptyObject
[]
,
Node'
Document
(
pack
"Doc2"
)
emptyObject
[]
,
Node'
Document
(
pack
"Doc3"
)
emptyObject
[]
]
)
-- |
-- myCorpus <- Prelude.map doc2hyperdataDocument <$> toDocs <$> snd <$> readCsv "doc/corpus_imt/Gargantext_Corpus_small.csv"
-- There is an error in the CSV parsing...
-- let myCorpus' = Prelude.filter (\n -> T.length (maybe "" identity (hyperdataDocument_title n)) > 30) myCorpus
del'
::
[
NodeId
]
->
IO
Int
del'
ns
=
runCmd'
$
del
ns
-- corporaOf :: Username -> IO [Corpus]
runCmd'
::
Cmd
a
->
IO
a
runCmd'
f
=
do
c
<-
connectGargandb
"gargantext.ini"
runCmd
c
f
runCmd'
f
=
connectGargandb
"gargantext.ini"
>>=
\
c
->
runCmd
c
f
src/Gargantext/Database/Node/Document/Import.hs
View file @
c9d2df42
...
...
@@ -41,6 +41,12 @@ instance).
- Hash policy: this UniqId is a sha256 uniq id which is the result of
the concatenation of the parameters defined by @hashParameters@.
> -- * Example
> insertTest :: FromRow r => CorpusId -> [Node HyperdataDocument] -> IO [r]
> insertTest :: IO [ReturnId]
> insertTest = connectGargandb "gargantext.ini"
> >>= \conn -> insertDocuments conn 1 452162 hyperdataDocuments
-}
------------------------------------------------------------------------
{-# LANGUAGE DeriveGeneric #-}
...
...
@@ -71,10 +77,9 @@ import qualified Data.Text as DT (pack, unpack, concat)
import
qualified
Data.Digest.Pure.SHA
as
SHA
(
sha256
,
showDigest
)
import
qualified
Data.ByteString.Lazy.Char8
as
DC
(
pack
)
import
Gargantext
(
connectGargandb
)
import
Gargantext.Database.Config
(
nodeTypeId
)
import
Gargantext.Database.Types.Node
--
FIXME
: the import of Document constructor below does not work
--
TODO
: the import of Document constructor below does not work
-- import Gargantext.Database.Types.Node (Document)
--import Gargantext.Database.Types.Node (docExample, hyperdataDocument, HyperdataDocument(..)
-- , hyperdataDocument_uniqId
...
...
@@ -204,10 +209,4 @@ addUniqId doc = set hyperdataDocument_uniqId (Just hash) doc
uniqId
=
DT
.
pack
.
SHA
.
showDigest
.
SHA
.
sha256
.
DC
.
pack
.
DT
.
unpack
---------------------------------------------------------------------------
-- * Tests
--insertTest :: FromRow r => CorpusId -> [Node HyperdataDocument] -> IO [r]
insertTest
::
IO
[
ReturnId
]
insertTest
=
connectGargandb
"gargantext.ini"
>>=
\
conn
->
insertDocuments
conn
1
452162
hyperdataDocuments
src/Gargantext/Database/TextSearch.hs
View file @
c9d2df42
...
...
@@ -7,8 +7,7 @@ Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Here is a longer description of this module, containing some
commentary with @some markup@.
-}
{-# LANGUAGE NoImplicitPrelude #-}
...
...
@@ -33,6 +32,7 @@ import Gargantext.Prelude
newtype
TSQuery
=
UnsafeTSQuery
[
Text
]
-- | TODO [""] -> panic "error"
toTSQuery
::
[
Text
]
->
TSQuery
toTSQuery
txt
=
UnsafeTSQuery
txt
...
...
@@ -66,20 +66,19 @@ instance ToField Order
-- ADD ngrams count
-- TESTS
textSearchQuery
::
Query
textSearchQuery
=
"SELECT n.id, n.hyperdata->'publication_year'
\
textSearchQuery
=
"SELECT n.id, n.hyperdata->'publication_year'
\
\
, n.hyperdata->'title'
\
\
, n.hyperdata->'source'
\
\
, n.hyperdata->'authors'
\
\
, COALESCE(nn.score,null)
\
\
FROM nodes n
\
\
LEFT JOIN nodes_nodes nn ON nn.node2_id = n.id
\
\
WHERE
\
\
n.
title_abstract @@ (?::tsquery)
\
\
AND n.parent_id = ? AND n.typename = 40
\
\
ORDER BY n.hyperdata -> 'publication_date' ?
\
\
, n.hyperdata->'authors'
\
\
, COALESCE(nn.score,null)
\
\
FROM nodes n
\
\
LEFT JOIN nodes_nodes nn ON nn.node2_id = n.id
\
\
WHERE
\
\
n.
search @@ (?::tsquery)
\
\
AND n.parent_id = ? AND n.typename = 40
\
\
ORDER BY n.hyperdata -> 'publication_date' ?
\
\
offset ? limit ?;"
textSearch
::
Connection
->
TSQuery
->
ParentId
->
Limit
->
Offset
->
Order
...
...
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