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 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 :: HasDBid NodeType => ParentId -> Cmd err (TableResult (Node HyperdataDocument))
  34 getAllDocuments pId = getAllChildren pId (Proxy :: Proxy HyperdataDocument)
  35                                          (Just NodeDocument)
  36
  37 -- TODO getAllTableContacts
  38 getAllContacts :: HasDBid NodeType => ParentId -> Cmd err (TableResult (Node HyperdataContact))
  39 getAllContacts pId = getAllChildren pId (Proxy :: Proxy HyperdataContact)
  40                                         (Just NodeContact)
  41
  42 getAllChildren :: (JSONB a, HasDBid NodeType)
  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, HasDBid NodeType)
  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 :: HasDBid NodeType
  70                => 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 toDBid maybeNodeType
  78     restrict -< typeName  .== pgInt4 nodeType
  79
  80     restrict -< (.||) (parent_id .== (pgNodeId parentId))
  81                       ( (.&&) (n1id .== pgNodeId parentId)
  82                               (n2id .== nId))
  83     returnA -< row