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 getAllDocuments :: ParentId -> Cmd err (TableResult (Node HyperdataDocument))
  34 getAllDocuments pId = getAllChildren pId (Proxy :: Proxy HyperdataDocument)
  35                                          (Just NodeDocument)
  36
  37 getAllContacts :: ParentId -> Cmd err (TableResult (Node HyperdataContact))
  38 getAllContacts pId = getAllChildren pId (Proxy :: Proxy HyperdataContact)
  39                                         (Just NodeContact)
  40
  41 getAllChildren :: JSONB a
  42                => ParentId
  43                -> proxy a
  44                -> Maybe NodeType
  45                -> Cmd err (NodeTableResult a)
  46 getAllChildren pId p maybeNodeType = getChildren pId p maybeNodeType Nothing Nothing
  47
  48 getChildren :: JSONB a
  49             => ParentId
  50             -> proxy a
  51             -> Maybe NodeType
  52             -> Maybe Offset
  53             -> Maybe Limit
  54             -> Cmd err (NodeTableResult a)
  55 getChildren pId _ maybeNodeType maybeOffset maybeLimit = do
  56   docs <- runOpaQuery
  57           $ limit' maybeLimit $ offset' maybeOffset
  58           $ orderBy (asc _node_id)
  59           $ query
  60
  61   docCount <- runCountOpaQuery query
  62
  63   pure $ TableResult { tr_docs = docs, tr_count = docCount }
  64
  65   where
  66     query = selectChildren pId maybeNodeType
  67
  68 selectChildren :: ParentId
  69                -> Maybe NodeType
  70                -> Query NodeRead
  71 selectChildren parentId maybeNodeType = proc () -> do
  72     row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
  73     (NodeNode n1id n2id _ _) <- queryNodeNodeTable -< ()
  74
  75     let nodeType = maybe 0 nodeTypeId maybeNodeType
  76     restrict -< typeName  .== pgInt4 nodeType
  77
  78     restrict -< (.||) (parent_id .== (pgNodeId parentId))
  79                       ( (.&&) (n1id .== pgNodeId parentId)
  80                               (n2id .== nId))
  81     returnA -< row