src/Gargantext/Database/Query/Table/NodeNode.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.NodeNode
  22   ( module Gargantext.Database.Schema.NodeNode
  23   , queryNodeNodeTable
  24   , selectDocsDates
  25   , selectDocNodes
  26   , selectDocs
  27   , nodeNodesCategory
  28   , getNodeNode
  29   , insertNodeNode
  30   , deleteNodeNode
  31   , selectPublicNodes
  32   )
  33   where
  34
  35 import Control.Arrow (returnA)
  36 import Control.Lens (view, (^.))
  37 import Data.Maybe (catMaybes)
  38 import Data.Text (Text, splitOn)
  39 import Database.PostgreSQL.Simple.SqlQQ (sql)
  40 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
  41 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
  42 import qualified Opaleye as O
  43 import Opaleye
  44
  45 import Gargantext.Core.Types
  46 import Gargantext.Database.Schema.NodeNode
  47 import Gargantext.Database.Admin.Config (nodeTypeId)
  48 import Gargantext.Database.Admin.Types.Hyperdata
  49 import Gargantext.Database.Admin.Types.Node (CorpusId, DocId, pgNodeId)
  50 import Gargantext.Database.Prelude
  51 import Gargantext.Database.Schema.Node
  52 import Gargantext.Prelude
  53
  54
  55 queryNodeNodeTable :: Query NodeNodeRead
  56 queryNodeNodeTable = queryTable nodeNodeTable
  57
  58 -- | not optimized (get all ngrams without filters)
  59 _nodesNodes :: Cmd err [NodeNode]
  60 _nodesNodes = runOpaQuery queryNodeNodeTable
  61
  62 ------------------------------------------------------------------------
  63 -- | Basic NodeNode tools
  64 getNodeNode :: NodeId -> Cmd err [NodeNode]
  65 getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
  66   where
  67     selectNodeNode :: Column PGInt4 -> Query NodeNodeRead
  68     selectNodeNode n' = proc () -> do
  69       ns <- queryNodeNodeTable -< ()
  70       restrict -< _nn_node1_id ns .== n'
  71       returnA -< ns
  72
  73 ------------------------------------------------------------------------
  74 insertNodeNode :: [NodeNode] -> Cmd err Int64
  75 insertNodeNode ns = mkCmd $ \conn -> runInsert_ conn
  76                           $ Insert nodeNodeTable ns' rCount Nothing
  77   where
  78     ns' :: [NodeNodeWrite]
  79     ns' = map (\(NodeNode n1 n2 x y)
  80                 -> NodeNode (pgNodeId n1)
  81                             (pgNodeId n2)
  82                             (pgDouble <$> x)
  83                             (pgInt4   <$> y)
  84               ) ns
  85
  86 ------------------------------------------------------------------------
  87 type Node1_Id = NodeId
  88 type Node2_Id = NodeId
  89
  90 deleteNodeNode :: Node1_Id -> Node2_Id -> Cmd err Int
  91 deleteNodeNode n1 n2 = mkCmd $ \conn ->
  92   fromIntegral <$> runDelete conn nodeNodeTable
  93                  (\(NodeNode n1_id n2_id _ _) -> n1_id .== pgNodeId n1
  94                                              .&& n2_id .== pgNodeId n2 )
  95
  96 ------------------------------------------------------------------------
  97 -- | Favorite management
  98 _nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
  99 _nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
 100   where
 101     favQuery :: PGS.Query
 102     favQuery = [sql|UPDATE nodes_nodes SET category = ?
 103                WHERE node1_id = ? AND node2_id = ?
 104                RETURNING node2_id;
 105                |]
 106
 107 nodeNodesCategory :: [(CorpusId,DocId,Int)] -> Cmd err [Int]
 108 nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
 109                             <$> runPGSQuery catQuery (PGS.Only $ Values fields inputData)
 110   where
 111     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
 112     catQuery :: PGS.Query
 113     catQuery = [sql| UPDATE nodes_nodes as nn0
 114                       SET category = nn1.category
 115                        FROM (?) as nn1(node1_id,node2_id,category)
 116                        WHERE nn0.node1_id = nn1.node1_id
 117                        AND   nn0.node2_id = nn1.node2_id
 118                        RETURNING nn1.node2_id
 119                   |]
 120
 121 ------------------------------------------------------------------------
 122 -- | TODO use UTCTime fast
 123 selectDocsDates :: CorpusId -> Cmd err [Text]
 124 selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
 125                    <$> catMaybes
 126                    <$> map (view hd_publication_date)
 127                    <$> selectDocs cId
 128
 129 selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
 130 selectDocs cId = runOpaQuery (queryDocs cId)
 131
 132 queryDocs :: CorpusId -> O.Query (Column PGJsonb)
 133 queryDocs cId = proc () -> do
 134   (n, nn) <- joinInCorpus -< ()
 135   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 136   restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
 137   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
 138   returnA -< view (node_hyperdata) n
 139
 140 selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument]
 141 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 142
 143 queryDocNodes :: CorpusId -> O.Query NodeRead
 144 queryDocNodes cId = proc () -> do
 145   (n, nn) <- joinInCorpus -< ()
 146   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 147   restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
 148   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
 149   returnA -<  n
 150
 151 joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
 152 joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
 153   where
 154     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
 155     cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
 156
 157 joinOn1 :: O.Query (NodeRead, NodeNodeReadNull)
 158 joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond
 159   where
 160     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
 161     cond (n, nn) = nn^.nn_node1_id .== n^.node_id
 162
 163
 164 ------------------------------------------------------------------------
 165 selectPublicNodes :: (Hyperdata a, QueryRunnerColumnDefault PGJsonb a)
 166                   => Cmd err [(Node a, Maybe Int)]
 167 selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
 168
 169 queryWithType :: NodeType -> O.Query (NodeRead, Column (Nullable PGInt4))
 170 queryWithType nt = proc () -> do
 171   (n, nn) <- joinOn1 -< ()
 172   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId nt)
 173   returnA  -<  (n, nn^.nn_node2_id)
 174