[FLOW] NgramsT is a Functor
[gargantext.git] / src / Gargantext / Database / Node / Children.hs
index 96394a78e290b2548ab7ade54a9bc7145cc58afd..2bc34b926780bca290eeb5aed638ec7e26b776ca 100644 (file)
@@ -14,26 +14,28 @@ Portability : POSIX
 {-# 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
@@ -46,8 +48,8 @@ selectChildren parentId maybeNodeType = proc () -> do
     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