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