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
Show 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.
...
@@ -60,37 +60,48 @@ AMS, and by SIAM.
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts #-}
module
Gargantext.Database.Bashql
(
get
,
get'
module
Gargantext.Database.Bashql
(
get
,
ls
,
ls'
,
ls
,
home
,
home'
,
home
,
post
,
post'
,
post
,
del
,
del'
,
del
,
tree
,
tree'
,
mv
,
postCorpus
,
postAnnuaire
,
put
,
rename
,
tree
,
mkCorpus
,
postAnnuaire
,
runCmd'
)
)
where
where
import
Control.Monad.Reader
-- (Reader, ask)
import
Control.Monad.Reader
-- (Reader, ask)
import
Data.Text
(
Text
,
pack
)
import
Data.Text
(
Text
)
import
Data.Aeson
import
Data.Aeson
import
Data.Aeson.Types
import
Data.Aeson.Types
import
Data.List
(
last
,
concat
)
import
Data.List
(
last
,
concat
)
import
Database.PostgreSQL.Simple
(
Only
)
import
Gargantext.Core.Types
import
Gargantext.Core.Types
import
Gargantext.Database.Utils
(
connectGargandb
)
import
Gargantext.Database.Utils
(
connectGargandb
)
import
Gargantext.Database.Node
import
Gargantext.Database.Node
import
qualified
Gargantext.Database.Node.Update
as
U
(
Update
(
..
),
update
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Opaleye
hiding
(
FromField
)
import
Opaleye
hiding
(
FromField
)
--type UserId = Int
--type NodeId = Int
-- List of NodeId
-- List of NodeId
-- type PWD a = PWD UserId [a]
-- type PWD a = PWD UserId [a]
type
PWD
=
[
NodeId
]
type
PWD
=
[
NodeId
]
--data PWD' a = a | PWD' [a]
--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
-- | TODO get Children or Node
get
::
PWD
->
Cmd
[
Node
Value
]
get
::
PWD
->
Cmd
[
Node
Value
]
get
[]
=
pure
[]
get
[]
=
pure
[]
...
@@ -129,8 +140,8 @@ del [] = pure 0
...
@@ -129,8 +140,8 @@ del [] = pure 0
del
ns
=
deleteNodes
ns
del
ns
=
deleteNodes
ns
-- | TODO
-- | TODO
--put :: Connection -> PWD -> [a] -> IO Int64
put
::
U
.
Update
->
Cmd
[
Only
Int
]
--put = undefined
put
u
=
mkCmd
$
U
.
update
u
-- | TODO
-- | TODO
-- cd (Home UserId) | (Node NodeId)
-- cd (Home UserId) | (Node NodeId)
...
@@ -140,8 +151,8 @@ del ns = deleteNodes ns
...
@@ -140,8 +151,8 @@ del ns = deleteNodes ns
type
CorpusName
=
Text
type
CorpusName
=
Text
post
Corpus
::
ToJSON
a
=>
CorpusName
->
(
a
->
Text
)
->
[
a
]
->
Cmd
NewNode
mk
Corpus
::
ToJSON
a
=>
CorpusName
->
(
a
->
Text
)
->
[
a
]
->
Cmd
NewNode
post
Corpus
corpusName
title
ns
=
do
mk
Corpus
corpusName
title
ns
=
do
pid
<-
last
<$>
home
pid
<-
last
<$>
home
let
uid
=
1
let
uid
=
1
postNode
uid
pid
(
Node'
NodeCorpus
corpusName
emptyObject
postNode
uid
pid
(
Node'
NodeCorpus
corpusName
emptyObject
...
@@ -160,46 +171,12 @@ postAnnuaire corpusName title ns = do
...
@@ -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"
-- myCorpus <- Prelude.map doc2hyperdataDocument <$> toDocs <$> snd <$> readCsv "doc/corpus_imt/Gargantext_Corpus_small.csv"
-- There is an error in the CSV parsing...
-- There is an error in the CSV parsing...
-- let myCorpus' = Prelude.filter (\n -> T.length (maybe "" identity (hyperdataDocument_title n)) > 30) myCorpus
-- 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]
-- corporaOf :: Username -> IO [Corpus]
runCmd'
::
Cmd
a
->
IO
a
runCmd'
::
Cmd
a
->
IO
a
runCmd'
f
=
do
runCmd'
f
=
connectGargandb
"gargantext.ini"
>>=
\
c
->
runCmd
c
f
c
<-
connectGargandb
"gargantext.ini"
runCmd
c
f
src/Gargantext/Database/Node/Document/Import.hs
View file @
c9d2df42
...
@@ -41,6 +41,12 @@ instance).
...
@@ -41,6 +41,12 @@ instance).
- Hash policy: this UniqId is a sha256 uniq id which is the result of
- Hash policy: this UniqId is a sha256 uniq id which is the result of
the concatenation of the parameters defined by @hashParameters@.
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 #-}
{-# LANGUAGE DeriveGeneric #-}
...
@@ -71,10 +77,9 @@ import qualified Data.Text as DT (pack, unpack, concat)
...
@@ -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.Digest.Pure.SHA
as
SHA
(
sha256
,
showDigest
)
import
qualified
Data.ByteString.Lazy.Char8
as
DC
(
pack
)
import
qualified
Data.ByteString.Lazy.Char8
as
DC
(
pack
)
import
Gargantext
(
connectGargandb
)
import
Gargantext.Database.Config
(
nodeTypeId
)
import
Gargantext.Database.Config
(
nodeTypeId
)
import
Gargantext.Database.Types.Node
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 (Document)
--import Gargantext.Database.Types.Node (docExample, hyperdataDocument, HyperdataDocument(..)
--import Gargantext.Database.Types.Node (docExample, hyperdataDocument, HyperdataDocument(..)
-- , hyperdataDocument_uniqId
-- , hyperdataDocument_uniqId
...
@@ -204,10 +209,4 @@ addUniqId doc = set hyperdataDocument_uniqId (Just hash) doc
...
@@ -204,10 +209,4 @@ addUniqId doc = set hyperdataDocument_uniqId (Just hash) doc
uniqId
=
DT
.
pack
.
SHA
.
showDigest
.
SHA
.
sha256
.
DC
.
pack
.
DT
.
unpack
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
...
@@ -7,8 +7,7 @@ Maintainer : team@gargantext.org
Stability : experimental
Stability : experimental
Portability : POSIX
Portability : POSIX
Here is a longer description of this module, containing some
commentary with @some markup@.
-}
-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoImplicitPrelude #-}
...
@@ -33,6 +32,7 @@ import Gargantext.Prelude
...
@@ -33,6 +32,7 @@ import Gargantext.Prelude
newtype
TSQuery
=
UnsafeTSQuery
[
Text
]
newtype
TSQuery
=
UnsafeTSQuery
[
Text
]
-- | TODO [""] -> panic "error"
toTSQuery
::
[
Text
]
->
TSQuery
toTSQuery
::
[
Text
]
->
TSQuery
toTSQuery
txt
=
UnsafeTSQuery
txt
toTSQuery
txt
=
UnsafeTSQuery
txt
...
@@ -74,12 +74,11 @@ textSearchQuery = "SELECT n.id, n.hyperdata->'publication_year' \
...
@@ -74,12 +74,11 @@ textSearchQuery = "SELECT n.id, n.hyperdata->'publication_year' \
\
FROM nodes n
\
\
FROM nodes n
\
\
LEFT JOIN nodes_nodes nn ON nn.node2_id = n.id
\
\
LEFT JOIN nodes_nodes nn ON nn.node2_id = n.id
\
\
WHERE
\
\
WHERE
\
\
n.
title_abstract @@ (?::tsquery)
\
\
n.
search @@ (?::tsquery)
\
\
AND n.parent_id = ? AND n.typename = 40
\
\
AND n.parent_id = ? AND n.typename = 40
\
\
ORDER BY n.hyperdata -> 'publication_date' ?
\
\
ORDER BY n.hyperdata -> 'publication_date' ?
\
\
offset ? limit ?;"
\
offset ? limit ?;"
textSearch
::
Connection
textSearch
::
Connection
->
TSQuery
->
ParentId
->
TSQuery
->
ParentId
->
Limit
->
Offset
->
Order
->
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