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