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