src/Gargantext/Database/Query/Table/NodeNode.hs

   1 {-|
   2 Module      : Gargantext.Database.Select.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   , getNodeNode
  25   , insertNodeNode
  26   , deleteNodeNode
  27   , selectPublicNodes
  28   )
  29   where
  30
  31 import Control.Arrow (returnA)
  32 import Control.Lens ((^.))
  33 import qualified Opaleye as O
  34 import Opaleye
  35
  36 import Gargantext.Core
  37 import Gargantext.Core.Types
  38 import Gargantext.Database.Schema.NodeNode
  39 import Gargantext.Database.Admin.Types.Hyperdata
  40 import Gargantext.Database.Prelude
  41 import Gargantext.Database.Schema.Node
  42 import Gargantext.Prelude
  43
  44
  45 queryNodeNodeTable :: Select NodeNodeRead
  46 queryNodeNodeTable = selectTable nodeNodeTable
  47
  48 -- | not optimized (get all ngrams without filters)
  49 _nodesNodes :: Cmd err [NodeNode]
  50 _nodesNodes = runOpaQuery queryNodeNodeTable
  51
  52 ------------------------------------------------------------------------
  53 -- | Basic NodeNode tools
  54 getNodeNode :: NodeId -> Cmd err [NodeNode]
  55 getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
  56   where
  57     selectNodeNode :: Column SqlInt4 -> Select NodeNodeRead
  58     selectNodeNode n' = proc () -> do
  59       ns <- queryNodeNodeTable -< ()
  60       restrict -< _nn_node1_id ns .== n'
  61       returnA -< ns
  62
  63 ------------------------------------------------------------------------
  64 -- TODO (refactor with Children)
  65 {-
  66 getNodeNodeWith :: NodeId -> proxy a -> Maybe NodeType -> Cmd err [a]
  67 getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
  68   where
  69     query = selectChildren pId maybeNodeType
  70
  71     selectChildren :: ParentId
  72                    -> Maybe NodeType
  73                    -> Select NodeRead
  74     selectChildren parentId maybeNodeType = proc () -> do
  75         row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
  76         (NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< ()
  77
  78         let nodeType = maybe 0 toDBid maybeNodeType
  79         restrict -< typeName  .== sqlInt4 nodeType
  80
  81         restrict -< (.||) (parent_id .== (pgNodeId parentId))
  82                           ( (.&&) (n1id .== pgNodeId parentId)
  83                                   (n2id .== nId))
  84         returnA -< row
  85 -}
  86
  87 ------------------------------------------------------------------------
  88 insertNodeNode :: [NodeNode] -> Cmd err Int
  89 insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
  90                           $ Insert nodeNodeTable ns' rCount (Just DoNothing))
  91   where
  92     ns' :: [NodeNodeWrite]
  93     ns' = map (\(NodeNode n1 n2 x y)
  94                 -> NodeNode (pgNodeId n1)
  95                             (pgNodeId n2)
  96                             (sqlDouble <$> x)
  97                             (sqlInt4   <$> y)
  98               ) ns
  99
 100
 101
 102 ------------------------------------------------------------------------
 103 type Node1_Id = NodeId
 104 type Node2_Id = NodeId
 105
 106 deleteNodeNode :: Node1_Id -> Node2_Id -> Cmd err Int
 107 deleteNodeNode n1 n2 = mkCmd $ \conn ->
 108   fromIntegral <$> runDelete_ conn
 109                               (Delete nodeNodeTable
 110                                       (\(NodeNode n1_id n2_id _ _) -> n1_id .== pgNodeId n1
 111                                                                   .&& n2_id .== pgNodeId n2
 112                                       )
 113                                       rCount
 114                               )
 115
 116 ------------------------------------------------------------------------
 117 selectPublicNodes :: HasDBid NodeType => (Hyperdata a, DefaultFromField SqlJsonb a)
 118                   => Cmd err [(Node a, Maybe Int)]
 119 selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
 120
 121 queryWithType :: HasDBid NodeType =>NodeType -> O.Select (NodeRead, Column (Nullable SqlInt4))
 122 queryWithType nt = proc () -> do
 123   (n, nn) <- joinOn1 -< ()
 124   restrict -< n^.node_typename .== (sqlInt4 $ toDBid nt)
 125   returnA  -<  (n, nn^.nn_node2_id)
 126
 127 joinOn1 :: O.Select (NodeRead, NodeNodeReadNull)
 128 joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond
 129   where
 130     cond :: (NodeRead, NodeNodeRead) -> Column SqlBool
 131     cond (n, nn) = nn^.nn_node1_id .== n^.node_id