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   , selectDocsDates
  25   , selectDocNodes
  26   , selectDocs
  27   , getNodeNode
  28   , insertNodeNode
  29   , deleteNodeNode
  30   , selectPublicNodes
  31   , selectCountDocs
  32   )
  33   where
  34
  35 import Control.Arrow (returnA)
  36 import Control.Lens (view, (^.))
  37 import Data.Maybe (catMaybes)
  38 import Data.Text (Text, splitOn)
  39 import qualified Opaleye as O
  40 import Opaleye
  41
  42 import Gargantext.Core
  43 import Gargantext.Core.Types
  44 import Gargantext.Database.Schema.NodeNode
  45 import Gargantext.Database.Admin.Types.Hyperdata
  46 import Gargantext.Database.Prelude
  47 import Gargantext.Database.Schema.Node
  48 import Gargantext.Prelude
  49
  50
  51 queryNodeNodeTable :: Select NodeNodeRead
  52 queryNodeNodeTable = selectTable nodeNodeTable
  53
  54 -- | not optimized (get all ngrams without filters)
  55 _nodesNodes :: Cmd err [NodeNode]
  56 _nodesNodes = runOpaQuery queryNodeNodeTable
  57
  58 ------------------------------------------------------------------------
  59 -- | Basic NodeNode tools
  60 getNodeNode :: NodeId -> Cmd err [NodeNode]
  61 getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
  62   where
  63     selectNodeNode :: Column SqlInt4 -> Select NodeNodeRead
  64     selectNodeNode n' = proc () -> do
  65       ns <- queryNodeNodeTable -< ()
  66       restrict -< _nn_node1_id ns .== n'
  67       returnA -< ns
  68
  69 ------------------------------------------------------------------------
  70 -- TODO (refactor with Children)
  71 {-
  72 getNodeNodeWith :: NodeId -> proxy a -> Maybe NodeType -> Cmd err [a]
  73 getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
  74   where
  75     query = selectChildren pId maybeNodeType
  76
  77     selectChildren :: ParentId
  78                    -> Maybe NodeType
  79                    -> Select NodeRead
  80     selectChildren parentId maybeNodeType = proc () -> do
  81         row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
  82         (NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< ()
  83
  84         let nodeType = maybe 0 toDBid maybeNodeType
  85         restrict -< typeName  .== sqlInt4 nodeType
  86
  87         restrict -< (.||) (parent_id .== (pgNodeId parentId))
  88                           ( (.&&) (n1id .== pgNodeId parentId)
  89                                   (n2id .== nId))
  90         returnA -< row
  91 -}
  92
  93 ------------------------------------------------------------------------
  94 insertNodeNode :: [NodeNode] -> Cmd err Int
  95 insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
  96                           $ Insert nodeNodeTable ns' rCount (Just DoNothing))
  97   where
  98     ns' :: [NodeNodeWrite]
  99     ns' = map (\(NodeNode n1 n2 x y)
 100                 -> NodeNode (pgNodeId n1)
 101                             (pgNodeId n2)
 102                             (sqlDouble <$> x)
 103                             (sqlInt4   <$> y)
 104               ) ns
 105
 106
 107
 108 ------------------------------------------------------------------------
 109 type Node1_Id = NodeId
 110 type Node2_Id = NodeId
 111
 112 deleteNodeNode :: Node1_Id -> Node2_Id -> Cmd err Int
 113 deleteNodeNode n1 n2 = mkCmd $ \conn ->
 114   fromIntegral <$> runDelete_ conn
 115                               (Delete nodeNodeTable
 116                                       (\(NodeNode n1_id n2_id _ _) -> n1_id .== pgNodeId n1
 117                                                                   .&& n2_id .== pgNodeId n2
 118                                       )
 119                                       rCount
 120                               )
 121
 122 ------------------------------------------------------------------------
 123 selectCountDocs :: HasDBid NodeType => CorpusId -> Cmd err Int
 124 selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
 125   where
 126     queryCountDocs cId' = proc () -> do
 127       (n, nn) <- joinInCorpus -< ()
 128       restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId')
 129       restrict -< nn^.nn_category  .>= (toNullable $ sqlInt4 1)
 130       restrict -< n^.node_typename .== (sqlInt4 $ toDBid NodeDocument)
 131       returnA -< n
 132
 133
 134
 135
 136 -- | TODO use UTCTime fast
 137 selectDocsDates :: HasDBid NodeType => CorpusId -> Cmd err [Text]
 138 selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
 139                    <$> catMaybes
 140                    <$> map (view hd_publication_date)
 141                    <$> selectDocs cId
 142
 143 selectDocs :: HasDBid NodeType => CorpusId -> Cmd err [HyperdataDocument]
 144 selectDocs cId = runOpaQuery (queryDocs cId)
 145
 146 queryDocs :: HasDBid NodeType => CorpusId -> O.Select (Column SqlJsonb)
 147 queryDocs cId = proc () -> do
 148   (n, nn) <- joinInCorpus -< ()
 149   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 150   restrict -< nn^.nn_category  .>= (toNullable $ sqlInt4 1)
 151   restrict -< n^.node_typename .== (sqlInt4 $ toDBid NodeDocument)
 152   returnA -< view (node_hyperdata) n
 153
 154 selectDocNodes :: HasDBid NodeType =>CorpusId -> Cmd err [Node HyperdataDocument]
 155 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 156
 157 queryDocNodes :: HasDBid NodeType =>CorpusId -> O.Select NodeRead
 158 queryDocNodes cId = proc () -> do
 159   (n, nn) <- joinInCorpus -< ()
 160   restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
 161   restrict -< nn^.nn_category  .>= (toNullable $ sqlInt4 1)
 162   restrict -< n^.node_typename .== (sqlInt4 $ toDBid NodeDocument)
 163   returnA -<  n
 164
 165 joinInCorpus :: O.Select (NodeRead, NodeNodeReadNull)
 166 joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
 167   where
 168     cond :: (NodeRead, NodeNodeRead) -> Column SqlBool
 169     cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
 170
 171 joinOn1 :: O.Select (NodeRead, NodeNodeReadNull)
 172 joinOn1 = leftJoin queryNodeTable queryNodeNodeTable cond
 173   where
 174     cond :: (NodeRead, NodeNodeRead) -> Column SqlBool
 175     cond (n, nn) = nn^.nn_node1_id .== n^.node_id
 176
 177
 178 ------------------------------------------------------------------------
 179 selectPublicNodes :: HasDBid NodeType => (Hyperdata a, DefaultFromField SqlJsonb a)
 180                   => Cmd err [(Node a, Maybe Int)]
 181 selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
 182
 183 queryWithType :: HasDBid NodeType =>NodeType -> O.Select (NodeRead, Column (Nullable SqlInt4))
 184 queryWithType nt = proc () -> do
 185   (n, nn) <- joinOn1 -< ()
 186   restrict -< n^.node_typename .== (sqlInt4 $ toDBid nt)
 187   returnA  -<  (n, nn^.nn_node2_id)
 188