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