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