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

   1 {-|
   2 Module      : Gargantext.Database.Query.Table.NodeContext
   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.NodeContext
  22   ( module Gargantext.Database.Schema.NodeContext
  23   , queryNodeContextTable
  24   , selectDocsDates
  25   , selectDocNodes
  26   , selectDocs
  27   , nodeContextsCategory
  28   , nodeContextsScore
  29   , getNodeContexts
  30   , getNodeContext
  31   , updateNodeContextCategory
  32   , getContextsForNgrams
  33   , insertNodeContext
  34   , deleteNodeContext
  35   , selectPublicContexts
  36   , selectCountDocs
  37   )
  38   where
  39
  40 import Control.Arrow (returnA)
  41 import Control.Lens (view, (^.))
  42 import Data.Maybe (catMaybes)
  43 import Data.Time (UTCTime)
  44 import Data.Text (Text, splitOn)
  45 import Database.PostgreSQL.Simple.SqlQQ (sql)
  46 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
  47 import Opaleye
  48 import qualified Database.PostgreSQL.Simple as PGS (In(..), Query, Only(..))
  49 import qualified Opaleye as O
  50
  51 import Gargantext.Core
  52 import Gargantext.Core.Types
  53 -- import Gargantext.Core.Types.Search (HyperdataRow(..), toHyperdataRow)
  54 import Gargantext.Database.Admin.Types.Hyperdata
  55 import Gargantext.Database.Query.Table.Node.Error (HasNodeError, NodeError(DoesNotExist), nodeError)
  56 import Gargantext.Database.Prelude
  57 import Gargantext.Prelude.Crypto.Hash (Hash)
  58 import Gargantext.Database.Schema.Context
  59 import Gargantext.Database.Schema.Node
  60 import Gargantext.Database.Schema.NodeContext
  61 import Gargantext.Prelude
  62
  63 queryNodeContextTable :: Select NodeContextRead
  64 queryNodeContextTable = selectTable nodeContextTable
  65
  66 -- | not optimized (get all ngrams without filters)
  67 _nodesContexts :: Cmd err [NodeContext]
  68 _nodesContexts = runOpaQuery queryNodeContextTable
  69
  70 ------------------------------------------------------------------------
  71 -- | Basic NodeContext tools
  72 getNodeContexts :: NodeId -> Cmd err [NodeContext]
  73 getNodeContexts n = runOpaQuery (selectNodeContexts $ pgNodeId n)
  74   where
  75     selectNodeContexts :: Column SqlInt4 -> Select NodeContextRead
  76     selectNodeContexts n' = proc () -> do
  77       ns <- queryNodeContextTable -< ()
  78       restrict -< _nc_node_id ns .== n'
  79       returnA -< ns
  80
  81
  82 getNodeContext :: HasNodeError err => ContextId -> NodeId -> Cmd err NodeContext
  83 getNodeContext c n = do
  84   maybeNodeContext <- headMay <$> runOpaQuery (selectNodeContext (pgNodeId c) (pgNodeId n))
  85   case maybeNodeContext of
  86     Nothing -> nodeError (DoesNotExist c)
  87     Just  r -> pure r
  88   where
  89     selectNodeContext :: Column SqlInt4 -> Column SqlInt4 -> Select NodeContextRead
  90     selectNodeContext c' n' = proc () -> do
  91       ns <- queryNodeContextTable -< ()
  92       restrict -< _nc_context_id ns .== c'
  93       restrict -< _nc_node_id ns .== n'
  94       returnA -< ns
  95
  96 updateNodeContextCategory :: ContextId -> NodeId -> Int -> Cmd err Int64
  97 updateNodeContextCategory cId nId cat = do
  98   execPGSQuery upScore (cat, cId, nId)
  99   where
 100     upScore :: PGS.Query
 101     upScore = [sql| UPDATE nodes_contexts
 102                       SET category = ?
 103                       WHERE context_id = ?
 104                       AND node_id = ? |]
 105
 106 getContextsForNgrams :: HasNodeError err => NodeId -> [Int] -> Cmd err [(NodeId, Maybe Hash, NodeTypeId, UserId, Maybe ParentId, ContextTitle, UTCTime, HyperdataDocument)]
 107 getContextsForNgrams cId ngramsIds = runPGSQuery query (cId, PGS.In ngramsIds)
 108   where
 109     query :: PGS.Query
 110     query = [sql| SELECT contexts.id, hash_id, typename, user_id, parent_id, name, date, hyperdata
 111                   FROM contexts
 112                   JOIN context_node_ngrams ON contexts.id = context_node_ngrams.context_id
 113                   JOIN nodes_contexts ON contexts.id = nodes_contexts.context_id
 114                   WHERE nodes_contexts.node_id = ?
 115                    AND context_node_ngrams.ngrams_id IN ? |]
 116
 117 ------------------------------------------------------------------------
 118 insertNodeContext :: [NodeContext] -> Cmd err Int
 119 insertNodeContext ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
 120                           $ Insert nodeContextTable ns' rCount (Just DoNothing))
 121   where
 122     ns' :: [NodeContextWrite]
 123     ns' = map (\(NodeContext i n c x y)
 124                 -> NodeContext (sqlInt4 <$> i)
 125                                (pgNodeId n)
 126                                (pgNodeId c)
 127                                (sqlDouble <$> x)
 128                                (sqlInt4  <$> y)
 129               ) ns
 130
 131
 132 ------------------------------------------------------------------------
 133 type Node_Id    = NodeId
 134 type Context_Id = NodeId
 135
 136 deleteNodeContext :: Node_Id -> Context_Id -> Cmd err Int
 137 deleteNodeContext n c = mkCmd $ \conn ->
 138   fromIntegral <$> runDelete_ conn
 139                               (Delete nodeContextTable
 140                                       (\(NodeContext _ n_id c_id _ _) -> n_id .== pgNodeId n
 141                                                                    .&& c_id .== pgNodeId c
 142                                       )
 143                                       rCount
 144                               )
 145
 146 ------------------------------------------------------------------------
 147 -- | Favorite management
 148 nodeContextsCategory :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
 149 nodeContextsCategory inputData = map (\(PGS.Only a) -> a)
 150                             <$> runPGSQuery catSelect (PGS.Only $ Values fields inputData)
 151   where
 152     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
 153     catSelect :: PGS.Query
 154     catSelect = [sql| UPDATE nodes_contexts as nn0
 155                       SET category = nn1.category
 156                        FROM (?) as nn1(node_id,context_id,category)
 157                        WHERE nn0.node_id    = nn1.node_id
 158                        AND   nn0.context_id = nn1.context_id
 159                        RETURNING nn1.node_id
 160                   |]
 161
 162 ------------------------------------------------------------------------
 163 -- | Score management
 164 nodeContextsScore :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
 165 nodeContextsScore inputData = map (\(PGS.Only a) -> a)
 166                             <$> runPGSQuery catScore (PGS.Only $ Values fields inputData)
 167   where
 168     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
 169     catScore :: PGS.Query
 170     catScore = [sql| UPDATE nodes_contexts as nn0
 171                       SET score = nn1.score
 172                        FROM (?) as nn1(node_id, context_id, score)
 173                        WHERE nn0.node_id    = nn1.node_id
 174                        AND   nn0.context_id = nn1.context_id
 175                        RETURNING nn1.context_id
 176                   |]
 177
 178
 179 ------------------------------------------------------------------------
 180 selectCountDocs :: HasDBid NodeType => CorpusId -> Cmd err Int
 181 selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
 182   where
 183     queryCountDocs cId' = proc () -> do
 184       (c, nc) <- joinInCorpus -< ()
 185       restrict -< nc^.nc_node_id   .== (toNullable $ pgNodeId cId')
 186       restrict -< nc^.nc_category  .>= (toNullable $ sqlInt4 1)
 187       restrict -< c^.context_typename .== (sqlInt4 $ toDBid NodeDocument)
 188       returnA  -< c
 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   (c, nn)  <- joinInCorpus -< ()
 204   restrict -< nn^.nc_node_id      .== (toNullable $ pgNodeId cId)
 205   restrict -< nn^.nc_category     .>= (toNullable $ sqlInt4 1)
 206   restrict -< c^.context_typename .== (sqlInt4 $ toDBid NodeDocument)
 207   returnA  -< view (context_hyperdata) c
 208
 209 selectDocNodes :: HasDBid NodeType => CorpusId -> Cmd err [Context HyperdataDocument]
 210 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 211
 212 queryDocNodes :: HasDBid NodeType => CorpusId -> O.Select ContextRead
 213 queryDocNodes cId = proc () -> do
 214   (c, nc) <- joinInCorpus -< ()
 215   restrict -< nc^.nc_node_id   .== (toNullable $ pgNodeId cId)
 216   restrict -< nc^.nc_category  .>= (toNullable $ sqlInt4 1)
 217   restrict -< c^.context_typename .== (sqlInt4 $ toDBid NodeDocument)
 218   returnA -<  c
 219
 220 joinInCorpus :: O.Select (ContextRead, NodeContextReadNull)
 221 joinInCorpus = leftJoin queryContextTable queryNodeContextTable cond
 222   where
 223     cond :: (ContextRead, NodeContextRead) -> Column SqlBool
 224     cond (c, nc) = c^.context_id .== nc^.nc_context_id
 225
 226
 227 joinOn1 :: O.Select (NodeRead, NodeContextReadNull)
 228 joinOn1 = leftJoin queryNodeTable queryNodeContextTable cond
 229   where
 230     cond :: (NodeRead, NodeContextRead) -> Column SqlBool
 231     cond (n, nc) = nc^.nc_node_id .== n^.node_id
 232
 233
 234 ------------------------------------------------------------------------
 235 selectPublicContexts :: HasDBid NodeType => (Hyperdata a, DefaultFromField SqlJsonb a)
 236                   => Cmd err [(Node a, Maybe Int)]
 237 selectPublicContexts = runOpaQuery (queryWithType NodeFolderPublic)
 238
 239 queryWithType :: HasDBid NodeType =>NodeType -> O.Select (NodeRead, Column (Nullable SqlInt4))
 240 queryWithType nt = proc () -> do
 241   (n, nc) <- joinOn1 -< ()
 242   restrict -< n^.node_typename .== (sqlInt4 $ toDBid nt)
 243   returnA  -<  (n, nc^.nc_context_id)