src/Gargantext/Database/Query/Table/NodeContext.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 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   , getNodeContext
  30   , insertNodeContext
  31   , deleteNodeContext
  32   , selectPublicContexts
  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 Opaleye
  44 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
  45 import qualified Opaleye as O
  46
  47 import Gargantext.Core
  48 import Gargantext.Core.Types
  49 import Gargantext.Database.Admin.Types.Hyperdata
  50 import Gargantext.Database.Prelude
  51 import Gargantext.Database.Schema.Context
  52 import Gargantext.Database.Schema.Node
  53 import Gargantext.Database.Schema.NodeContext
  54 import Gargantext.Prelude
  55
  56 queryNodeContextTable :: Select NodeContextRead
  57 queryNodeContextTable = selectTable nodeContextTable
  58
  59 -- | not optimized (get all ngrams without filters)
  60 _nodesContexts :: Cmd err [NodeContext]
  61 _nodesContexts = runOpaQuery queryNodeContextTable
  62
  63 ------------------------------------------------------------------------
  64 -- | Basic NodeContext tools
  65 getNodeContext :: NodeId -> Cmd err [NodeContext]
  66 getNodeContext n = runOpaQuery (selectNodeContext $ pgNodeId n)
  67   where
  68     selectNodeContext :: Column SqlInt4 -> Select NodeContextRead
  69     selectNodeContext n' = proc () -> do
  70       ns <- queryNodeContextTable -< ()
  71       restrict -< _nc_node_id ns .== n'
  72       returnA -< ns
  73
  74 ------------------------------------------------------------------------
  75 insertNodeContext :: [NodeContext] -> Cmd err Int
  76 insertNodeContext ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
  77                           $ Insert nodeContextTable ns' rCount (Just DoNothing))
  78   where
  79     ns' :: [NodeContextWrite]
  80     ns' = map (\(NodeContext n c x y)
  81                 -> NodeContext (pgNodeId n)
  82                                (pgNodeId c)
  83                                (sqlDouble <$> x)
  84                                (sqlInt4  <$> y)
  85               ) ns
  86
  87
  88 ------------------------------------------------------------------------
  89 type Node_Id    = NodeId
  90 type Context_Id = NodeId
  91
  92 deleteNodeContext :: Node_Id -> Context_Id -> Cmd err Int
  93 deleteNodeContext n c = mkCmd $ \conn ->
  94   fromIntegral <$> runDelete_ conn
  95                               (Delete nodeContextTable
  96                                       (\(NodeContext n_id c_id _ _) -> n_id .== pgNodeId n
  97                                                                    .&& c_id .== pgNodeId c
  98                                       )
  99                                       rCount
 100                               )
 101
 102 ------------------------------------------------------------------------
 103 -- | Favorite management
 104 nodeContextsCategory :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
 105 nodeContextsCategory inputData = map (\(PGS.Only a) -> a)
 106                             <$> runPGSQuery catSelect (PGS.Only $ Values fields inputData)
 107   where
 108     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
 109     catSelect :: PGS.Query
 110     catSelect = [sql| UPDATE nodes_contexts as nn0
 111                       SET category = nn1.category
 112                        FROM (?) as nn1(node_id,context_id,category)
 113                        WHERE nn0.node_id    = nn1.node_id
 114                        AND   nn0.context_id = nn1.context_id
 115                        RETURNING nn1.node_id
 116                   |]
 117
 118 ------------------------------------------------------------------------
 119 -- | Score management
 120 nodeContextsScore :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
 121 nodeContextsScore inputData = map (\(PGS.Only a) -> a)
 122                             <$> runPGSQuery catScore (PGS.Only $ Values fields inputData)
 123   where
 124     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
 125     catScore :: PGS.Query
 126     catScore = [sql| UPDATE nodes_contexts as nn0
 127                       SET score = nn1.score
 128                        FROM (?) as nn1(node_id, context_id, score)
 129                        WHERE nn0.node_id    = nn1.node_id
 130                        AND   nn0.context_id = nn1.context_id
 131                        RETURNING nn1.context_id
 132                   |]
 133
 134
 135 ------------------------------------------------------------------------
 136 selectCountDocs :: HasDBid NodeType => CorpusId -> Cmd err Int
 137 selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
 138   where
 139     queryCountDocs cId' = proc () -> do
 140       (c, nc) <- joinInCorpus -< ()
 141       restrict -< nc^.nc_node_id   .== (toNullable $ pgNodeId cId')
 142       restrict -< nc^.nc_category  .>= (toNullable $ sqlInt4 1)
 143       restrict -< c^.context_typename .== (sqlInt4 $ toDBid NodeDocument)
 144       returnA  -< c
 145
 146
 147 -- | TODO use UTCTime fast
 148 selectDocsDates :: HasDBid NodeType => CorpusId -> Cmd err [Text]
 149 selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
 150                    <$> catMaybes
 151                    <$> map (view hd_publication_date)
 152                    <$> selectDocs cId
 153
 154 selectDocs :: HasDBid NodeType => CorpusId -> Cmd err [HyperdataDocument]
 155 selectDocs cId = runOpaQuery (queryDocs cId)
 156
 157 queryDocs :: HasDBid NodeType => CorpusId -> O.Select (Column SqlJsonb)
 158 queryDocs cId = proc () -> do
 159   (c, nn)  <- joinInCorpus -< ()
 160   restrict -< nn^.nc_node_id      .== (toNullable $ pgNodeId cId)
 161   restrict -< nn^.nc_category     .>= (toNullable $ sqlInt4 1)
 162   restrict -< c^.context_typename .== (sqlInt4 $ toDBid NodeDocument)
 163   returnA  -< view (context_hyperdata) c
 164
 165 selectDocNodes :: HasDBid NodeType => CorpusId -> Cmd err [Context HyperdataDocument]
 166 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 167
 168 queryDocNodes :: HasDBid NodeType => CorpusId -> O.Select ContextRead
 169 queryDocNodes cId = proc () -> do
 170   (c, nc) <- joinInCorpus -< ()
 171   restrict -< nc^.nc_node_id   .== (toNullable $ pgNodeId cId)
 172   restrict -< nc^.nc_category  .>= (toNullable $ sqlInt4 1)
 173   restrict -< c^.context_typename .== (sqlInt4 $ toDBid NodeDocument)
 174   returnA -<  c
 175
 176 joinInCorpus :: O.Select (ContextRead, NodeContextReadNull)
 177 joinInCorpus = leftJoin queryContextTable queryNodeContextTable cond
 178   where
 179     cond :: (ContextRead, NodeContextRead) -> Column SqlBool
 180     cond (c, nc) = c^.context_id .== nc^.nc_context_id
 181
 182
 183 joinOn1 :: O.Select (NodeRead, NodeContextReadNull)
 184 joinOn1 = leftJoin queryNodeTable queryNodeContextTable cond
 185   where
 186     cond :: (NodeRead, NodeContextRead) -> Column SqlBool
 187     cond (n, nc) = nc^.nc_node_id .== n^.node_id
 188
 189
 190 ------------------------------------------------------------------------
 191 selectPublicContexts :: HasDBid NodeType => (Hyperdata a, DefaultFromField SqlJsonb a)
 192                   => Cmd err [(Node a, Maybe Int)]
 193 selectPublicContexts = runOpaQuery (queryWithType NodeFolderPublic)
 194
 195 queryWithType :: HasDBid NodeType =>NodeType -> O.Select (NodeRead, Column (Nullable SqlInt4))
 196 queryWithType nt = proc () -> do
 197   (n, nc) <- joinOn1 -< ()
 198   restrict -< n^.node_typename .== (sqlInt4 $ toDBid nt)
 199   returnA  -<  (n, nc^.nc_context_id)