Commit caef0e8b authored by Karen Konou's avatar Karen Konou

[NodePoly] Maybe ParentID in NodePoly

parent 70f28cf3
Pipeline #2909 failed with stage
in 0 seconds
...@@ -86,7 +86,7 @@ defaultNodeDocumentV3 = ...@@ -86,7 +86,7 @@ defaultNodeDocumentV3 =
NodePoly { id : 0 NodePoly { id : 0
, typename : 0 , typename : 0
, userId : 0 , userId : 0
, parentId : 0 , parentId : Just 0
, name : "Default name" , name : "Default name"
, date : "Default date" , date : "Default date"
, hyperdata : defaultDocumentV3 , hyperdata : defaultDocumentV3
...@@ -148,7 +148,7 @@ defaultNodeDocument = ...@@ -148,7 +148,7 @@ defaultNodeDocument =
NodePoly { id : 0 NodePoly { id : 0
, typename : 0 , typename : 0
, userId : 0 , userId : 0
, parentId : 0 , parentId : Just 0
, name : "Default name" , name : "Default name"
, date : "Default date" , date : "Default date"
, hyperdata : defaultDocument , hyperdata : defaultDocument
......
module Gargantext.Components.Node module Gargantext.Components.Node
where where
import Data.Generic.Rep (class Generic) import Gargantext.Prelude
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe) import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Simple.JSON as JSON import Simple.JSON as JSON
import Gargantext.Prelude
type NodePolyCommon a = type NodePolyCommon a =
( id :: Int ( id :: Int
, typename :: Int , typename :: Int
...@@ -18,7 +18,7 @@ type NodePolyCommon a = ...@@ -18,7 +18,7 @@ type NodePolyCommon a =
newtype NodePoly a = newtype NodePoly a =
NodePoly { userId :: Int NodePoly { userId :: Int
, parentId :: Int , parentId :: Maybe Int
| NodePolyCommon a | NodePolyCommon a
} }
derive instance Generic (NodePoly a) _ derive instance Generic (NodePoly a) _
...@@ -26,7 +26,7 @@ derive instance Newtype (NodePoly a) _ ...@@ -26,7 +26,7 @@ derive instance Newtype (NodePoly a) _
instance Eq a => Eq (NodePoly a) where eq = genericEq instance Eq a => Eq (NodePoly a) where eq = genericEq
instance JSON.ReadForeign a => JSON.ReadForeign (NodePoly a) where instance JSON.ReadForeign a => JSON.ReadForeign (NodePoly a) where
readImpl f = do readImpl f = do
inst :: { user_id :: Int, parent_id :: Int | NodePolyCommon a } <- JSON.readImpl f inst :: { user_id :: Int, parent_id :: Maybe Int | NodePolyCommon a } <- JSON.readImpl f
pure $ NodePoly { id: inst.id pure $ NodePoly { id: inst.id
, typename: inst.typename , typename: inst.typename
, userId: inst.user_id , userId: inst.user_id
......
...@@ -387,8 +387,8 @@ loadCorpus {nodeId, session} = do ...@@ -387,8 +387,8 @@ loadCorpus {nodeId, session} = do
case res of case res of
Left err -> pure $ Left err Left err -> pure $ Left err
Right (NodePoly {parentId: corpusId} :: NodePoly {}) -> do Right (NodePoly {parentId: corpusId} :: NodePoly {}) -> do
eCorpusNode <- get session $ corpusNodeRoute corpusId "" eCorpusNode <- get session $ corpusNodeRoute (fromMaybe 0 corpusId) ""
eDefaultListIds <- (get session $ defaultListIdsRoute corpusId) eDefaultListIds <- (get session $ defaultListIdsRoute (fromMaybe 0 corpusId))
:: forall a. JSON.ReadForeign a => AffETableResult (NodePoly a) :: forall a. JSON.ReadForeign a => AffETableResult (NodePoly a)
case eCorpusNode of case eCorpusNode of
Left err -> pure $ Left err Left err -> pure $ Left err
...@@ -398,7 +398,7 @@ loadCorpus {nodeId, session} = do ...@@ -398,7 +398,7 @@ loadCorpus {nodeId, session} = do
Right defaultListIds -> do Right defaultListIds -> do
case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) -> Just (NodePoly { id: defaultListId }) ->
pure $ Right { corpusId, corpusNode, defaultListId } pure $ Right { corpusId: (fromMaybe 0 corpusId), corpusNode, defaultListId }
Nothing -> Nothing ->
pure $ Left $ CustomError "Missing default list" pure $ Left $ CustomError "Missing default list"
...@@ -425,18 +425,18 @@ loadCorpusWithChild { nodeId: childId, session } = do ...@@ -425,18 +425,18 @@ loadCorpusWithChild { nodeId: childId, session } = do
Left err -> pure $ Left err Left err -> pure $ Left err
Right listNode -> do Right listNode -> do
let (NodePoly {parentId: corpusId} :: NodePoly {}) = listNode let (NodePoly {parentId: corpusId} :: NodePoly {}) = listNode
eCorpusNode <- get session $ corpusNodeRoute corpusId "" eCorpusNode <- get session $ corpusNodeRoute (fromMaybe 0 corpusId) ""
case eCorpusNode of case eCorpusNode of
Left err -> pure $ Left err Left err -> pure $ Left err
Right corpusNode -> do Right corpusNode -> do
eDefaultListIds <- (get session $ defaultListIdsRoute corpusId) eDefaultListIds <- (get session $ defaultListIdsRoute (fromMaybe 0 corpusId))
:: forall a. JSON.ReadForeign a => AffETableResult (NodePoly a) :: forall a. JSON.ReadForeign a => AffETableResult (NodePoly a)
case eDefaultListIds of case eDefaultListIds of
Left err -> pure $ Left err Left err -> pure $ Left err
Right defaultListIds -> do Right defaultListIds -> do
case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) -> Just (NodePoly { id: defaultListId }) ->
pure $ Right { corpusId, corpusNode, defaultListId } pure $ Right { corpusId: fromMaybe 0 corpusId, corpusNode, defaultListId }
Nothing -> Nothing ->
throwError $ error "Missing default list" throwError $ error "Missing default list"
where where
......
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