{-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
module Gargantext.Database.Node.Children where
-import Database.PostgreSQL.Simple (Connection)
import Opaleye
import Gargantext.Core.Types
-import Gargantext.Database.Node
-import Gargantext.Database.NodeNode
+import Gargantext.Database.Schema.Node
+import Gargantext.Database.Utils
+import Gargantext.Database.Schema.NodeNode
import Gargantext.Database.Config (nodeTypeId)
-import Gargantext.Database.Queries
+import Gargantext.Database.Queries.Filter
import Gargantext.Database.Node.Contact (HyperdataContact)
+import Gargantext.Database.Schema.Node (pgNodeId)
import Control.Arrow (returnA)
-- | TODO: use getChildren with Proxy ?
-getContacts :: ParentId -> Maybe NodeType -> Cmd [Node HyperdataContact]
-getContacts pId maybeNodeType = mkCmd $ \c -> runQuery c $ selectChildren pId maybeNodeType
+getContacts :: ParentId -> Maybe NodeType -> Cmd err [Node HyperdataContact]
+getContacts pId maybeNodeType = runOpaQuery $ selectChildren pId maybeNodeType
-getChildren :: JSONB a => Connection -> ParentId -> proxy a -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [Node a]
-getChildren c pId _ maybeNodeType maybeOffset maybeLimit = runQuery c
+getChildren :: JSONB a => ParentId -> proxy a -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Cmd err [Node a]
+getChildren pId _ maybeNodeType maybeOffset maybeLimit = runOpaQuery
$ limit' maybeLimit $ offset' maybeOffset
$ orderBy (asc _node_id)
$ selectChildren pId maybeNodeType
selectChildren :: ParentId -> Maybe NodeType -> Query NodeRead
selectChildren parentId maybeNodeType = proc () -> do
- row@(Node nId typeName _ parent_id _ _ _ _) <- queryNodeTable -< ()
+ row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
(NodeNode n1id n2id _ _ _) <- queryNodeNodeTable -< ()
let nodeType = maybe 0 nodeTypeId maybeNodeType
restrict -< typeName .== pgInt4 nodeType
- restrict -< (.||) (parent_id .== (toNullable $ pgInt4 parentId))
- ( (.&&) (n1id .== pgInt4 parentId)
+ restrict -< (.||) (parent_id .== (pgNodeId parentId))
+ ( (.&&) (n1id .== pgNodeId parentId)
(n2id .== nId))
returnA -< row