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.Schema.Node
  24 import Gargantext.Database.Schema.NodeNode
  25 import Gargantext.Database.Config (nodeTypeId)
  26 import Gargantext.Database.Queries
  27 import Gargantext.Database.Node.Contact (HyperdataContact)
  28 import Control.Arrow (returnA)
  29
  30 -- | TODO: use getChildren with Proxy ?
  31 getContacts :: ParentId -> Maybe NodeType -> Cmd [Node HyperdataContact]
  32 getContacts pId maybeNodeType = mkCmd $ \c -> runQuery c $ selectChildren pId maybeNodeType
  33
  34
  35 getChildren :: JSONB a => Connection -> ParentId -> proxy a -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [Node a]
  36 getChildren c pId _ maybeNodeType maybeOffset maybeLimit = runQuery c
  37                   $ limit' maybeLimit $ offset' maybeOffset
  38                   $ orderBy (asc _node_id)
  39                   $ selectChildren pId maybeNodeType
  40
  41 selectChildren :: ParentId -> Maybe NodeType -> Query NodeRead
  42 selectChildren parentId maybeNodeType = proc () -> do
  43     row@(Node nId typeName _ parent_id _ _ _ _) <- queryNodeTable -< ()
  44     (NodeNode n1id n2id _ _ _) <- queryNodeNodeTable -< ()
  45
  46     let nodeType = maybe 0 nodeTypeId maybeNodeType
  47     restrict -< typeName  .== pgInt4 nodeType
  48
  49     restrict -< (.||) (parent_id .== (toNullable $ pgInt4 parentId))
  50                       ( (.&&) (n1id .== pgInt4 parentId)
  51                               (n2id .== nId))
  52     returnA -< row
  53
  54
  55
  56