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