src/Gargantext/Database/Query/Table/Node/Children.hs

   1 {-|
   2 Module      : Gargantext.Database.Query.Table.Node.Children
   3 Description : Main requests of Node to the database
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9 -}
  10
  11
  12 {-# OPTIONS_GHC -fno-warn-orphans        #-}
  13
  14 {-# LANGUAGE Arrows                      #-}
  15
  16 module Gargantext.Database.Query.Table.Node.Children
  17   where
  18
  19 import Control.Arrow (returnA)
  20 import Data.Proxy
  21 import Gargantext.Core
  22 import Gargantext.Core.Types
  23 import Gargantext.Core.Types.Query (Limit, Offset)
  24 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument, HyperdataContact)
  25 import Gargantext.Database.Prelude
  26 import Gargantext.Database.Query.Filter
  27
  28 import Gargantext.Database.Schema.Node
  29 import Gargantext.Database.Schema.Context
  30 import Gargantext.Database.Schema.NodeContext
  31 import Gargantext.Database.Query.Table.NodeContext
  32
  33
  34 import Gargantext.Prelude
  35 import Opaleye
  36
  37
  38 -- TODO getAllTableDocuments
  39 getAllDocuments :: HasDBid NodeType => ParentId -> Cmd err (TableResult (Node HyperdataDocument))
  40 getAllDocuments pId = getAllChildren pId (Proxy :: Proxy HyperdataDocument)
  41                                          (Just NodeDocument)
  42
  43 -- TODO getAllTableContacts
  44 getAllContacts :: HasDBid NodeType => ParentId -> Cmd err (TableResult (Node HyperdataContact))
  45 getAllContacts pId = getAllChildren pId (Proxy :: Proxy HyperdataContact)
  46                                         (Just NodeContact)
  47
  48 getAllChildren :: (JSONB a, HasDBid NodeType)
  49                => ParentId
  50                -> proxy a
  51                -> Maybe NodeType
  52                -> Cmd err (NodeTableResult a)
  53 getAllChildren pId p maybeNodeType = getChildren pId p maybeNodeType Nothing Nothing
  54
  55
  56 getChildren :: (JSONB a, HasDBid NodeType)
  57             => ParentId
  58             -> proxy a
  59             -> Maybe NodeType
  60             -> Maybe Offset
  61             -> Maybe Limit
  62             -> Cmd err (NodeTableResult a)
  63 getChildren pId p t@(Just NodeDocument) maybeOffset maybeLimit = getChildrenContext pId p t maybeOffset maybeLimit
  64 getChildren pId p t@(Just NodeContact ) maybeOffset maybeLimit = getChildrenContext pId p t maybeOffset maybeLimit
  65 getChildren a b c d e = getChildrenNode a b c d e
  66
  67
  68 getChildrenNode :: (JSONB a, HasDBid NodeType)
  69             => ParentId
  70             -> proxy a
  71             -> Maybe NodeType
  72             -> Maybe Offset
  73             -> Maybe Limit
  74             -> Cmd err (NodeTableResult a)
  75 getChildrenNode pId _ maybeNodeType maybeOffset maybeLimit = do
  76   -- printDebug "getChildrenNode" (pId, maybeNodeType)
  77   let query = selectChildrenNode pId maybeNodeType
  78   docs <- runOpaQuery
  79         $ limit'  maybeLimit
  80         $ offset' maybeOffset
  81         $ orderBy (asc _node_id)
  82         $ query
  83   docCount <- runCountOpaQuery query
  84   pure $ TableResult { tr_docs = docs, tr_count = docCount }
  85
  86
  87 selectChildrenNode :: HasDBid NodeType
  88                    => ParentId
  89                    -> Maybe NodeType
  90                    -> Select NodeRead
  91 selectChildrenNode parentId maybeNodeType = proc () -> do
  92     row@(Node _ _ typeName _ parent_id _ _ _) <- queryNodeTable -< ()
  93     let nodeType = maybe 0 toDBid maybeNodeType
  94     restrict -< typeName  .== sqlInt4 nodeType
  95     restrict -< parent_id .== (pgNodeId parentId)
  96     returnA -< row
  97
  98
  99 getChildrenContext :: (JSONB a, HasDBid NodeType)
 100             => ParentId
 101             -> proxy a
 102             -> Maybe NodeType
 103             -> Maybe Offset
 104             -> Maybe Limit
 105             -> Cmd err (NodeTableResult a)
 106 getChildrenContext pId _ maybeNodeType maybeOffset maybeLimit = do
 107   -- printDebug "getChildrenContext" (pId, maybeNodeType)
 108   let query = selectChildren' pId maybeNodeType
 109
 110   docs <- runOpaQuery
 111         $ limit'  maybeLimit
 112         $ offset' maybeOffset
 113         $ orderBy (asc _context_id)
 114         $ query
 115
 116   docCount <- runCountOpaQuery query
 117   pure $ TableResult { tr_docs = map context2node docs, tr_count = docCount }
 118
 119
 120 selectChildren' :: HasDBid NodeType
 121                => ParentId
 122                -> Maybe NodeType
 123                -> Select ContextRead
 124 selectChildren' parentId maybeNodeType = proc () -> do
 125     row@(Context cid _ typeName _ _ _ _ _) <- queryContextTable     -< ()
 126     (NodeContext _ nid cid' _ _)           <- queryNodeContextTable -< ()
 127
 128     let nodeType = maybe 0 toDBid maybeNodeType
 129     restrict -< typeName  .== sqlInt4 nodeType
 130
 131     restrict -< nid .== pgNodeId parentId
 132     restrict -< cid .== cid'
 133     returnA -< row