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