, insertNodeNode
, deleteNodeNode
, selectPublicNodes
+ , selectCountDocs
)
where
import Gargantext.Database.Schema.NodeNode
import Gargantext.Database.Admin.Config (nodeTypeId)
import Gargantext.Database.Admin.Types.Hyperdata
-import Gargantext.Database.Admin.Types.Node (CorpusId, DocId, pgNodeId)
import Gargantext.Database.Prelude
import Gargantext.Database.Schema.Node
import Gargantext.Prelude
returnA -< ns
------------------------------------------------------------------------
-insertNodeNode :: [NodeNode] -> Cmd err Int64
-insertNodeNode ns = mkCmd $ \conn -> runInsert_ conn
- $ Insert nodeNodeTable ns' rCount Nothing
+-- TODO (refactor with Children)
+{-
+getNodeNodeWith :: NodeId -> proxy a -> Maybe NodeType -> Cmd err [a]
+getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
+ where
+ query = selectChildren pId maybeNodeType
+
+ selectChildren :: ParentId
+ -> Maybe NodeType
+ -> Query NodeRead
+ selectChildren parentId maybeNodeType = proc () -> do
+ row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
+ (NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< ()
+
+ let nodeType = maybe 0 nodeTypeId maybeNodeType
+ restrict -< typeName .== pgInt4 nodeType
+
+ restrict -< (.||) (parent_id .== (pgNodeId parentId))
+ ( (.&&) (n1id .== pgNodeId parentId)
+ (n2id .== nId))
+ returnA -< row
+-}
+
+------------------------------------------------------------------------
+insertNodeNode :: [NodeNode] -> Cmd err Int
+insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
+ $ Insert nodeNodeTable ns' rCount (Just DoNothing))
where
ns' :: [NodeNodeWrite]
ns' = map (\(NodeNode n1 n2 x y)
(pgInt4 <$> y)
) ns
+
+
------------------------------------------------------------------------
type Node1_Id = NodeId
type Node2_Id = NodeId
|]
------------------------------------------------------------------------
--- | TODO use UTCTime fast
+selectCountDocs :: CorpusId -> Cmd err Int
+selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
+ where
+ queryCountDocs cId' = proc () -> do
+ (n, nn) <- joinInCorpus -< ()
+ restrict -< nn^.nn_node1_id .== (toNullable $ pgNodeId cId')
+ restrict -< nn^.nn_category .>= (toNullable $ pgInt4 1)
+ restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
+ returnA -< n
+
+
+
+
+-- | TODO use UTCTime fast
selectDocsDates :: CorpusId -> Cmd err [Text]
selectDocsDates cId = map (head' "selectDocsDates" . splitOn "-")
<$> catMaybes