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   , selectPublicNodes
  32   , selectCountDocs
  33   )
  34   where
  35
  36 import Control.Arrow (returnA)
  37 import Control.Lens (view, (^.))
  38 import Data.Maybe (catMaybes)
  39 import Data.Text (Text, splitOn)
  40 import Database.PostgreSQL.Simple.SqlQQ (sql)
  41 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
  42 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
  43 import qualified Opaleye as O
  44 import Opaleye
  45
  46 import Gargantext.Core.Types
  47 import Gargantext.Database.Schema.NodeNode
  48 import Gargantext.Database.Admin.Config (nodeTypeId)
  49 import Gargantext.Database.Admin.Types.Hyperdata
  50 import Gargantext.Database.Admin.Types.Node (CorpusId, DocId, pgNodeId)
  51 import Gargantext.Database.Prelude
  52 import Gargantext.Database.Schema.Node
  53 import Gargantext.Prelude
  54
  55
  56 queryNodeNodeTable :: Query NodeNodeRead
  57 queryNodeNodeTable = queryTable nodeNodeTable
  58
  59 -- | not optimized (get all ngrams without filters)
  60 _nodesNodes :: Cmd err [NodeNode]
  61 _nodesNodes = runOpaQuery queryNodeNodeTable
  62
  63 ------------------------------------------------------------------------
  64 -- | Basic NodeNode tools
  65 getNodeNode :: NodeId -> Cmd err [NodeNode]
  66 getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
  67   where
  68     selectNodeNode :: Column PGInt4 -> Query NodeNodeRead
  69     selectNodeNode n' = proc () -> do
  70       ns <- queryNodeNodeTable -< ()
  71       restrict -< _nn_node1_id ns .== n'
  72       returnA -< ns
  73
  74 ------------------------------------------------------------------------
  75 -- TODO (refactor with Children)
  76 {-
  77 getNodeNodeWith :: NodeId -> proxy a -> Maybe NodeType -> Cmd err [a]
  78 getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
  79   where
  80     query = selectChildren pId maybeNodeType
  81
  82     selectChildren :: ParentId
  83                    -> Maybe NodeType
  84                    -> Query NodeRead
  85     selectChildren parentId maybeNodeType = proc () -> do
  86         row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
  87         (NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< ()
  88
  89         let nodeType = maybe 0 nodeTypeId maybeNodeType
  90         restrict -< typeName  .== pgInt4 nodeType
  91
  92         restrict -< (.||) (parent_id .== (pgNodeId parentId))
  93                           ( (.&&) (n1id .== pgNodeId parentId)
  94                                   (n2id .== nId))
  95         returnA -< row
  96 -}
  97
  98 ------------------------------------------------------------------------
  99 insertNodeNode :: [NodeNode] -> Cmd err Int
 100 insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
 101                           $ Insert nodeNodeTable ns' rCount (Just DoNothing))
 102   where
 103     ns' :: [NodeNodeWrite]
 104     ns' = map (\(NodeNode n1 n2 x y)
 105                 -> NodeNode (pgNodeId n1)
 106                             (pgNodeId n2)
 107                             (pgDouble <$> x)
 108                             (pgInt4   <$> y)
 109               ) ns
 110
 111
 112
 113 ------------------------------------------------------------------------
 114 type Node1_Id = NodeId
 115 type Node2_Id = NodeId
 116
 117 deleteNodeNode :: Node1_Id -> Node2_Id -> Cmd err Int
 118 deleteNodeNode n1 n2 = mkCmd $ \conn ->
 119   fromIntegral <$> runDelete conn nodeNodeTable
 120                  (\(NodeNode n1_id n2_id _ _) -> n1_id .== pgNodeId n1
 121                                              .&& n2_id .== pgNodeId n2 )
 122
 123 ------------------------------------------------------------------------
 124 -- | Favorite management
 125 _nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
 126 _nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
 127   where
 128     favQuery :: PGS.Query
 129     favQuery = [sql|UPDATE nodes_nodes SET category = ?
 130                WHERE node1_id = ? AND node2_id = ?
 131                RETURNING node2_id;
 132                |]
 133
 134 nodeNodesCategory :: [(CorpusId,DocId,Int)] -> Cmd err [Int]
 135 nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
 136                             <$> runPGSQuery catQuery (PGS.Only $ Values fields inputData)
 137   where
 138     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
 139     catQuery :: PGS.Query
 140     catQuery = [sql| UPDATE nodes_nodes as nn0
 141                       SET category = nn1.category
 142                        FROM (?) as nn1(node1_id,node2_id,category)
 143                        WHERE nn0.node1_id = nn1.node1_id
 144                        AND   nn0.node2_id = nn1.node2_id
 145                        RETURNING nn1.node2_id
 146                   |]
 147
 148 ------------------------------------------------------------------------
 149 selectCountDocs :: CorpusId -> Cmd err Int
 150 selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
 151   where
 152     queryCountDocs cId' = proc () -> do
 153       (n, nn) <- joinInCorpus -< ()
 154       restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId')
 155       restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
 156       restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
 157       returnA -< n
 158
 159
 160
 161
 162 -- | TODO use UTCTime fast
 163 selectDocsDates :: CorpusId -> Cmd err [Text]
 164 selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
 165                    <$> catMaybes
 166                    <$> map (view hd_publication_date)
 167                    <$> selectDocs cId
 168
 169 selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
 170 selectDocs cId = runOpaQuery (queryDocs cId)
 171
 172 queryDocs :: CorpusId -> O.Query (Column PGJsonb)
 173 queryDocs cId = proc () -> do
 174   (n, nn) <- joinInCorpus -< ()
 175   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 176   restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
 177   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
 178   returnA -< view (node_hyperdata) n
 179
 180 selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument]
 181 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 182
 183 queryDocNodes :: CorpusId -> O.Query NodeRead
 184 queryDocNodes cId = proc () -> do
 185   (n, nn) <- joinInCorpus -< ()
 186   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 187   restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
 188   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
 189   returnA -<  n
 190
 191 joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
 192 joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
 193   where
 194     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
 195     cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
 196
 197 joinOn1 :: O.Query (NodeRead, NodeNodeReadNull)
 198 joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond
 199   where
 200     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
 201     cond (n, nn) = nn^.nn_node1_id .== n^.node_id
 202
 203
 204 ------------------------------------------------------------------------
 205 selectPublicNodes :: (Hyperdata a, QueryRunnerColumnDefault PGJsonb a)
 206                   => Cmd err [(Node a, Maybe Int)]
 207 selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
 208
 209 queryWithType :: NodeType -> O.Query (NodeRead, Column (Nullable PGInt4))
 210 queryWithType nt = proc () -> do
 211   (n, nn) <- joinOn1 -< ()
 212   restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId nt)
 213   returnA  -<  (n, nn^.nn_node2_id)
 214