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 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  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.Types
  22 import Gargantext.Database.Admin.Config (nodeTypeId)
  23 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument, HyperdataContact)
  24 import Gargantext.Database.Admin.Types.Node (pgNodeId)
  25 import Gargantext.Database.Prelude
  26 import Gargantext.Database.Query.Filter
  27 import Gargantext.Database.Query.Table.Node
  28 import Gargantext.Database.Query.Table.NodeNode
  29 import Gargantext.Database.Schema.Node
  30 import Opaleye
  31 import Protolude
  32
  33
  34 -- TODO getAllTableDocuments
  35 getAllDocuments :: ParentId -> Cmd err (TableResult (Node HyperdataDocument))
  36 getAllDocuments pId = getAllChildren pId (Proxy :: Proxy HyperdataDocument)
  37                                          (Just NodeDocument)
  38
  39 -- TODO getAllTableContacts
  40 getAllContacts :: ParentId -> Cmd err (TableResult (Node HyperdataContact))
  41 getAllContacts pId = getAllChildren pId (Proxy :: Proxy HyperdataContact)
  42                                         (Just NodeContact)
  43
  44 getAllChildren :: JSONB a
  45                => ParentId
  46                -> proxy a
  47                -> Maybe NodeType
  48                -> Cmd err (NodeTableResult a)
  49 getAllChildren pId p maybeNodeType = getChildren pId p maybeNodeType Nothing Nothing
  50
  51 getChildren :: JSONB a
  52             => ParentId
  53             -> proxy a
  54             -> Maybe NodeType
  55             -> Maybe Offset
  56             -> Maybe Limit
  57             -> Cmd err (NodeTableResult a)
  58 getChildren pId _ maybeNodeType maybeOffset maybeLimit = do
  59   docs <- runOpaQuery
  60           $ limit' maybeLimit $ offset' maybeOffset
  61           $ orderBy (asc _node_id)
  62           $ query
  63
  64   docCount <- runCountOpaQuery query
  65
  66   pure $ TableResult { tr_docs = docs, tr_count = docCount }
  67
  68   where
  69     query = selectChildren pId maybeNodeType
  70
  71 selectChildren :: ParentId
  72                -> Maybe NodeType
  73                -> Query 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 nodeTypeId maybeNodeType
  79     restrict -< typeName  .== pgInt4 nodeType
  80
  81     restrict -< (.||) (parent_id .== (pgNodeId parentId))
  82                       ( (.&&) (n1id .== pgNodeId parentId)
  83                               (n2id .== nId))
  84     returnA -< row