{-|
-Module : Gargantext.Database.Query.Table.NodeNode
+Module : Gargantext.Database.Query.Table.NodeContext
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
, selectDocs
, nodeContextsCategory
, nodeContextsScore
+ , getNodeContexts
, getNodeContext
+ , updateNodeContextCategory
+ , getContextsForNgrams
, insertNodeContext
, deleteNodeContext
, selectPublicContexts
import Control.Arrow (returnA)
import Control.Lens (view, (^.))
import Data.Maybe (catMaybes)
+import Data.Time (UTCTime)
import Data.Text (Text, splitOn)
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Opaleye
-import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
+import qualified Database.PostgreSQL.Simple as PGS (In(..), Query, Only(..))
import qualified Opaleye as O
import Gargantext.Core
import Gargantext.Core.Types
+-- import Gargantext.Core.Types.Search (HyperdataRow(..), toHyperdataRow)
import Gargantext.Database.Admin.Types.Hyperdata
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError, NodeError(DoesNotExist), nodeError)
import Gargantext.Database.Prelude
+import Gargantext.Prelude.Crypto.Hash (Hash)
import Gargantext.Database.Schema.Context
import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.NodeContext
------------------------------------------------------------------------
-- | Basic NodeContext tools
-getNodeContext :: NodeId -> Cmd err [NodeContext]
-getNodeContext n = runOpaQuery (selectNodeContext $ pgNodeId n)
+getNodeContexts :: NodeId -> Cmd err [NodeContext]
+getNodeContexts n = runOpaQuery (selectNodeContexts $ pgNodeId n)
where
- selectNodeContext :: Column SqlInt4 -> Select NodeContextRead
- selectNodeContext n' = proc () -> do
+ selectNodeContexts :: Column SqlInt4 -> Select NodeContextRead
+ selectNodeContexts n' = proc () -> do
ns <- queryNodeContextTable -< ()
restrict -< _nc_node_id ns .== n'
returnA -< ns
+
+getNodeContext :: HasNodeError err => ContextId -> NodeId -> Cmd err NodeContext
+getNodeContext c n = do
+ maybeNodeContext <- headMay <$> runOpaQuery (selectNodeContext (pgNodeId c) (pgNodeId n))
+ case maybeNodeContext of
+ Nothing -> nodeError (DoesNotExist c)
+ Just r -> pure r
+ where
+ selectNodeContext :: Column SqlInt4 -> Column SqlInt4 -> Select NodeContextRead
+ selectNodeContext c' n' = proc () -> do
+ ns <- queryNodeContextTable -< ()
+ restrict -< _nc_context_id ns .== c'
+ restrict -< _nc_node_id ns .== n'
+ returnA -< ns
+
+updateNodeContextCategory :: ContextId -> NodeId -> Int -> Cmd err Int64
+updateNodeContextCategory cId nId cat = do
+ execPGSQuery upScore (cat, cId, nId)
+ where
+ upScore :: PGS.Query
+ upScore = [sql| UPDATE nodes_contexts
+ SET category = ?
+ WHERE context_id = ?
+ AND node_id = ? |]
+
+getContextsForNgrams :: HasNodeError err => NodeId -> [Int] -> Cmd err [(NodeId, Maybe Hash, NodeTypeId, UserId, Maybe ParentId, ContextTitle, UTCTime, HyperdataDocument)]
+getContextsForNgrams cId ngramsIds = runPGSQuery query (cId, PGS.In ngramsIds)
+ where
+ query :: PGS.Query
+ query = [sql| SELECT contexts.id, hash_id, typename, user_id, parent_id, name, date, hyperdata
+ FROM contexts
+ JOIN context_node_ngrams ON contexts.id = context_node_ngrams.context_id
+ JOIN nodes_contexts ON contexts.id = nodes_contexts.context_id
+ WHERE nodes_contexts.node_id = ?
+ AND context_node_ngrams.ngrams_id IN ? |]
+
------------------------------------------------------------------------
insertNodeContext :: [NodeContext] -> Cmd err Int
insertNodeContext ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
$ Insert nodeContextTable ns' rCount (Just DoNothing))
where
ns' :: [NodeContextWrite]
- ns' = map (\(NodeContext n c x y)
- -> NodeContext (pgNodeId n)
+ ns' = map (\(NodeContext i n c x y)
+ -> NodeContext (sqlInt4 <$> i)
+ (pgNodeId n)
(pgNodeId c)
(sqlDouble <$> x)
(sqlInt4 <$> y)
deleteNodeContext n c = mkCmd $ \conn ->
fromIntegral <$> runDelete_ conn
(Delete nodeContextTable
- (\(NodeContext n_id c_id _ _) -> n_id .== pgNodeId n
+ (\(NodeContext _ n_id c_id _ _) -> n_id .== pgNodeId n
.&& c_id .== pgNodeId c
)
rCount
------------------------------------------------------------------------
-- | Favorite management
-_nodeContextCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
-_nodeContextCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
- where
- favQuery :: PGS.Query
- favQuery = [sql|UPDATE nodes_contexts SET category = ?
- WHERE node_id = ? AND context_id = ?
- RETURNING context_id;
- |]
-
nodeContextsCategory :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
nodeContextsCategory inputData = map (\(PGS.Only a) -> a)
- <$> runPGSQuery catQuery (PGS.Only $ Values fields inputData)
+ <$> runPGSQuery catSelect (PGS.Only $ Values fields inputData)
where
fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
- catQuery :: PGS.Query
- catQuery = [sql| UPDATE nodes_contexts as nn0
+ catSelect :: PGS.Query
+ catSelect = [sql| UPDATE nodes_contexts as nn0
SET category = nn1.category
FROM (?) as nn1(node_id,context_id,category)
- WHERE nn0.node1_id = nn1.node_id
- AND nn0.node2_id = nn1.context_id
- RETURNING nn1.context_id
+ WHERE nn0.node_id = nn1.node_id
+ AND nn0.context_id = nn1.context_id
+ RETURNING nn1.node_id
|]
------------------------------------------------------------------------
-- | Score management
-_nodeContextScore :: CorpusId -> DocId -> Int -> Cmd err [Int]
-_nodeContextScore cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery scoreQuery (c,cId,dId)
- where
- scoreQuery :: PGS.Query
- scoreQuery = [sql|UPDATE nodes_contexts SET score = ?
- WHERE node_id = ? AND context_id = ?
- RETURNING context_id;
- |]
-
nodeContextsScore :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
nodeContextsScore inputData = map (\(PGS.Only a) -> a)
<$> runPGSQuery catScore (PGS.Only $ Values fields inputData)
catScore = [sql| UPDATE nodes_contexts as nn0
SET score = nn1.score
FROM (?) as nn1(node_id, context_id, score)
- WHERE nn0.node_id = nn1.node_id
+ WHERE nn0.node_id = nn1.node_id
AND nn0.context_id = nn1.context_id
RETURNING nn1.context_id
|]
+
------------------------------------------------------------------------
selectCountDocs :: HasDBid NodeType => CorpusId -> Cmd err Int
selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
restrict -< nc^.nc_node_id .== (toNullable $ pgNodeId cId')
restrict -< nc^.nc_category .>= (toNullable $ sqlInt4 1)
restrict -< c^.context_typename .== (sqlInt4 $ toDBid NodeDocument)
- returnA -< c
+ returnA -< c
-- | TODO use UTCTime fast
joinInCorpus = leftJoin queryContextTable queryNodeContextTable cond
where
cond :: (ContextRead, NodeContextRead) -> Column SqlBool
- cond (c, nc) = c^.context_id .== nc^.nc_node_id
+ cond (c, nc) = c^.context_id .== nc^.nc_context_id
joinOn1 :: O.Select (NodeRead, NodeContextReadNull)