]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Node/Document/Add.hs
Merge branch 'dev' into dev-phylo
[gargantext.git] / src / Gargantext / Database / Node / Document / Add.hs
1 {-|
2 Module : Gargantext.Database.Node.Document.Add
3 Description : Importing context of texts (documents)
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10 Add Documents/Contact to a Corpus/Annuaire.
11
12 -}
13 ------------------------------------------------------------------------
14 {-# LANGUAGE DeriveDataTypeable #-}
15 {-# LANGUAGE DeriveGeneric #-}
16 {-# LANGUAGE FlexibleInstances #-}
17 {-# LANGUAGE NoImplicitPrelude #-}
18 {-# LANGUAGE OverloadedStrings #-}
19 {-# LANGUAGE QuasiQuotes #-}
20 {-# LANGUAGE RankNTypes #-}
21 {-# LANGUAGE TypeSynonymInstances #-}
22 ------------------------------------------------------------------------
23 module Gargantext.Database.Node.Document.Add where
24
25
26 import Data.ByteString.Internal (ByteString)
27 import Data.Typeable (Typeable)
28 import Database.PostgreSQL.Simple (Query, Only(..))
29 import Database.PostgreSQL.Simple.SqlQQ
30 import Database.PostgreSQL.Simple.ToField (toField)
31 import Database.PostgreSQL.Simple.ToRow (ToRow(..))
32 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
33
34 import Data.Text (Text)
35
36 import Gargantext.Database.Utils (Cmd, runPGSQuery, formatPGSQuery)
37 import Gargantext.Database.Types.Node
38 import Gargantext.Prelude
39
40 import GHC.Generics (Generic)
41 ---------------------------------------------------------------------------
42
43 add :: ParentId -> [NodeId] -> Cmd err [Only Int]
44 add pId ns = runPGSQuery queryAdd (Only $ Values fields inputData)
45 where
46 fields = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
47 inputData = prepare pId ns
48
49 add_debug :: ParentId -> [NodeId] -> Cmd err ByteString
50 add_debug pId ns = formatPGSQuery queryAdd (Only $ Values fields inputData)
51 where
52 fields = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
53 inputData = prepare pId ns
54
55
56 -- | Input Tables: types of the tables
57 inputSqlTypes :: [Text]
58 inputSqlTypes = ["int4","int4","int4"]
59
60 -- | SQL query to add documents
61 -- TODO return id of added documents only
62 queryAdd :: Query
63 queryAdd = [sql|
64 WITH input_rows(node1_id,node2_id,category) AS (?)
65 INSERT INTO nodes_nodes (node1_id, node2_id,category)
66 SELECT * FROM input_rows
67 ON CONFLICT (node1_id, node2_id) DO NOTHING -- on unique index
68 RETURNING 1
69 ;
70 |]
71
72 prepare :: ParentId -> [NodeId] -> [InputData]
73 prepare pId ns = map (\nId -> InputData pId nId) ns
74
75 ------------------------------------------------------------------------
76 -- * Main Types used
77
78 data InputData = InputData { inNode1_id :: NodeId
79 , inNode2_id :: NodeId
80 } deriving (Show, Generic, Typeable)
81
82 instance ToRow InputData where
83 toRow inputData = [ toField (inNode1_id inputData)
84 , toField (inNode2_id inputData)
85 , toField (1 :: Int)
86 ]
87