Commit 76f0419f authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] getNodesWithParentId == children with null parent_id

parent 7384c431
...@@ -15,6 +15,7 @@ import Database.PostgreSQL.Simple.FromField ( Conversion ...@@ -15,6 +15,7 @@ import Database.PostgreSQL.Simple.FromField ( Conversion
, fromField , fromField
, returnError , returnError
) )
import Prelude hiding (null, id)
import Database.PostgreSQL.Simple.Internal (Field) import Database.PostgreSQL.Simple.Internal (Field)
import Control.Arrow (returnA) import Control.Arrow (returnA)
import Control.Lens.TH (makeLensesWith, abbreviatedFields) import Control.Lens.TH (makeLensesWith, abbreviatedFields)
...@@ -115,17 +116,29 @@ runGetNodes :: Connection -> Query NodeRead -> IO [Document] ...@@ -115,17 +116,29 @@ runGetNodes :: Connection -> Query NodeRead -> IO [Document]
runGetNodes = runQuery runGetNodes = runQuery
queryNodeTable :: Query NodeRead
queryNodeTable = queryTable nodeTable
selectNodeWithParentID :: Column (Nullable PGInt4) -> Query NodeRead -- NP check type
selectNodeWithParentID node_id = proc () -> do getNodesWithParentId :: Connection -> Int -> IO [Node Value]
getNodesWithParentId conn n = runQuery conn $ selectNodeWithParentID n
selectNodeWithParentID :: Int -> Query NodeRead
selectNodeWithParentID n = proc () -> do
row@(Node _id _tn _u p_id _n _d _h) <- queryNodeTable -< () row@(Node _id _tn _u p_id _n _d _h) <- queryNodeTable -< ()
-- restrict -< maybe (isNull p_id) (p_id .==) node_id restrict -< if n > 0
restrict -< p_id .== node_id then
p_id .== (toNullable $ pgInt4 n)
else
isNull p_id
returnA -< row returnA -< row
queryNodeTable :: Query NodeRead
queryNodeTable = queryTable nodeTable
selectNodesWithType :: Column PGInt4 -> Query NodeRead selectNodesWithType :: Column PGInt4 -> Query NodeRead
selectNodesWithType type_id = proc () -> do selectNodesWithType type_id = proc () -> do
row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< () row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
...@@ -140,16 +153,12 @@ getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value] ...@@ -140,16 +153,12 @@ getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value]
getNodesWithType conn type_id = do getNodesWithType conn type_id = do
runQuery conn $ selectNodesWithType type_id runQuery conn $ selectNodesWithType type_id
-- NP check type
getNodesWithParentId :: Connection -> Column (Nullable PGInt4) -> IO [Node Value]
getNodesWithParentId conn node_id = do
runQuery conn $ selectNodeWithParentID node_id
-- NP check type -- NP check type
getCorpusDocument :: Connection -> Column PGInt4 -> IO [Document] getCorpusDocument :: Connection -> Int -> IO [Document]
getCorpusDocument conn node_id = runQuery conn (selectNodeWithParentID $ toNullable node_id) getCorpusDocument conn n = runQuery conn (selectNodeWithParentID n)
-- NP check type -- NP check type
getProjectCorpora :: Connection -> Column (Nullable PGInt4) -> IO [Corpus] getProjectCorpora :: Connection -> Int -> IO [Corpus]
getProjectCorpora conn node_id = do getProjectCorpora conn node_id = do
runQuery conn $ selectNodeWithParentID node_id runQuery conn $ selectNodeWithParentID node_id
...@@ -37,7 +37,7 @@ type API = "roots" :> Get '[JSON] [Node Value] ...@@ -37,7 +37,7 @@ type API = "roots" :> Get '[JSON] [Node Value]
server :: Connection -> Server API server :: Connection -> Server API
server conn server conn
= liftIO (getNodesWithType conn 1) = liftIO (getNodesWithParentId conn 0)
:<|> nodeAPI conn :<|> nodeAPI conn
:<|> echo :<|> echo
:<|> upload :<|> upload
...@@ -71,8 +71,10 @@ api = Proxy ...@@ -71,8 +71,10 @@ api = Proxy
nodeAPI :: Connection -> NodeId -> Server NodeAPI nodeAPI :: Connection -> NodeId -> Server NodeAPI
nodeAPI conn id nodeAPI conn id
= liftIO (getNode conn id') = liftIO (getNode conn id')
:<|> liftIO (getNodesWithParentId conn (toNullable id')) :<|> liftIO (getNodesWithParentId conn id)
where id' = pgInt4 id where
id' = pgInt4 id
-- | Upload files -- | Upload files
-- TODO Is it possible to adapt the function according to iValue input ? -- TODO Is it possible to adapt the function according to iValue input ?
......
...@@ -31,7 +31,6 @@ data Language = EN | FR -- | DE | IT | SP ...@@ -31,7 +31,6 @@ data Language = EN | FR -- | DE | IT | SP
-- > ... add your language and help us to implement it (: -- > ... add your language and help us to implement it (:
-- All the Database is structred like a hierarchical Tree -- All the Database is structred like a hierarchical Tree
data Tree a = NodeT a [Tree a] data Tree a = NodeT a [Tree a]
deriving (Show, Read, Eq) deriving (Show, Read, Eq)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment