src/Gargantext/Database/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.Node.Children where
  20
  21 import Opaleye
  22 import Gargantext.Core.Types
  23 import Gargantext.Database.Schema.Node
  24 import Gargantext.Database.Utils
  25 import Gargantext.Database.Schema.NodeNode
  26 import Gargantext.Database.Config (nodeTypeId)
  27 import Gargantext.Database.Queries.Filter
  28 import Gargantext.Database.Node.Contact (HyperdataContact)
  29 import Gargantext.Database.Schema.Node (pgNodeId)
  30 import Control.Arrow (returnA)
  31
  32 -- | TODO: use getChildren with Proxy ?
  33 getContacts :: ParentId
  34             -> Maybe NodeType
  35             -> Cmd err [Node HyperdataContact]
  36 getContacts pId maybeNodeType = runOpaQuery $ selectChildren pId maybeNodeType
  37
  38
  39 getChildren :: JSONB a
  40             => ParentId
  41             -> proxy a
  42             -> Maybe NodeType
  43             -> Maybe Offset
  44             -> Maybe Limit
  45             -> Cmd err [Node a]
  46 getChildren pId _ maybeNodeType maybeOffset maybeLimit = runOpaQuery
  47                   $ limit' maybeLimit $ offset' maybeOffset
  48                   $ orderBy (asc _node_id)
  49                   $ selectChildren pId maybeNodeType
  50
  51 selectChildren :: ParentId
  52                -> Maybe NodeType
  53                -> Query NodeRead
  54 selectChildren parentId maybeNodeType = proc () -> do
  55     row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
  56     (NodeNode n1id n2id _ _) <- queryNodeNodeTable -< ()
  57
  58     let nodeType = maybe 0 nodeTypeId maybeNodeType
  59     restrict -< typeName  .== pgInt4 nodeType
  60
  61     restrict -< (.||) (parent_id .== (pgNodeId parentId))
  62                       ( (.&&) (n1id .== pgNodeId parentId)
  63                               (n2id .== nId))
  64     returnA -< row
  65
  66
  67
  68