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

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