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