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

   1 {-|
   2 Module      : Gargantext.Database.Select.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 FunctionalDependencies #-}
  18 {-# LANGUAGE QuasiQuotes            #-}
  19 {-# LANGUAGE TemplateHaskell        #-}
  20
  21 module Gargantext.Database.Query.Table.NodeNode
  22   ( module Gargantext.Database.Schema.NodeNode
  23   , queryNodeNodeTable
  24   , selectDocsDates
  25   , selectDocNodes
  26   , selectDocs
  27   , nodeNodesCategory
  28   , nodeNodesScore
  29   , getNodeNode
  30   , insertNodeNode
  31   , deleteNodeNode
  32   , selectPublicNodes
  33   , selectCountDocs
  34   )
  35   where
  36
  37 import Control.Arrow (returnA)
  38 import Control.Lens (view, (^.))
  39 import Data.Maybe (catMaybes)
  40 import Data.Text (Text, splitOn)
  41 import Database.PostgreSQL.Simple.SqlQQ (sql)
  42 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
  43 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
  44 import qualified Opaleye as O
  45 import Opaleye
  46
  47 import Gargantext.Core
  48 import Gargantext.Core.Types
  49 import Gargantext.Database.Schema.NodeNode
  50 import Gargantext.Database.Admin.Types.Hyperdata
  51 import Gargantext.Database.Prelude
  52 import Gargantext.Database.Schema.Node
  53 import Gargantext.Prelude
  54
  55
  56 queryNodeNodeTable :: Select NodeNodeRead
  57 queryNodeNodeTable = selectTable nodeNodeTable
  58
  59 -- | not optimized (get all ngrams without filters)
  60 _nodesNodes :: Cmd err [NodeNode]
  61 _nodesNodes = runOpaQuery queryNodeNodeTable
  62
  63 ------------------------------------------------------------------------
  64 -- | Basic NodeNode tools
  65 getNodeNode :: NodeId -> Cmd err [NodeNode]
  66 getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
  67   where
  68     selectNodeNode :: Column SqlInt4 -> Select NodeNodeRead
  69     selectNodeNode n' = proc () -> do
  70       ns <- queryNodeNodeTable -< ()
  71       restrict -< _nn_node1_id ns .== n'
  72       returnA -< ns
  73
  74 ------------------------------------------------------------------------
  75 -- TODO (refactor with Children)
  76 {-
  77 getNodeNodeWith :: NodeId -> proxy a -> Maybe NodeType -> Cmd err [a]
  78 getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
  79   where
  80     query = selectChildren pId maybeNodeType
  81
  82     selectChildren :: ParentId
  83                    -> Maybe NodeType
  84                    -> Select NodeRead
  85     selectChildren parentId maybeNodeType = proc () -> do
  86         row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
  87         (NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< ()
  88
  89         let nodeType = maybe 0 toDBid maybeNodeType
  90         restrict -< typeName  .== sqlInt4 nodeType
  91
  92         restrict -< (.||) (parent_id .== (pgNodeId parentId))
  93                           ( (.&&) (n1id .== pgNodeId parentId)
  94                                   (n2id .== nId))
  95         returnA -< row
  96 -}
  97
  98 ------------------------------------------------------------------------
  99 insertNodeNode :: [NodeNode] -> Cmd err Int
 100 insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
 101                           $ Insert nodeNodeTable ns' rCount (Just DoNothing))
 102   where
 103     ns' :: [NodeNodeWrite]
 104     ns' = map (\(NodeNode n1 n2 x y)
 105                 -> NodeNode (pgNodeId n1)
 106                             (pgNodeId n2)
 107                             (sqlDouble <$> x)
 108                             (sqlInt4   <$> y)
 109               ) ns
 110
 111
 112
 113 ------------------------------------------------------------------------
 114 type Node1_Id = NodeId
 115 type Node2_Id = NodeId
 116
 117 deleteNodeNode :: Node1_Id -> Node2_Id -> Cmd err Int
 118 deleteNodeNode n1 n2 = mkCmd $ \conn ->
 119   fromIntegral <$> runDelete_ conn
 120                               (Delete nodeNodeTable
 121                                       (\(NodeNode n1_id n2_id _ _) -> n1_id .== pgNodeId n1
 122                                                                   .&& n2_id .== pgNodeId n2
 123                                       )
 124                                       rCount
 125                               )
 126
 127 ------------------------------------------------------------------------
 128 -- | Favorite management
 129 _nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
 130 _nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favSelect (c,cId,dId)
 131   where
 132     favSelect :: PGS.Query
 133     favSelect = [sql|UPDATE nodes_nodes SET category = ?
 134                WHERE node1_id = ? AND node2_id = ?
 135                RETURNING node2_id;
 136                |]
 137
 138 nodeNodesCategory :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
 139 nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
 140                             <$> runPGSQuery catSelect (PGS.Only $ Values fields inputData)
 141   where
 142     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
 143     catSelect :: PGS.Query
 144     catSelect = [sql| UPDATE nodes_nodes as nn0
 145                       SET category = nn1.category
 146                        FROM (?) as nn1(node1_id,node2_id,category)
 147                        WHERE nn0.node1_id = nn1.node1_id
 148                        AND   nn0.node2_id = nn1.node2_id
 149                        RETURNING nn1.node2_id
 150                   |]
 151
 152 ------------------------------------------------------------------------
 153 -- | Score management
 154 _nodeNodeScore :: CorpusId -> DocId -> Int -> Cmd err [Int]
 155 _nodeNodeScore cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery scoreSelect (c,cId,dId)
 156   where
 157     scoreSelect :: PGS.Query
 158     scoreSelect = [sql|UPDATE nodes_nodes SET score = ?
 159                   WHERE node1_id = ? AND node2_id = ?
 160                   RETURNING node2_id;
 161                   |]
 162
 163 nodeNodesScore :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
 164 nodeNodesScore inputData = map (\(PGS.Only a) -> a)
 165                             <$> runPGSQuery catScore (PGS.Only $ Values fields inputData)
 166   where
 167     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
 168     catScore :: PGS.Query
 169     catScore = [sql| UPDATE nodes_nodes as nn0
 170                       SET score = nn1.score
 171                        FROM (?) as nn1(node1_id, node2_id, score)
 172                        WHERE nn0.node1_id = nn1.node1_id
 173                        AND   nn0.node2_id = nn1.node2_id
 174                        RETURNING nn1.node2_id
 175                   |]
 176
 177 ------------------------------------------------------------------------
 178 selectCountDocs :: HasDBid NodeType => CorpusId -> Cmd err Int
 179 selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
 180   where
 181     queryCountDocs cId' = proc () -> do
 182       (n, nn) <- joinInCorpus -< ()
 183       restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId')
 184       restrict -< nn^.nn_category  .>= (toNullable $ sqlInt4 1)
 185       restrict -< n^.node_typename .== (sqlInt4 $ toDBid NodeDocument)
 186       returnA -< n
 187
 188
 189
 190
 191 -- | TODO use UTCTime fast
 192 selectDocsDates :: HasDBid NodeType => CorpusId -> Cmd err [Text]
 193 selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
 194                    <$> catMaybes
 195                    <$> map (view hd_publication_date)
 196                    <$> selectDocs cId
 197
 198 selectDocs :: HasDBid NodeType => CorpusId -> Cmd err [HyperdataDocument]
 199 selectDocs cId = runOpaQuery (queryDocs cId)
 200
 201 queryDocs :: HasDBid NodeType => CorpusId -> O.Select (Column SqlJsonb)
 202 queryDocs cId = proc () -> do
 203   (n, nn) <- joinInCorpus -< ()
 204   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 205   restrict -< nn^.nn_category  .>= (toNullable $ sqlInt4 1)
 206   restrict -< n^.node_typename .== (sqlInt4 $ toDBid NodeDocument)
 207   returnA -< view (node_hyperdata) n
 208
 209 selectDocNodes :: HasDBid NodeType =>CorpusId -> Cmd err [Node HyperdataDocument]
 210 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 211
 212 queryDocNodes :: HasDBid NodeType =>CorpusId -> O.Select NodeRead
 213 queryDocNodes cId = proc () -> do
 214   (n, nn) <- joinInCorpus -< ()
 215   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 216   restrict -< nn^.nn_category  .>= (toNullable $ sqlInt4 1)
 217   restrict -< n^.node_typename .== (sqlInt4 $ toDBid NodeDocument)
 218   returnA -<  n
 219
 220 joinInCorpus :: O.Select (NodeRead, NodeNodeReadNull)
 221 joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
 222   where
 223     cond :: (NodeRead, NodeNodeRead) -> Column SqlBool
 224     cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
 225
 226 joinOn1 :: O.Select (NodeRead, NodeNodeReadNull)
 227 joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond
 228   where
 229     cond :: (NodeRead, NodeNodeRead) -> Column SqlBool
 230     cond (n, nn) = nn^.nn_node1_id .== n^.node_id
 231
 232
 233 ------------------------------------------------------------------------
 234 selectPublicNodes :: HasDBid NodeType => (Hyperdata a, DefaultFromField SqlJsonb a)
 235                   => Cmd err [(Node a, Maybe Int)]
 236 selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
 237
 238 queryWithType :: HasDBid NodeType =>NodeType -> O.Select (NodeRead, Column (Nullable SqlInt4))
 239 queryWithType nt = proc () -> do
 240   (n, nn) <- joinOn1 -< ()
 241   restrict -< n^.node_typename .== (sqlInt4 $ toDBid nt)
 242   returnA  -<  (n, nn^.nn_node2_id)
 243