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