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 n n1 n2 x y)
  80                 -> NodeNode (pgInt4   <$> n)
  81                             (pgNodeId n1)
  82                             (pgNodeId n2)
  83                             (pgDouble <$> x)
  84                             (pgInt4   <$> y)
  85               ) ns
  86
  87 ------------------------------------------------------------------------
  88 type Node1_Id = NodeId
  89 type Node2_Id = NodeId
  90
  91 deleteNodeNode :: Node1_Id -> Node2_Id -> Cmd err Int
  92 deleteNodeNode n1 n2 = mkCmd $ \conn ->
  93   fromIntegral <$> runDelete conn nodeNodeTable
  94                  (\(NodeNode _ n1_id n2_id _ _) -> n1_id .== pgNodeId n1
  95                                              .&& n2_id .== pgNodeId n2 )
  96
  97 ------------------------------------------------------------------------
  98 -- | Favorite management
  99 _nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
 100 _nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
 101   where
 102     favQuery :: PGS.Query
 103     favQuery = [sql|UPDATE nodes_nodes SET category = ?
 104                WHERE node1_id = ? AND node2_id = ?
 105                RETURNING node2_id;
 106                |]
 107
 108 nodeNodesCategory :: [(CorpusId,DocId,Int)] -> Cmd err [Int]
 109 nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
 110                             <$> runPGSQuery catQuery (PGS.Only $ Values fields inputData)
 111   where
 112     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
 113     catQuery :: PGS.Query
 114     catQuery = [sql| UPDATE nodes_nodes as nn0
 115                       SET category = nn1.category
 116                        FROM (?) as nn1(node1_id,node2_id,category)
 117                        WHERE nn0.node1_id = nn1.node1_id
 118                        AND   nn0.node2_id = nn1.node2_id
 119                        RETURNING nn1.node2_id
 120                   |]
 121
 122 ------------------------------------------------------------------------
 123 -- | TODO use UTCTime fast
 124 selectDocsDates :: CorpusId -> Cmd err [Text]
 125 selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
 126                    <$> catMaybes
 127                    <$> map (view hd_publication_date)
 128                    <$> selectDocs cId
 129
 130 selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
 131 selectDocs cId = runOpaQuery (queryDocs cId)
 132
 133 queryDocs :: CorpusId -> O.Query (Column PGJsonb)
 134 queryDocs cId = proc () -> do
 135   (n, nn) <- joinInCorpus -< ()
 136   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 137   restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
 138   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
 139   returnA -< view (node_hyperdata) n
 140
 141 selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument]
 142 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 143
 144 queryDocNodes :: CorpusId -> O.Query NodeRead
 145 queryDocNodes cId = proc () -> do
 146   (n, nn) <- joinInCorpus -< ()
 147   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 148   restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
 149   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
 150   returnA -<  n
 151
 152 joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
 153 joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
 154   where
 155     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
 156     cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
 157
 158 joinOn1 :: O.Query (NodeRead, NodeNodeReadNull)
 159 joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond
 160   where
 161     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
 162     cond (n, nn) = nn^.nn_node1_id .== n^.node_id
 163
 164
 165 ------------------------------------------------------------------------
 166 selectPublicNodes :: (Hyperdata a, QueryRunnerColumnDefault PGJsonb a)
 167                   => Cmd err [(Node a, Maybe Int)]
 168 selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
 169
 170 queryWithType :: NodeType -> O.Query (NodeRead, Column (Nullable PGInt4))
 171 queryWithType nt = proc () -> do
 172   (n, nn) <- joinOn1 -< ()
 173   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId nt)
 174   returnA  -<  (n, nn^.nn_node2_id)
 175