import Data.Aeson
import Data.Maybe (fromMaybe)
import Data.Text (Text)
-import qualified Database.PostgreSQL.Simple as DPS
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Opaleye hiding (FromField)
import Prelude hiding (null, id, map, sum)
import Gargantext.Database.Schema.Node
import Gargantext.Prelude hiding (sum, head)
+import qualified Database.PostgreSQL.Simple as PGS
+
+
queryNodeSearchTable :: Select NodeSearchRead
queryNodeSearchTable = selectTable nodeTableSearch
-> NodeType
-> Cmd err (Maybe NodeId)
getClosestParentIdByType nId nType = do
- result <- runPGSQuery query (nId, 0 :: Int)
+ result <- runPGSQuery query (PGS.Only nId)
case result of
[(NodeId parentId, pTypename)] -> do
if toDBid nType == pTypename then
getClosestParentIdByType (NodeId parentId) nType
_ -> pure Nothing
where
- query :: DPS.Query
+ query :: PGS.Query
query = [sql|
SELECT n2.id, n2.typename
FROM nodes n1
JOIN nodes n2 ON n1.parent_id = n2.id
- WHERE n1.id = ? AND 0 = ?;
+ WHERE n1.id = ?;
|]
-- | Similar to `getClosestParentIdByType` but includes current node
-> NodeType
-> Cmd err (Maybe NodeId)
getClosestParentIdByType' nId nType = do
- result <- runPGSQuery query (nId, 0 :: Int)
+ result <- runPGSQuery query (PGS.Only nId)
case result of
[(NodeId id, pTypename)] -> do
if toDBid nType == pTypename then
getClosestParentIdByType nId nType
_ -> pure Nothing
where
- query :: DPS.Query
+ query :: PGS.Query
query = [sql|
SELECT n.id, n.typename
FROM nodes n
- WHERE n.id = ? AND 0 = ?;
+ WHERE n.id = ?;
|]
-- | Given a node id, find all it's children (no matter how deep) of
-> NodeType
-> Cmd err [NodeId]
getChildrenByType nId nType = do
- result <- runPGSQuery query (nId, 0 :: Int)
+ result <- runPGSQuery query (PGS.Only nId)
children_lst <- mapM (\(id, _) -> getChildrenByType id nType) result
pure $ concat $ [fst <$> filter (\(_, pTypename) -> pTypename == toDBid nType) result] ++ children_lst
where
- query :: DPS.Query
+ query :: PGS.Query
query = [sql|
SELECT n.id, n.typename
FROM nodes n
- WHERE n.parent_id = ? AND 0 = ?;
+ WHERE n.parent_id = ?;
|]
------------------------------------------------------------------------
------------------------------------------------------------------------
nodeExists :: (HasNodeError err) => NodeId -> Cmd err Bool
-nodeExists nId = (== [DPS.Only True])
- <$> runPGSQuery [sql|SELECT true FROM nodes WHERE id = ? AND ?|] (nId, True)
+nodeExists nId = (== [PGS.Only True])
+ <$> runPGSQuery [sql|SELECT true FROM nodes WHERE id = ? |] (PGS.Only nId)
getNode :: HasNodeError err => NodeId -> Cmd err (Node Value)
getNode nId = do
getListsWithParentId :: HasDBid NodeType => NodeId -> Cmd err [Node HyperdataList]
getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)
-