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