[DBFLOW/NGRAMS] mkNodeList (for groups and others: design ok).

src/Gargantext/Database/Flow.hs

@@ -153,7 +153,7 @@ insertToNodeNgrams m = insertNodeNgrams $ [ NodeNgram Nothing nId  ((_ngramsId
 -- insertInto NodeNgramsNgrams
 
 -- compute Candidate / Map
+-- ALTER TABLE nodes_nodes_ngrams ADD COLUMN typelist int;
 -- insertNodeNodeNgram
 
 -- get data of NgramsTable

src/Gargantext/Database/Node.hs

@@ -332,7 +332,6 @@ nodeFolderW maybeName maybeFolder pid = node NodeFolder name folder (Just pid)
     name   = maybe "Folder" identity maybeName
     folder = maybe defaultFolder identity maybeFolder
 ------------------------------------------------------------------------
-
 nodeCorpusW :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> NodeWrite'
 nodeCorpusW maybeName maybeCorpus pId = node NodeCorpus name corpus (Just pId)
   where
@@ -366,6 +365,15 @@ nodeContactW maybeName maybeContact aId = node NodeContact name contact (Just aI
     name    = maybe "Contact" identity maybeName
     contact = maybe defaultContact identity maybeContact
 ------------------------------------------------------------------------
+defaultList :: HyperdataList
+defaultList = HyperdataList (Just "Preferences")
+
+nodeListW :: Maybe Name -> Maybe HyperdataList -> ParentId -> UserId -> NodeWrite'
+nodeListW maybeName maybeList pId = node NodeList name list (Just pId)
+  where
+    name = maybe "Listes" identity maybeName
+    list = maybe defaultList identity maybeList
+
 ------------------------------------------------------------------------
 node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite'
 node nodeType name hyperData parentId userId = Node Nothing typeId userId parentId name Nothing byteData
@@ -497,8 +505,8 @@ type Name = Text
 
 mk'' :: NodeType -> Maybe ParentId -> UserId -> Name -> Cmd [Int]
 mk'' NodeUser Nothing uId name  = mkCmd $ \c -> mk' c NodeUser uId Nothing name
-mk'' NodeUser _       _   _     = panic "NodeUser can not has a parent"
-mk'' _        Nothing _   _     = panic "NodeType needs a parent"
+mk'' NodeUser _       _   _     = panic "NodeUser do not have any parent"
+mk'' _        Nothing _   _     = panic "NodeType does   have a   parent"
 mk'' nt       pId     uId name  = mkCmd $ \c -> mk' c nt uId pId name
 
 mkRoot :: UserId -> Cmd [Int]
@@ -509,6 +517,6 @@ mkRoot uId = case uId > 0 of
 mkCorpus :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> Cmd [Int]
 mkCorpus n h p u = insertNodesR' [nodeCorpusW n h p u]
 
---mkNodeGroupList :: Maybe HyperdataAny -> ParentId -> UserId -> Cmd [Int]
---mkNodeGroupList h p u = insertNodesR' [nodeCorpusW (Just "Group List" h p u)]
+mkList :: ParentId -> UserId -> Cmd [Int]
+mkList p u = insertNodesR' [nodeListW Nothing Nothing p u]
 

src/Gargantext/Database/Types/Node.hs

@@ -209,19 +209,18 @@ instance ToSchema Resource where
   declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
 
 ------------------------------------------------------------------------
-
 data HyperdataUser = HyperdataUser { hyperdataUser_language       :: Maybe Text
                                        } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
 
 instance Hyperdata HyperdataUser
-
+------------------------------------------------------------------------
 data HyperdataFolder = HyperdataFolder { hyperdataFolder_desc    :: Maybe Text
                                        } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
 
 instance Hyperdata HyperdataFolder
-
+------------------------------------------------------------------------
 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title        :: Maybe Text
                                        , hyperdataCorpus_desc         :: Maybe Text
                                        , hyperdataCorpus_query        :: Maybe Text
@@ -282,13 +281,14 @@ data HyperdataList = HyperdataList { hyperdataList_preferences   :: Maybe Text
 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
 
 instance Hyperdata HyperdataList
-
+------------------------------------------------------------------------
 data HyperdataScore = HyperdataScore { hyperdataScore_preferences   :: Maybe Text
                                    } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
 
 instance Hyperdata HyperdataScore
 
+------------------------------------------------------------------------
 
 data HyperdataResource = HyperdataResource { hyperdataResource_preferences   :: Maybe Text
                                    } deriving (Show, Generic)
@@ -296,6 +296,7 @@ $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
 
 instance Hyperdata HyperdataResource
 
+------------------------------------------------------------------------
 
 -- TODO add the Graph Structure here
 data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences   :: Maybe Text
@@ -303,6 +304,7 @@ data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences   :: Maybe Tex
 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
 
 instance Hyperdata HyperdataGraph
+------------------------------------------------------------------------
 
 -- TODO add the Graph Structure here
 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences   :: Maybe Text
@@ -311,7 +313,8 @@ $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
 
 instance Hyperdata HyperdataPhylo
 
--- | TODO FEATURE: Notebook saved in the node (to work with Python or Haskell)
+------------------------------------------------------------------------
+-- | TODO FEATURE: Notebook saved in the node
 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences   :: Maybe Text
                                    } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
@@ -319,7 +322,6 @@ $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
 instance Hyperdata HyperdataNotebook
 
 
-
 -- | NodePoly indicates that Node has a Polymorphism Type
 type Node json   = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json -- NodeVector
 
@@ -347,10 +349,10 @@ type NodeAnnuaire = Node HyperdataAnnuaire
 type NodeContact  = Node HyperdataContact
 
 ---- | Then a Node can be either a Graph or a Phylo or a Notebook
+type NodeList     = Node HyperdataList
 type NodeGraph    = Node HyperdataGraph
 type NodePhylo    = Node HyperdataPhylo
 type NodeNotebook = Node HyperdataNotebook
-
 ------------------------------------------------------------------------
 data NodeType = NodeUser 
               | NodeFolder
@@ -360,7 +362,7 @@ data NodeType = NodeUser
               | NodeGraph
               | NodeDashboard  | NodeChart
               -- | Classification
-              -- | Lists
+              | NodeList
               -- | Metrics
               deriving (Show, Read, Eq, Generic, Bounded, Enum)