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 $ Insert nodeNodeTable ns' rCount Nothing
  73   where
  74     ns' :: [NodeNodeWrite]
  75     ns' = map (\(NodeNode n1 n2 x y)
  76                 -> NodeNode (pgNodeId n1)
  77                             (pgNodeId n2)
  78                             (pgDouble <$> x)
  79                             (pgInt4   <$> y)
  80               ) ns
  81
  82
  83 -- | Favorite management
  84 _nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
  85 _nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
  86   where
  87     favQuery :: PGS.Query
  88     favQuery = [sql|UPDATE nodes_nodes SET category = ?
  89                WHERE node1_id = ? AND node2_id = ?
  90                RETURNING node2_id;
  91                |]
  92
  93 nodeNodesCategory :: [(CorpusId,DocId,Int)] -> Cmd err [Int]
  94 nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
  95                             <$> runPGSQuery catQuery (PGS.Only $ Values fields inputData)
  96   where
  97     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
  98     catQuery :: PGS.Query
  99     catQuery = [sql| UPDATE nodes_nodes as nn0
 100                       SET category = nn1.category
 101                        FROM (?) as nn1(node1_id,node2_id,category)
 102                        WHERE nn0.node1_id = nn1.node1_id
 103                        AND   nn0.node2_id = nn1.node2_id
 104                        RETURNING nn1.node2_id
 105                   |]
 106
 107 ------------------------------------------------------------------------
 108 -- | TODO use UTCTime fast
 109 selectDocsDates :: CorpusId -> Cmd err [Text]
 110 selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
 111                    <$> catMaybes
 112                    <$> map (view hyperdataDocument_publication_date)
 113                    <$> selectDocs cId
 114
 115 selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
 116 selectDocs cId = runOpaQuery (queryDocs cId)
 117
 118 queryDocs :: CorpusId -> O.Query (Column PGJsonb)
 119 queryDocs cId = proc () -> do
 120   (n, nn) <- joinInCorpus -< ()
 121   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 122   restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
 123   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
 124   returnA -< view (node_hyperdata) n
 125
 126 selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument]
 127 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 128
 129 queryDocNodes :: CorpusId -> O.Query NodeRead
 130 queryDocNodes cId = proc () -> do
 131   (n, nn) <- joinInCorpus -< ()
 132   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 133   restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
 134   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
 135   returnA -<  n
 136
 137 joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
 138 joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
 139   where
 140     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
 141     cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
 142