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