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 DeriveGeneric        #-}
  15 {-# LANGUAGE NoImplicitPrelude    #-}
  16 {-# LANGUAGE QuasiQuotes          #-}
  17 {-# LANGUAGE DeriveDataTypeable   #-}
  18 {-# LANGUAGE FlexibleInstances    #-}
  19 {-# LANGUAGE TypeSynonymInstances #-}
  20 ------------------------------------------------------------------------
  21 module Gargantext.Database.Node.Document.Add where
  22
  23 import Control.Lens (set)
  24
  25 import Data.Aeson (toJSON, Value)
  26 import Data.ByteString.Internal (ByteString)
  27 import Data.Maybe (maybe)
  28 import Data.Typeable (Typeable)
  29 import Database.PostgreSQL.Simple (Connection, FromRow, Query, formatQuery, query, Only(..))
  30 import Database.PostgreSQL.Simple.FromRow (fromRow, field)
  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 import qualified Data.Text                   as DT (pack, unpack, concat)
  38 import qualified Data.Digest.Pure.SHA        as SHA (sha256, showDigest)
  39 import qualified Data.ByteString.Lazy.Char8  as DC (pack)
  40
  41 import Gargantext.Database.Config (nodeTypeId)
  42 import Gargantext.Database.Node (mkCmd, Cmd(..))
  43 import Gargantext.Database.Types.Node
  44 import Gargantext.Prelude
  45
  46 import GHC.Generics (Generic)
  47 ---------------------------------------------------------------------------
  48
  49 type ParentId = Int
  50
  51 add :: ParentId -> [NodeId] -> Cmd [Only Int]
  52 add pId ns = mkCmd $ \c -> query c queryAdd (Only $ Values fields inputData)
  53   where
  54     fields    = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
  55     inputData = prepare pId ns
  56
  57 add_debug :: ParentId -> [NodeId] -> Cmd ByteString
  58 add_debug pId ns = mkCmd $ \c -> formatQuery c queryAdd (Only $ Values fields inputData)
  59   where
  60     fields    = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
  61     inputData = prepare pId ns
  62
  63
  64
  65 -- | Input Tables: types of the tables
  66 inputSqlTypes :: [Text]
  67 inputSqlTypes = map DT.pack ["int4","int4"]
  68
  69 -- | SQL query to add documents
  70 -- TODO return id of added documents only
  71 queryAdd :: Query
  72 queryAdd = [sql|
  73        WITH input_rows(node1_id,node2_id) AS (?)
  74        INSERT INTO nodes_nodes (node1_id, node2_id)
  75        SELECT * FROM input_rows
  76        ON CONFLICT (node1_id, node2_id) DO NOTHING -- on unique index
  77        RETURNING 1
  78        ;
  79            |]
  80
  81 prepare :: ParentId -> [NodeId] -> [InputData]
  82 prepare pId ns = map (\nId -> InputData pId nId) ns
  83
  84 ------------------------------------------------------------------------
  85 -- * Main Types used
  86
  87
  88 data InputData = InputData { inNode1_id :: NodeId
  89                            , inNode2_id :: NodeId
  90                            } deriving (Show, Generic, Typeable)
  91
  92 instance ToRow InputData where
  93   toRow inputData = [ toField (inNode1_id inputData)
  94                     , toField (inNode2_id inputData)
  95                     ]
  96