]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Query/Table/Node/Document/Add.hs
fix
[gargantext.git] / src / Gargantext / Database / Query / Table / 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 QuasiQuotes #-}
16 {-# LANGUAGE TypeSynonymInstances #-}
17
18 ------------------------------------------------------------------------
19 module Gargantext.Database.Query.Table.Node.Document.Add
20 where
21
22 import Data.ByteString.Internal (ByteString)
23 import Data.Text (Text)
24 import Data.Typeable (Typeable)
25 import Database.PostgreSQL.Simple (Query, Only(..))
26 import Database.PostgreSQL.Simple.SqlQQ
27 import Database.PostgreSQL.Simple.ToField (toField)
28 import Database.PostgreSQL.Simple.ToRow (ToRow(..))
29 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
30 import GHC.Generics (Generic)
31 import Gargantext.Database.Admin.Types.Node
32 import Gargantext.Database.Prelude (Cmd, runPGSQuery, formatPGSQuery)
33 import Gargantext.Prelude
34
35 ---------------------------------------------------------------------------
36
37 add :: ParentId -> [NodeId] -> Cmd err [Only Int]
38 add pId ns = runPGSQuery queryAdd (Only $ Values fields inputData)
39 where
40 fields = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
41 inputData = prepare pId ns
42
43 add_debug :: ParentId -> [NodeId] -> Cmd err ByteString
44 add_debug pId ns = formatPGSQuery queryAdd (Only $ Values fields inputData)
45 where
46 fields = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
47 inputData = prepare pId ns
48
49
50 -- | Input Tables: types of the tables
51 inputSqlTypes :: [Text]
52 inputSqlTypes = ["int4","int4","int4"]
53
54 -- | SQL query to add documents
55 -- TODO return id of added documents only
56 queryAdd :: Query
57 queryAdd = [sql|
58 WITH input_rows(node1_id,node2_id,category) AS (?)
59 INSERT INTO nodes_nodes (node1_id, node2_id,category)
60 SELECT * FROM input_rows
61 ON CONFLICT (node1_id, node2_id) DO NOTHING -- on unique index
62 RETURNING 1
63 ;
64 |]
65
66 prepare :: ParentId -> [NodeId] -> [InputData]
67 prepare pId ns = map (\nId -> InputData pId nId) ns
68
69 ------------------------------------------------------------------------
70 -- * Main Types used
71
72 data InputData = InputData { inNode1_id :: NodeId
73 , inNode2_id :: NodeId
74 } deriving (Show, Generic, Typeable)
75
76 instance ToRow InputData where
77 toRow inputData = [ toField (inNode1_id inputData)
78 , toField (inNode2_id inputData)
79 , toField (1 :: Int)
80 ]
81