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