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