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
  18 module Gargantext.Database.Node.Children where
  19
  20 import Database.PostgreSQL.Simple (Connection)
  21 import Opaleye
  22 import Gargantext.Core.Types
  23 import Gargantext.Database.Node
  24 import Gargantext.Database.NodeNode
  25 import Gargantext.Database.Config (nodeTypeId)
  26 import Gargantext.Database.Queries
  27 import Control.Arrow (returnA)
  28
  29 getChildren :: JSONB a => Connection -> ParentId -> proxy a -> Maybe NodeType
  30             -> Maybe Offset -> Maybe Limit -> IO [Node a]
  31 getChildren c pId _ maybeNodeType maybeOffset maybeLimit = runQuery c
  32                   $ limit' maybeLimit $ offset' maybeOffset
  33                   $ orderBy (asc _node_id)
  34                   $ selectChildren pId maybeNodeType
  35
  36 selectChildren :: ParentId -> Maybe NodeType -> Query NodeRead
  37 selectChildren parentId maybeNodeType = proc () -> do
  38     row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
  39     (NodeNode n1id n2id _ _ _) <- queryNodeNodeTable -< ()
  40
  41     let nodeType = maybe 0 nodeTypeId maybeNodeType
  42     restrict -< typeName  .== pgInt4 nodeType
  43
  44     restrict -< (.||) (parent_id .== (toNullable $ pgInt4 parentId))
  45                       ( (.&&) (n1id .== pgInt4 parentId)
  46                               (n2id .== nId))
  47     returnA -< row
  48
  49
  50
  51