queryNodeSearchTable :: Query NodeSearchRead
-queryNodeSearchTable = queryTable nodeTableSearch
+queryNodeSearchTable = selectTable nodeTableSearch
selectNode :: Column PGInt4 -> Query NodeRead
selectNode id' = proc () -> do
let typeId' = maybe 0 toDBid maybeNodeType
restrict -< if typeId' > 0
- then typeId .== (pgInt4 (typeId' :: Int))
+ then typeId .== (sqlInt4 (typeId' :: Int))
else (pgBool True)
returnA -< row ) -< ()
returnA -< node'
deleteNode :: NodeId -> Cmd err Int
deleteNode n = mkCmd $ \conn ->
- fromIntegral <$> runDelete conn nodeTable
- (\(Node n_id _ _ _ _ _ _ _) -> n_id .== pgNodeId n)
+ fromIntegral <$> runDelete_ conn
+ (Delete nodeTable
+ (\(Node n_id _ _ _ _ _ _ _) -> n_id .== pgNodeId n)
+ rCount
+ )
deleteNodes :: [NodeId] -> Cmd err Int
deleteNodes ns = mkCmd $ \conn ->
- fromIntegral <$> runDelete conn nodeTable
- (\(Node n_id _ _ _ _ _ _ _) -> in_ ((map pgNodeId ns)) n_id)
+ fromIntegral <$> runDelete_ conn
+ (Delete nodeTable
+ (\(Node n_id _ _ _ _ _ _ _) -> in_ ((map pgNodeId ns)) n_id)
+ rCount
+ )
-- TODO: NodeType should match with `a'
getNodesWith :: (JSONB a, HasDBid NodeType) => NodeId -> proxy a -> Maybe NodeType
getClosestParentIdByType nId nType = do
result <- runPGSQuery query (nId, 0 :: Int)
case result of
- [DPS.Only parentId, DPS.Only pTypename] -> do
+ [(NodeId parentId, pTypename)] -> do
if toDBid nType == pTypename then
pure $ Just $ NodeId parentId
else
query :: DPS.Query
query = [sql|
SELECT n2.id, n2.typename
- FROM nodes n1
+ FROM nodes n1
JOIN nodes n2 ON n1.parent_id = n2.id
WHERE n1.id = ? AND 0 = ?;
|]
+-- | Similar to `getClosestParentIdByType` but includes current node
+-- in search too
+getClosestParentIdByType' :: HasDBid NodeType
+ => NodeId
+ -> NodeType
+ -> Cmd err (Maybe NodeId)
+getClosestParentIdByType' nId nType = do
+ result <- runPGSQuery query (nId, 0 :: Int)
+ case result of
+ [(NodeId id, pTypename)] -> do
+ if toDBid nType == pTypename then
+ pure $ Just $ NodeId id
+ else
+ getClosestParentIdByType nId nType
+ _ -> pure Nothing
+ where
+ query :: DPS.Query
+ query = [sql|
+ SELECT n.id, n.typename
+ FROM nodes n
+ WHERE n.id = ? AND 0 = ?;
+ |]
+
+-- | Given a node id, find all it's children (no matter how deep) of
+-- given node type.
+getChildrenByType :: HasDBid NodeType
+ => NodeId
+ -> NodeType
+ -> Cmd err [NodeId]
+getChildrenByType nId nType = do
+ result <- runPGSQuery query (nId, 0 :: Int)
+ children_lst <- mapM (\(id, _) -> getChildrenByType id nType) result
+ pure $ concat $ [fst <$> filter (\(_, pTypename) -> pTypename == toDBid nType) result] ++ children_lst
+ where
+ query :: DPS.Query
+ query = [sql|
+ SELECT n.id, n.typename
+ FROM nodes n
+ WHERE n.parent_id = ? AND 0 = ?;
+ |]
+
------------------------------------------------------------------------
getDocumentsV3WithParentId :: HasDBid NodeType => NodeId -> Cmd err [Node HyperdataDocumentV3]
getDocumentsV3WithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocument)
=> NodeType -> Query NodeRead
selectNodesWithType nt' = proc () -> do
row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
- restrict -< tn .== (pgInt4 $ toDBid nt')
+ restrict -< tn .== (sqlInt4 $ toDBid nt')
returnA -< row
getNodesIdWithType :: (HasNodeError err, HasDBid NodeType) => NodeType -> Cmd err [NodeId]
=> NodeType -> Query (Column PGInt4)
selectNodesIdWithType nt = proc () -> do
row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
- restrict -< tn .== (pgInt4 $ toDBid nt)
+ restrict -< tn .== (sqlInt4 $ toDBid nt)
returnA -< _node_id row
------------------------------------------------------------------------
-> NodeWrite
node nodeType name hyperData parentId userId =
Node Nothing Nothing
- (pgInt4 typeId)
- (pgInt4 userId)
+ (sqlInt4 typeId)
+ (sqlInt4 userId)
(pgNodeId <$> parentId)
- (pgStrictText name)
+ (sqlStrictText name)
Nothing
(pgJSONB $ cs $ encode hyperData)
where
ns' :: [NodeWrite]
ns' = map (\(Node i t u p n d h)
-> Node (pgNodeId <$> i)
- (pgInt4 $ toDBid t)
- (pgInt4 u)
+ (sqlInt4 $ toDBid t)
+ (sqlInt4 u)
(pgNodeId <$> p)
- (pgStrictText n)
+ (sqlStrictText n)
(pgUTCTime <$> d)
(pgJSONB $ cs $ encode h)
) ns
runInsert_ conn (Insert nodeTable ns (rReturning (\(Node i _ _ _ _ _ _ _) -> i)) Nothing)
insertNodesWithParent :: Maybe ParentId -> [NodeWrite] -> Cmd err Int64
-insertNodesWithParent pid ns = insertNodes (set node_parentId (pgNodeId <$> pid) <$> ns)
+insertNodesWithParent pid ns = insertNodes (set node_parent_id (pgNodeId <$> pid) <$> ns)
insertNodesWithParentR :: Maybe ParentId -> [NodeWrite] -> Cmd err [NodeId]
-insertNodesWithParentR pid ns = insertNodesR (set node_parentId (pgNodeId <$> pid) <$> ns)
+insertNodesWithParentR pid ns = insertNodesR (set node_parent_id (pgNodeId <$> pid) <$> ns)
------------------------------------------------------------------------
-- TODO
-- currently this function removes the child relation
node2table :: HasDBid NodeType
=> UserId -> Maybe ParentId -> Node' -> NodeWrite
-node2table uid pid (Node' nt txt v []) = Node Nothing Nothing (pgInt4 $ toDBid nt) (pgInt4 uid) (fmap pgNodeId pid) (pgStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v)
+node2table uid pid (Node' nt txt v []) = Node Nothing Nothing (sqlInt4 $ toDBid nt) (sqlInt4 uid) (fmap pgNodeId pid) (sqlStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v)
node2table _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet"
defaultList cId =
maybe (nodeError NoListFound) (pure . view node_id) . headMay =<< getListsWithParentId cId
+defaultListMaybe :: (HasNodeError err, HasDBid NodeType) => CorpusId -> Cmd err (Maybe NodeId)
+defaultListMaybe cId = headMay <$> map (view node_id ) <$> getListsWithParentId cId
getListsWithParentId :: HasDBid NodeType => NodeId -> Cmd err [Node HyperdataList]
getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)