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