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