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.Database.Admin.Types.Hyperdata (HyperdataDocument, HyperdataContact)
  24 import Gargantext.Database.Prelude
  25 import Gargantext.Database.Query.Filter
  26
  27 import Gargantext.Database.Schema.Node
  28 import Gargantext.Database.Schema.Context
  29 import Gargantext.Database.Schema.NodeContext
  30 import Gargantext.Database.Query.Table.NodeContext
  31
  32
  33 import Gargantext.Prelude
  34 import Opaleye
  35
  36
  37 -- TODO getAllTableDocuments
  38 getAllDocuments :: HasDBid NodeType => ParentId -> Cmd err (TableResult (Node HyperdataDocument))
  39 getAllDocuments pId = getAllChildren pId (Proxy :: Proxy HyperdataDocument)
  40                                          (Just NodeDocument)
  41
  42 -- TODO getAllTableContacts
  43 getAllContacts :: HasDBid NodeType => ParentId -> Cmd err (TableResult (Node HyperdataContact))
  44 getAllContacts pId = getAllChildren pId (Proxy :: Proxy HyperdataContact)
  45                                         (Just NodeContact)
  46
  47 getAllChildren :: (JSONB a, HasDBid NodeType)
  48                => ParentId
  49                -> proxy a
  50                -> Maybe NodeType
  51                -> Cmd err (NodeTableResult a)
  52 getAllChildren pId p maybeNodeType = getChildren pId p maybeNodeType Nothing Nothing
  53
  54
  55 getChildren :: (JSONB a, HasDBid NodeType)
  56             => ParentId
  57             -> proxy a
  58             -> Maybe NodeType
  59             -> Maybe Offset
  60             -> Maybe Limit
  61             -> Cmd err (NodeTableResult a)
  62 getChildren pId p t@(Just NodeDocument) maybeOffset maybeLimit = getChildrenContext pId p t maybeOffset maybeLimit
  63 getChildren pId p t@(Just NodeContact ) maybeOffset maybeLimit = getChildrenContext pId p t maybeOffset maybeLimit
  64 getChildren a b c d e = getChildrenNode a b c d e
  65
  66
  67 getChildrenNode :: (JSONB a, HasDBid NodeType)
  68             => ParentId
  69             -> proxy a
  70             -> Maybe NodeType
  71             -> Maybe Offset
  72             -> Maybe Limit
  73             -> Cmd err (NodeTableResult a)
  74 getChildrenNode pId _ maybeNodeType maybeOffset maybeLimit = do
  75   printDebug "getChildrenNode" (pId, maybeNodeType)
  76   let query = selectChildrenNode pId maybeNodeType
  77   docs <- runOpaQuery
  78         $ limit'  maybeLimit
  79         $ offset' maybeOffset
  80         $ orderBy (asc _node_id)
  81         $ query
  82   docCount <- runCountOpaQuery query
  83   pure $ TableResult { tr_docs = docs, tr_count = docCount }
  84
  85
  86 selectChildrenNode :: HasDBid NodeType
  87                => ParentId
  88                -> Maybe NodeType
  89                -> Select NodeRead
  90 selectChildrenNode parentId maybeNodeType = proc () -> do
  91     row@(Node _ _ typeName _ parent_id _ _ _) <- queryNodeTable -< ()
  92     let nodeType = maybe 0 toDBid maybeNodeType
  93     restrict -< typeName  .== sqlInt4 nodeType
  94     restrict -< parent_id .== (pgNodeId parentId)
  95     returnA -< row
  96
  97
  98 getChildrenContext :: (JSONB a, HasDBid NodeType)
  99             => ParentId
 100             -> proxy a
 101             -> Maybe NodeType
 102             -> Maybe Offset
 103             -> Maybe Limit
 104             -> Cmd err (NodeTableResult a)
 105 getChildrenContext pId _ maybeNodeType maybeOffset maybeLimit = do
 106   printDebug "getChildrenContext" (pId, maybeNodeType)
 107   let query = selectChildren' pId maybeNodeType
 108
 109   docs <- runOpaQuery
 110         $ limit'  maybeLimit
 111         $ offset' maybeOffset
 112         $ orderBy (asc _context_id)
 113         $ query
 114
 115   docCount <- runCountOpaQuery query
 116   pure $ TableResult { tr_docs = map context2node docs, tr_count = docCount }
 117
 118
 119 selectChildren' :: HasDBid NodeType
 120                => ParentId
 121                -> Maybe NodeType
 122                -> Select ContextRead
 123 selectChildren' parentId maybeNodeType = proc () -> do
 124     row@(Context cid _ typeName _ _ _ _ _) <- queryContextTable     -< ()
 125     (NodeContext nid cid' _ _)                    <- queryNodeContextTable -< ()
 126
 127     let nodeType = maybe 0 toDBid maybeNodeType
 128     restrict -< typeName  .== sqlInt4 nodeType
 129
 130     restrict -< nid .== pgNodeId parentId
 131     restrict -< cid .== cid'
 132     returnA -< row