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 -> Maybe NodeType -> Cmd err [Node HyperdataContact]
  34 getContacts pId maybeNodeType = runOpaQuery $ selectChildren pId maybeNodeType
  35
  36
  37 getChildren :: JSONB a => ParentId -> proxy a -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Cmd err [Node a]
  38 getChildren pId _ maybeNodeType maybeOffset maybeLimit = runOpaQuery
  39                   $ limit' maybeLimit $ offset' maybeOffset
  40                   $ orderBy (asc _node_id)
  41                   $ selectChildren pId maybeNodeType
  42
  43 selectChildren :: ParentId -> Maybe NodeType -> Query NodeRead
  44 selectChildren parentId maybeNodeType = proc () -> do
  45     row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
  46     (NodeNode n1id n2id _ _) <- queryNodeNodeTable -< ()
  47
  48     let nodeType = maybe 0 nodeTypeId maybeNodeType
  49     restrict -< typeName  .== pgInt4 nodeType
  50
  51     restrict -< (.||) (parent_id .== (pgNodeId parentId))
  52                       ( (.&&) (n1id .== pgNodeId parentId)
  53                               (n2id .== nId))
  54     returnA -< row
  55
  56
  57
  58