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