[New Node] NodeTexts to Learn Texts and display it.

bin/gargantext-import/Main.hs

@@ -50,7 +50,7 @@ main = do
   let
     --tt = (Unsupervised EN 6 0 Nothing)
     tt = (Multi EN)
-    format = WOS -- CsvGargV3
+    format = CsvHalFormat --WOS -- CsvGargV3
     cmd :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
     cmd = flowCorpusFile (cs user) (Left (cs name :: Text)) (read limit :: Int) tt  format corpusPath
   {-

src/Gargantext/Database/Config.hs

@@ -46,6 +46,7 @@ nodeTypeId n =
     NodeCorpusV3  -> 3
     NodeCorpus    -> 30
     NodeAnnuaire  -> 31
+    NodeTexts     -> 40
     NodeDocument  -> 4
     NodeContact   -> 41
   --NodeSwap   -> 19

src/Gargantext/Database/Flow.hs

@@ -194,6 +194,7 @@ flowCorpusUser l userName corpusName ctype ids = do
   userListId  <- flowList userId userCorpusId ngs
   printDebug "userListId" userListId
   -- User Graph Flow
+  _ <- mkTexts  userCorpusId userId
   --_ <- mkGraph  userCorpusId userId
   --_ <- mkPhylo  userCorpusId userId
   --}

src/Gargantext/Database/Learn.hs

@@ -89,22 +89,18 @@ text (FacetDoc _ _ _ h _ _)  = title <> "" <> Text.take 100 abstr
 
 ---------------------------------------------------------------------------
 
-
 apply :: (FlowCmdM DevEnv GargError m) => FavOrTrash -> CorpusId -> [NodeId] -> m [Int]
 apply favTrash cId ns = case favTrash of
       IsFav   -> nodesToFavorite $ map (\n -> (cId, n, True)) ns
       IsTrash -> delDocs cId (Documents ns)
 
-
 moreLikeAndApply :: FlowCmdM DevEnv GargError m => FavOrTrash -> CorpusId -> m [Int]
 moreLikeAndApply ft cId = do
   priors <- getPriors ft cId
   moreLikeWithAndApply priors ft cId
 
-
 moreLikeWithAndApply :: FlowCmdM DevEnv GargError m => Events Bool -> FavOrTrash -> CorpusId -> m [Int]
 moreLikeWithAndApply priors ft cId = do
   ids <- map facetDoc_id <$> moreLikeWith priors ft cId
   apply ft cId ids
 
-

src/Gargantext/Database/Schema/Node.hs

@@ -434,6 +434,17 @@ nodeAnnuaireW maybeName maybeAnnuaire pId = node NodeAnnuaire name annuaire (Jus
     name     = maybe "Annuaire" identity maybeName
     annuaire = maybe defaultAnnuaire identity maybeAnnuaire
 
+
+------------------------------------------------------------------------
+arbitraryTexts :: HyperdataTexts
+arbitraryTexts = HyperdataTexts (Just "Preferences")
+
+nodeTextsW :: Maybe Name -> Maybe HyperdataList -> ParentId -> UserId -> NodeWrite
+nodeTextsW maybeName maybeList pId = node NodeList name list (Just pId)
+  where
+    name = maybe "Texts" identity maybeName
+    list = maybe arbitraryList identity maybeList
+
 ------------------------------------------------------------------------
 arbitraryList :: HyperdataList
 arbitraryList = HyperdataList (Just "Preferences")
@@ -441,7 +452,7 @@ arbitraryList = 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
+    name = maybe "Lists" identity maybeName
     list = maybe arbitraryList identity maybeList
 
                 --------------------
@@ -621,6 +632,9 @@ defaultList :: HasNodeError err => CorpusId -> Cmd err ListId
 defaultList cId =
   maybe (nodeError NoListFound) (pure . view node_id) . headMay =<< getListsWithParentId cId
 
+mkTexts :: ParentId -> UserId -> Cmd err [NodeId]
+mkTexts p u = insertNodesR [nodeTextsW Nothing Nothing p u]
+
 mkList :: HasNodeError err => ParentId -> UserId -> Cmd err [NodeId]
 mkList p u = insertNodesR [nodeListW Nothing Nothing p u]
 

src/Gargantext/Database/Tree.hs

@@ -98,7 +98,7 @@ dbTree rootId = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n) <$> runPGS
         FROM nodes AS c
         
         INNER JOIN tree AS s ON c.parent_id = s.id
-        WHERE c.typename IN (2,3,30,31,7,9,90)
+        WHERE c.typename IN (2,3,5,30,31,40,7,9,90)
       )
   SELECT * from tree;
   |] (Only rootId)

src/Gargantext/Database/Types/Node.hs

@@ -306,6 +306,12 @@ hyperdataCorpus = case decode corpusExample of
 instance Arbitrary HyperdataCorpus where
     arbitrary = pure hyperdataCorpus -- TODO
 
+------------------------------------------------------------------------
+data HyperdataTexts = HyperdataTexts { hyperdataTexts_desc    :: Maybe Text
+                                       } deriving (Show, Generic)
+$(deriveJSON (unPrefix "hyperdataTexts_") ''HyperdataTexts)
+
+instance Hyperdata HyperdataTexts
 ------------------------------------------------------------------------
 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title        :: !(Maybe Text)
                                            , hyperdataAnnuaire_desc         :: !(Maybe Text)
@@ -414,6 +420,7 @@ type NodeUser     = Node HyperdataUser
 type NodeFolder   = Node HyperdataFolder
 
 type NodeCorpus   = Node HyperdataCorpus
+type NodeTexts    = Node HyperdataTexts
 type NodeCorpusV3 = Node HyperdataCorpus
 type NodeDocument = Node HyperdataDocument
 
@@ -430,7 +437,7 @@ type NodeNotebook = Node HyperdataNotebook
 ------------------------------------------------------------------------
 data NodeType = NodeUser
               | NodeFolder
-              | NodeCorpus     | NodeCorpusV3 | NodeDocument
+              | NodeCorpus     | NodeCorpusV3 | NodeTexts | NodeDocument
               | NodeAnnuaire   | NodeContact
               | NodeGraph      | NodePhylo
               | NodeDashboard  | NodeChart