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 i n c x y)
  81                 -> NodeContext (sqlInt4 <$> i)
  82                                (pgNodeId n)
  83                                (pgNodeId c)
  84                                (sqlDouble <$> x)
  85                                (sqlInt4  <$> y)
  86               ) ns
  87
  88
  89 ------------------------------------------------------------------------
  90 type Node_Id    = NodeId
  91 type Context_Id = NodeId
  92
  93 deleteNodeContext :: Node_Id -> Context_Id -> Cmd err Int
  94 deleteNodeContext n c = mkCmd $ \conn ->
  95   fromIntegral <$> runDelete_ conn
  96                               (Delete nodeContextTable
  97                                       (\(NodeContext _ n_id c_id _ _) -> n_id .== pgNodeId n
  98                                                                    .&& c_id .== pgNodeId c
  99                                       )
 100                                       rCount
 101                               )
 102
 103 ------------------------------------------------------------------------
 104 -- | Favorite management
 105 nodeContextsCategory :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
 106 nodeContextsCategory inputData = map (\(PGS.Only a) -> a)
 107                             <$> runPGSQuery catSelect (PGS.Only $ Values fields inputData)
 108   where
 109     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
 110     catSelect :: PGS.Query
 111     catSelect = [sql| UPDATE nodes_contexts as nn0
 112                       SET category = nn1.category
 113                        FROM (?) as nn1(node_id,context_id,category)
 114                        WHERE nn0.node_id    = nn1.node_id
 115                        AND   nn0.context_id = nn1.context_id
 116                        RETURNING nn1.node_id
 117                   |]
 118
 119 ------------------------------------------------------------------------
 120 -- | Score management
 121 nodeContextsScore :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
 122 nodeContextsScore inputData = map (\(PGS.Only a) -> a)
 123                             <$> runPGSQuery catScore (PGS.Only $ Values fields inputData)
 124   where
 125     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
 126     catScore :: PGS.Query
 127     catScore = [sql| UPDATE nodes_contexts as nn0
 128                       SET score = nn1.score
 129                        FROM (?) as nn1(node_id, context_id, score)
 130                        WHERE nn0.node_id    = nn1.node_id
 131                        AND   nn0.context_id = nn1.context_id
 132                        RETURNING nn1.context_id
 133                   |]
 134
 135
 136 ------------------------------------------------------------------------
 137 selectCountDocs :: HasDBid NodeType => CorpusId -> Cmd err Int
 138 selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
 139   where
 140     queryCountDocs cId' = proc () -> do
 141       (c, nc) <- joinInCorpus -< ()
 142       restrict -< nc^.nc_node_id   .== (toNullable $ pgNodeId cId')
 143       restrict -< nc^.nc_category  .>= (toNullable $ sqlInt4 1)
 144       restrict -< c^.context_typename .== (sqlInt4 $ toDBid NodeDocument)
 145       returnA  -< c
 146
 147
 148 -- | TODO use UTCTime fast
 149 selectDocsDates :: HasDBid NodeType => CorpusId -> Cmd err [Text]
 150 selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
 151                    <$> catMaybes
 152                    <$> map (view hd_publication_date)
 153                    <$> selectDocs cId
 154
 155 selectDocs :: HasDBid NodeType => CorpusId -> Cmd err [HyperdataDocument]
 156 selectDocs cId = runOpaQuery (queryDocs cId)
 157
 158 queryDocs :: HasDBid NodeType => CorpusId -> O.Select (Column SqlJsonb)
 159 queryDocs cId = proc () -> do
 160   (c, nn)  <- joinInCorpus -< ()
 161   restrict -< nn^.nc_node_id      .== (toNullable $ pgNodeId cId)
 162   restrict -< nn^.nc_category     .>= (toNullable $ sqlInt4 1)
 163   restrict -< c^.context_typename .== (sqlInt4 $ toDBid NodeDocument)
 164   returnA  -< view (context_hyperdata) c
 165
 166 selectDocNodes :: HasDBid NodeType => CorpusId -> Cmd err [Context HyperdataDocument]
 167 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 168
 169 queryDocNodes :: HasDBid NodeType => CorpusId -> O.Select ContextRead
 170 queryDocNodes cId = proc () -> do
 171   (c, nc) <- joinInCorpus -< ()
 172   restrict -< nc^.nc_node_id   .== (toNullable $ pgNodeId cId)
 173   restrict -< nc^.nc_category  .>= (toNullable $ sqlInt4 1)
 174   restrict -< c^.context_typename .== (sqlInt4 $ toDBid NodeDocument)
 175   returnA -<  c
 176
 177 joinInCorpus :: O.Select (ContextRead, NodeContextReadNull)
 178 joinInCorpus = leftJoin queryContextTable queryNodeContextTable cond
 179   where
 180     cond :: (ContextRead, NodeContextRead) -> Column SqlBool
 181     cond (c, nc) = c^.context_id .== nc^.nc_context_id
 182
 183
 184 joinOn1 :: O.Select (NodeRead, NodeContextReadNull)
 185 joinOn1 = leftJoin queryNodeTable queryNodeContextTable cond
 186   where
 187     cond :: (NodeRead, NodeContextRead) -> Column SqlBool
 188     cond (n, nc) = nc^.nc_node_id .== n^.node_id
 189
 190
 191 ------------------------------------------------------------------------
 192 selectPublicContexts :: HasDBid NodeType => (Hyperdata a, DefaultFromField SqlJsonb a)
 193                   => Cmd err [(Node a, Maybe Int)]
 194 selectPublicContexts = runOpaQuery (queryWithType NodeFolderPublic)
 195
 196 queryWithType :: HasDBid NodeType =>NodeType -> O.Select (NodeRead, Column (Nullable SqlInt4))
 197 queryWithType nt = proc () -> do
 198   (n, nc) <- joinOn1 -< ()
 199   restrict -< n^.node_typename .== (sqlInt4 $ toDBid nt)
 200   returnA  -<  (n, nc^.nc_context_id)