src/Gargantext/Database/Query/Table/NodeNode.hs

   1 {-|
   2 Module      : Gargantext.Database.Query.Table.NodeNode
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 Here is a longer description of this module, containing some
  11 commentary with @some markup@.
  12 -}
  13
  14 {-# OPTIONS_GHC -fno-warn-orphans #-}
  15
  16 {-# LANGUAGE Arrows                 #-}
  17 {-# LANGUAGE FlexibleContexts       #-}
  18 {-# LANGUAGE FlexibleInstances      #-}
  19 {-# LANGUAGE FunctionalDependencies #-}
  20 {-# LANGUAGE QuasiQuotes            #-}
  21 {-# LANGUAGE MultiParamTypeClasses  #-}
  22 {-# LANGUAGE NoImplicitPrelude      #-}
  23 {-# LANGUAGE OverloadedStrings      #-}
  24 {-# LANGUAGE RankNTypes             #-}
  25 {-# LANGUAGE TemplateHaskell        #-}
  26
  27 module Gargantext.Database.Query.Table.NodeNode where
  28
  29 import Control.Arrow (returnA)
  30 import Control.Lens (view, (^.))
  31 import Data.Maybe (catMaybes)
  32 import Data.Text (Text, splitOn)
  33 import Database.PostgreSQL.Simple.SqlQQ (sql)
  34 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
  35 import Gargantext.Core.Types
  36 import Gargantext.Database.Schema.NodeNode
  37 import Gargantext.Database.Admin.Types.Node (pgNodeId)
  38 import Gargantext.Database.Admin.Config (nodeTypeId)
  39 import Gargantext.Database.Admin.Types.Node (CorpusId, DocId)
  40 import Gargantext.Database.Admin.Utils
  41 import Gargantext.Database.Schema.Node
  42 import Gargantext.Prelude
  43 import Opaleye
  44 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
  45 import qualified Opaleye as O
  46
  47 ------------------------------------------------------------------------
  48 -- | Basic NodeNode tools
  49 getNodeNode :: NodeId -> Cmd err [NodeNode]
  50 getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
  51   where
  52     selectNodeNode :: Column PGInt4 -> Query NodeNodeRead
  53     selectNodeNode n' = proc () -> do
  54       ns <- queryNodeNodeTable -< ()
  55       restrict -< _nn_node1_id ns .== n'
  56       returnA -< ns
  57
  58 -------------------------
  59 insertNodeNode :: [NodeNode] -> Cmd err Int64
  60 insertNodeNode ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeNodeTable ns' rCount Nothing
  61   where
  62     ns' :: [NodeNodeWrite]
  63     ns' = map (\(NodeNode n1 n2 x y)
  64                 -> NodeNode (pgNodeId n1)
  65                             (pgNodeId n2)
  66                             (pgDouble <$> x)
  67                             (pgInt4   <$> y)
  68               ) ns
  69
  70
  71 -- | Favorite management
  72 nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
  73 nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
  74   where
  75     favQuery :: PGS.Query
  76     favQuery = [sql|UPDATE nodes_nodes SET category = ?
  77                WHERE node1_id = ? AND node2_id = ?
  78                RETURNING node2_id;
  79                |]
  80
  81 nodeNodesCategory :: [(CorpusId,DocId,Int)] -> Cmd err [Int]
  82 nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
  83                             <$> runPGSQuery catQuery (PGS.Only $ Values fields inputData)
  84   where
  85     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
  86     catQuery :: PGS.Query
  87     catQuery = [sql| UPDATE nodes_nodes as nn0
  88                       SET category = nn1.category
  89                        FROM (?) as nn1(node1_id,node2_id,category)
  90                        WHERE nn0.node1_id = nn1.node1_id
  91                        AND   nn0.node2_id = nn1.node2_id
  92                        RETURNING nn1.node2_id
  93                   |]
  94
  95 ------------------------------------------------------------------------
  96 -- | TODO use UTCTime fast
  97 selectDocsDates :: CorpusId -> Cmd err [Text]
  98 selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
  99                    <$> catMaybes
 100                    <$> map (view hyperdataDocument_publication_date)
 101                    <$> selectDocs cId
 102
 103 selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
 104 selectDocs cId = runOpaQuery (queryDocs cId)
 105
 106 queryDocs :: CorpusId -> O.Query (Column PGJsonb)
 107 queryDocs cId = proc () -> do
 108   (n, nn) <- joinInCorpus -< ()
 109   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 110   restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
 111   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
 112   returnA -< view (node_hyperdata) n
 113
 114 selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument]
 115 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 116
 117 queryDocNodes :: CorpusId -> O.Query NodeRead
 118 queryDocNodes cId = proc () -> do
 119   (n, nn) <- joinInCorpus -< ()
 120   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 121   restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
 122   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
 123   returnA -<  n
 124
 125 joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
 126 joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
 127   where
 128     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
 129     cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
 130
 131 ------------------------------------------------------------------------
 132 -- | Trash management
 133 nodeToTrash :: CorpusId -> DocId -> Bool -> Cmd err [PGS.Only Int]
 134 nodeToTrash cId dId b = runPGSQuery trashQuery (b,cId,dId)
 135   where
 136     trashQuery :: PGS.Query
 137     trashQuery = [sql|UPDATE nodes_nodes SET delete = ?
 138                   WHERE node1_id = ? AND node2_id = ?
 139                   RETURNING node2_id
 140                   |]
 141
 142 -- | Trash Massive
 143 nodesToTrash :: [(CorpusId,DocId,Bool)] -> Cmd err [Int]
 144 nodesToTrash input = map (\(PGS.Only a) -> a)
 145                         <$> runPGSQuery trashQuery (PGS.Only $ Values fields input)
 146   where
 147     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","bool"]
 148     trashQuery :: PGS.Query
 149     trashQuery = [sql| UPDATE nodes_nodes as nn0 SET
 150                  delete = nn1.delete
 151                  from (?) as nn1(node1_id,node2_id,delete)
 152                  WHERE nn0.node1_id = nn1.node1_id
 153                  AND   nn0.node2_id = nn1.node2_id
 154                  RETURNING nn1.node2_id
 155                   |]
 156
 157 -- | /!\ Really remove nodes in the Corpus or Annuaire
 158 emptyTrash :: CorpusId -> Cmd err [PGS.Only Int]
 159 emptyTrash cId = runPGSQuery delQuery (PGS.Only cId)
 160   where
 161     delQuery :: PGS.Query
 162     delQuery = [sql|DELETE from nodes_nodes n
 163                     WHERE n.node1_id = ?
 164                       AND n.delete = true
 165                     RETURNING n.node2_id
 166                 |]
 167 ------------------------------------------------------------------------