Commit 1b07704e authored by Alexandre Delanoë's avatar Alexandre Delanoë

[DB/Errors] DoesNotExist Node error (todo remove useless errors type).

parent 217e984e
...@@ -54,9 +54,9 @@ queryNodeSearchTable = queryTable nodeTableSearch ...@@ -54,9 +54,9 @@ queryNodeSearchTable = queryTable nodeTableSearch
selectNode :: Column PGInt4 -> Query NodeRead selectNode :: Column PGInt4 -> Query NodeRead
selectNode id = proc () -> do selectNode id = proc () -> do
row <- queryNodeTable -< () row <- queryNodeTable -< ()
restrict -< _node_id row .== id restrict -< _node_id row .== id
returnA -< row returnA -< row
runGetNodes :: Query NodeRead -> Cmd err [Node HyperdataAny] runGetNodes :: Query NodeRead -> Cmd err [Node HyperdataAny]
runGetNodes = runOpaQuery runGetNodes = runOpaQuery
...@@ -67,7 +67,7 @@ runGetNodes = runOpaQuery ...@@ -67,7 +67,7 @@ runGetNodes = runOpaQuery
-- Favorites (Bool), node_ngrams -- Favorites (Bool), node_ngrams
selectNodesWith :: ParentId -> Maybe NodeType selectNodesWith :: ParentId -> Maybe NodeType
-> Maybe Offset -> Maybe Limit -> Query NodeRead -> Maybe Offset -> Maybe Limit -> Query NodeRead
selectNodesWith parentId maybeNodeType maybeOffset maybeLimit = selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
--offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId --offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
limit' maybeLimit $ offset' maybeOffset limit' maybeLimit $ offset' maybeOffset
$ orderBy (asc _node_id) $ orderBy (asc _node_id)
...@@ -154,11 +154,14 @@ getNodeWith nId _ = do ...@@ -154,11 +154,14 @@ getNodeWith nId _ = do
<$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId)) <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
getNodePhylo :: NodeId -> Cmd err (Node HyperdataPhylo) getNodePhylo :: HasNodeError err
=> NodeId
-> Cmd err (Node HyperdataPhylo)
getNodePhylo nId = do getNodePhylo nId = do
fromMaybe (error $ "Node Phylo does not exist: " <> show nId) . headMay res <- headMay <$> runOpaQuery (selectNode (pgNodeId nId))
<$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId)) case res of
Nothing -> nodeError (DoesNotExist nId)
Just r -> pure r
getNodesWithType :: Column PGInt4 -> Cmd err [Node HyperdataDocument] getNodesWithType :: Column PGInt4 -> Cmd err [Node HyperdataDocument]
getNodesWithType = runOpaQuery . selectNodesWithType getNodesWithType = runOpaQuery . selectNodesWithType
...@@ -293,15 +296,20 @@ nodePhyloW maybeName maybePhylo pId = node NodePhylo name graph (Just pId) ...@@ -293,15 +296,20 @@ nodePhyloW maybeName maybePhylo pId = node NodePhylo name graph (Just pId)
name = maybe "Phylo" identity maybeName name = maybe "Phylo" identity maybeName
graph = maybe arbitraryPhylo identity maybePhylo graph = maybe arbitraryPhylo identity maybePhylo
------------------------------------------------------------------------ ------------------------------------------------------------------------
arbitraryDashboard :: HyperdataDashboard arbitraryDashboard :: HyperdataDashboard
arbitraryDashboard = HyperdataDashboard (Just "Preferences") [] arbitraryDashboard = HyperdataDashboard (Just "Preferences") []
------------------------------------------------------------------------ ------------------------------------------------------------------------
node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite node :: (ToJSON a, Hyperdata a)
=> NodeType
-> Name
-> a
-> Maybe ParentId
-> UserId
-> NodeWrite
node nodeType name hyperData parentId userId = node nodeType name hyperData parentId userId =
Node Nothing Node Nothing
(pgInt4 typeId) (pgInt4 typeId)
(pgInt4 userId) (pgInt4 userId)
(pgNodeId <$> parentId) (pgNodeId <$> parentId)
...@@ -355,7 +363,8 @@ data Node' = Node' { _n_type :: NodeType ...@@ -355,7 +363,8 @@ data Node' = Node' { _n_type :: NodeType
} deriving (Show) } deriving (Show)
mkNodes :: [NodeWrite] -> Cmd err Int64 mkNodes :: [NodeWrite] -> Cmd err Int64
mkNodes ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns rCount Nothing mkNodes ns = mkCmd $ \conn -> runInsert_ conn
$ Insert nodeTable ns rCount Nothing
mkNodeR :: [NodeWrite] -> Cmd err [NodeId] mkNodeR :: [NodeWrite] -> Cmd err [NodeId]
mkNodeR ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns (rReturning _node_id) Nothing mkNodeR ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns (rReturning _node_id) Nothing
...@@ -365,7 +374,11 @@ mkNodeR ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns (rReturning ...@@ -365,7 +374,11 @@ mkNodeR ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns (rReturning
data NewNode = NewNode { _newNodeId :: NodeId data NewNode = NewNode { _newNodeId :: NodeId
, _newNodeChildren :: [NodeId] } , _newNodeChildren :: [NodeId] }
postNode :: HasNodeError err => UserId -> Maybe ParentId -> Node' -> Cmd err NewNode postNode :: HasNodeError err
=> UserId
-> Maybe ParentId
-> Node'
-> Cmd err NewNode
postNode uid pid (Node' nt txt v []) = do postNode uid pid (Node' nt txt v []) = do
pids <- mkNodeR [node2table uid pid (Node' nt txt v [])] pids <- mkNodeR [node2table uid pid (Node' nt txt v [])]
......
...@@ -26,6 +26,7 @@ Portability : POSIX ...@@ -26,6 +26,7 @@ Portability : POSIX
module Gargantext.Database.Query.Table.Node.Error where module Gargantext.Database.Query.Table.Node.Error where
import Gargantext.Database.Admin.Types.Node (NodeId)
import Control.Lens (Prism', (#), (^?)) import Control.Lens (Prism', (#), (^?))
import Control.Monad.Error.Class (MonadError(..)) import Control.Monad.Error.Class (MonadError(..))
import Gargantext.Prelude hiding (sum, head) import Gargantext.Prelude hiding (sum, head)
...@@ -43,6 +44,7 @@ data NodeError = NoListFound ...@@ -43,6 +44,7 @@ data NodeError = NoListFound
| NegativeId | NegativeId
| NotImplYet | NotImplYet
| ManyNodeUsers | ManyNodeUsers
| DoesNotExist NodeId
instance Show NodeError instance Show NodeError
where where
...@@ -58,6 +60,7 @@ instance Show NodeError ...@@ -58,6 +60,7 @@ instance Show NodeError
show NotImplYet = "Not implemented yet" show NotImplYet = "Not implemented yet"
show ManyParents = "Too many parents" show ManyParents = "Too many parents"
show ManyNodeUsers = "Many userNode/user" show ManyNodeUsers = "Many userNode/user"
show (DoesNotExist n) = "Node does not exist" <> show n
class HasNodeError e where class HasNodeError e where
_NodeError :: Prism' e NodeError _NodeError :: Prism' e NodeError
......
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