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

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