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

   1 {-| Module      : Gargantext.Database.Select.Table.NodeNode
   2 Description :
   3 Copyright   : (c) CNRS, 2017-Present
   4 License     : AGPL + CECILL v3
   5 Maintainer  : team@gargantext.org
   6 Stability   : experimental
   7 Portability : POSIX
   8
   9 Here is a longer description of this module, containing some
  10 commentary with @some markup@.
  11 -}
  12
  13 {-# OPTIONS_GHC -fno-warn-orphans #-}
  14
  15 {-# LANGUAGE Arrows                 #-}
  16 {-# LANGUAGE FunctionalDependencies #-}
  17 {-# LANGUAGE QuasiQuotes            #-}
  18 {-# LANGUAGE TemplateHaskell        #-}
  19
  20 module Gargantext.Database.Query.Table.NodeNode
  21   ( module Gargantext.Database.Schema.NodeNode
  22   , queryNodeNodeTable
  23   , getNodeNode
  24   , insertNodeNode
  25   , deleteNodeNode
  26   , selectPublicNodes
  27   )
  28   where
  29
  30 import Control.Arrow (returnA)
  31 import Control.Lens ((^.))
  32 import qualified Opaleye as O
  33 import Opaleye
  34
  35 import Gargantext.Core
  36 import Gargantext.Core.Types
  37 import Gargantext.Database.Schema.NodeNode
  38 import Gargantext.Database.Admin.Types.Hyperdata
  39 import Gargantext.Database.Prelude
  40 import Gargantext.Database.Schema.Node
  41 import Gargantext.Prelude
  42
  43
  44 queryNodeNodeTable :: Select NodeNodeRead
  45 queryNodeNodeTable = selectTable nodeNodeTable
  46
  47 -- | not optimized (get all ngrams without filters)
  48 _nodesNodes :: Cmd err [NodeNode]
  49 _nodesNodes = runOpaQuery queryNodeNodeTable
  50
  51 ------------------------------------------------------------------------
  52 -- | Basic NodeNode tools
  53 getNodeNode :: NodeId -> Cmd err [NodeNode]
  54 getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
  55   where
  56     selectNodeNode :: Column SqlInt4 -> Select NodeNodeRead
  57     selectNodeNode n' = proc () -> do
  58       ns <- queryNodeNodeTable -< ()
  59       restrict -< _nn_node1_id ns .== n'
  60       returnA -< ns
  61
  62 ------------------------------------------------------------------------
  63 -- TODO (refactor with Children)
  64 {-
  65 getNodeNodeWith :: NodeId -> proxy a -> Maybe NodeType -> Cmd err [a]
  66 getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
  67   where
  68     query = selectChildren pId maybeNodeType
  69
  70     selectChildren :: ParentId
  71                    -> Maybe NodeType
  72                    -> Select NodeRead
  73     selectChildren parentId maybeNodeType = proc () -> do
  74         row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
  75         (NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< ()
  76
  77         let nodeType = maybe 0 toDBid maybeNodeType
  78         restrict -< typeName  .== sqlInt4 nodeType
  79
  80         restrict -< (.||) (parent_id .== (pgNodeId parentId))
  81                           ( (.&&) (n1id .== pgNodeId parentId)
  82                                   (n2id .== nId))
  83         returnA -< row
  84 -}
  85
  86 ------------------------------------------------------------------------
  87 insertNodeNode :: [NodeNode] -> Cmd err Int
  88 insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
  89                           $ Insert nodeNodeTable ns' rCount (Just DoNothing))
  90   where
  91     ns' :: [NodeNodeWrite]
  92     ns' = map (\(NodeNode n1 n2 x y)
  93                 -> NodeNode (pgNodeId n1)
  94                             (pgNodeId n2)
  95                             (sqlDouble <$> x)
  96                             (sqlInt4   <$> y)
  97               ) ns
  98
  99
 100
 101 ------------------------------------------------------------------------
 102 type Node1_Id = NodeId
 103 type Node2_Id = NodeId
 104
 105 deleteNodeNode :: Node1_Id -> Node2_Id -> Cmd err Int
 106 deleteNodeNode n1 n2 = mkCmd $ \conn ->
 107   fromIntegral <$> runDelete_ conn
 108                   (Delete nodeNodeTable
 109                           (\(NodeNode n1_id n2_id _ _) -> n1_id .== pgNodeId n1
 110                                                       .&& n2_id .== pgNodeId n2
 111                           )
 112                           rCount
 113                   )
 114
 115 ------------------------------------------------------------------------
 116 selectPublicNodes :: HasDBid NodeType
 117                   => (Hyperdata a, DefaultFromField SqlJsonb a)
 118                   => Cmd err [(Node a, Maybe Int)]
 119 selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
 120
 121 queryWithType :: HasDBid NodeType
 122               => NodeType
 123               -> O.Select (NodeRead, Column (Nullable SqlInt4))
 124 queryWithType nt = proc () -> do
 125   (n, nn) <- node_NodeNode -< ()
 126   restrict -< n^.node_typename .== (sqlInt4 $ toDBid nt)
 127   returnA  -<  (n, nn^.nn_node2_id)
 128
 129 node_NodeNode :: O.Select (NodeRead, NodeNodeReadNull)
 130 node_NodeNode = leftJoin queryNodeTable queryNodeNodeTable cond
 131   where
 132     cond :: (NodeRead, NodeNodeRead) -> Column SqlBool
 133     cond (n, nn) = nn^.nn_node1_id .== n^.node_id
 134
 135
 136