[FEAT] Text Flow with NoList built as option

src/Gargantext/API/Node/Corpus/New.hs

@@ -236,7 +236,7 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
                              }
 
           cids <- mapM (\txt -> do
-                           flowDataText user txt (Multi l) cid Nothing logStatus) txts
+                           flowDataText user txt (Multi l) cid (Just flw) logStatus) txts
           printDebug "corpus id" cids
           printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text)
           sendMail user
@@ -274,7 +274,7 @@ addToCorpusWithForm :: (FlowCmdM env err m)
                     -> (JobLog -> m ())
                     -> JobLog
                     -> m JobLog
-addToCorpusWithForm user cid (NewWithForm ft ff d l _n) logStatus jobLog = do
+addToCorpusWithForm user cid (NewWithForm ft ff d l _n sel) logStatus jobLog = do
   printDebug "[addToCorpusWithForm] Parsing corpus: " cid
   printDebug "[addToCorpusWithForm] fileType" ft
   printDebug "[addToCorpusWithForm] fileFormat" ff
@@ -325,7 +325,7 @@ addToCorpusWithForm user cid (NewWithForm ft ff d l _n) logStatus jobLog = do
       _cid' <- flowCorpus user
                           (Right [cid])
                           (Multi $ fromMaybe EN l)
-                          Nothing
+                          (Just sel)
                           --(Just $ fromIntegral $ length docs, docsC')
                           (mCount, transPipe liftBase docsC') -- TODO fix number of docs
                           --(map (map toHyperdataDocument) docs)

src/Gargantext/API/Node/FrameCalcUpload.hs

@@ -24,6 +24,7 @@ import Gargantext.API.Node.Corpus.New.Types (FileFormat(..), FileType(..))
 import Gargantext.API.Node.Types (NewWithForm(..))
 import Gargantext.API.Prelude
 import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Core.Text.List.Social (FlowSocialListWith(..), FlowSocialListPriority(..))
 import Gargantext.Database.Action.Flow.Types
 import Gargantext.Database.Admin.Types.Hyperdata.Frame
 import Gargantext.Database.Admin.Types.Node
@@ -87,6 +88,6 @@ frameCalcUploadAsync uId nId _f logStatus jobLog = do
   jobLog2 <- case mCId of
     Nothing -> pure $ jobLogFail jobLog
     Just cId ->
-      addToCorpusWithForm (RootId (NodeId uId)) cId (NewWithForm CSV Plain body Nothing "calc-upload.csv") logStatus jobLog
+      addToCorpusWithForm (RootId (NodeId uId)) cId (NewWithForm CSV Plain body Nothing "calc-upload.csv" (FlowSocialListWithPriority MySelfFirst)) logStatus jobLog
 
   pure $ jobLogSuccess jobLog2

src/Gargantext/API/Node/Types.hs

@@ -20,6 +20,7 @@ import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
 import Gargantext.Prelude
 import qualified Gargantext.Database.GargDB as GargDB
 import Gargantext.API.Node.Corpus.New.Types (FileType, FileFormat)
+import Gargantext.Core.Text.List.Social (FlowSocialListWith)
 
 -------------------------------------------------------
 data NewWithForm = NewWithForm
@@ -28,6 +29,7 @@ data NewWithForm = NewWithForm
   , _wf_data       :: !Text    -- NOTE for binary files, this represents base-64 data
   , _wf_lang       :: !(Maybe Lang)
   , _wf_name       :: !Text
+  , _wf_selection  :: !FlowSocialListWith
   } deriving (Eq, Show, Generic)
 
 makeLenses ''NewWithForm
@@ -43,9 +45,9 @@ instance ToSchema NewWithForm where
 -------------------------------------------------------
 
 data NewWithFile = NewWithFile
-  { _wfi_b64_data :: !Text
-  , _wfi_lang     :: !(Maybe Lang)
-  , _wfi_name     :: !Text
+  { _wfi_b64_data  :: !Text
+  , _wfi_lang      :: !(Maybe Lang)
+  , _wfi_name      :: !Text
   } deriving (Eq, Show, Generic)
 
 makeLenses ''NewWithFile

src/Gargantext/Core/Text/List/Social.hs

@@ -20,6 +20,8 @@ import Data.Map (Map)
 import Data.Monoid (mconcat)
 import Data.Swagger
 import GHC.Generics
+
+import Web.Internal.HttpApiData (ToHttpApiData, FromHttpApiData, parseUrlPiece, toUrlPiece)
 import qualified Data.Scientific as Scientific
 import qualified Data.Text       as T
 import qualified Data.Vector     as V
@@ -50,37 +52,49 @@ import qualified Prelude
 
 data FlowSocialListWith = FlowSocialListWithPriority { fslw_priority :: FlowSocialListPriority }
                         | FlowSocialListWithLists    { fslw_lists :: [ListId] }
-  deriving (Show, Generic)
+                        | NoList { makeList :: Bool }
+
+  deriving (Eq, Show, Generic)
 instance FromJSON FlowSocialListWith where
   parseJSON (Object v) = do
     typ :: T.Text <- v .: "type"
     value <- v .:? "value" .!= []
     case typ of
-      "MyListsFirst" -> pure $ FlowSocialListWithPriority { fslw_priority = MySelfFirst }
-      "OtherListsFirst" -> pure $ FlowSocialListWithPriority { fslw_priority = OthersFirst }
-      "SelectedLists" -> pure $ FlowSocialListWithLists { fslw_lists = value }
-      _ -> pure $ FlowSocialListWithPriority { fslw_priority = MySelfFirst }
+      "MyListsFirst"     -> pure $ FlowSocialListWithPriority { fslw_priority = MySelfFirst }
+      "OtherListsFirst"  -> pure $ FlowSocialListWithPriority { fslw_priority = OthersFirst }
+      "SelectedLists"    -> pure $ FlowSocialListWithLists { fslw_lists = value }
+      "NoList"           -> pure $ NoList True
+      _                  -> pure $ FlowSocialListWithPriority { fslw_priority = MySelfFirst }
   parseJSON _ = mzero
 instance ToJSON FlowSocialListWith where
-  toJSON (FlowSocialListWithPriority { fslw_priority = MySelfFirst }) =
-    object [ ("type", String "MyListsFirst") ]
-  toJSON (FlowSocialListWithPriority { fslw_priority = OthersFirst }) =
-    object [ ("type", String "ListsFirst") ]
-  toJSON (FlowSocialListWithLists { fslw_lists = ids }) =
-    object [ ("type", String "SelectedLists")
-           , ("value", Array $ V.fromList $ (map (\(NodeId id) -> Number $ Scientific.scientific (Prelude.toInteger id) 1) ids)) ]
+  toJSON (FlowSocialListWithPriority { fslw_priority = MySelfFirst }) = object [ ("type", String "MyListsFirst") ]
+  toJSON (FlowSocialListWithPriority { fslw_priority = OthersFirst }) = object [ ("type", String "ListsFirst") ]
+  toJSON (NoList _) = object [ ("type", String "NoList") ]
+  toJSON (FlowSocialListWithLists { fslw_lists = ids }) = object [ ("type", String "SelectedLists")
+                                                                 , ("value", Array $ V.fromList $ (map (\(NodeId id) -> Number $ Scientific.scientific (Prelude.toInteger id) 1) ids)) ]
 instance ToSchema FlowSocialListWith where
   declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
+instance FromHttpApiData FlowSocialListWith
+  where
+    parseUrlPiece "MyListsFirst"    = pure $ FlowSocialListWithPriority { fslw_priority = MySelfFirst }
+    parseUrlPiece "OtherListsFirst" = pure $ FlowSocialListWithPriority { fslw_priority = OthersFirst }
+    parseUrlPiece "NoList"          = pure $ NoList True
+    parseUrlPiece _                 = panic "[G.C.T.L.Social] TODO FromHttpApiData FlowSocialListWith"
+
+instance ToHttpApiData   FlowSocialListWith where
+    toUrlPiece (FlowSocialListWithPriority  MySelfFirst) = "MySelfFirst"
+    toUrlPiece (FlowSocialListWithPriority  OthersFirst) = "OtherListsFirst"
+    toUrlPiece (NoList _) = "NoList" 
+    toUrlPiece (FlowSocialListWithLists _)  = panic "[G.C.T.L.Social] TODO ToHttpApiData FlowSocialListWith"
 
 data FlowSocialListPriority = MySelfFirst | OthersFirst
-  deriving (Show, Generic)
+  deriving (Eq, Show, Generic)
 instance ToSchema FlowSocialListPriority where
   declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
 
 flowSocialListPriority :: FlowSocialListPriority -> [NodeMode]
 flowSocialListPriority MySelfFirst = [Private{-, Shared, Public -}]
 flowSocialListPriority OthersFirst = reverse $ flowSocialListPriority MySelfFirst
-
 {-
 -- | We keep the parents for all ngrams but terms
 keepAllParents :: NgramsType -> KeepAllParents
@@ -102,6 +116,7 @@ flowSocialList :: ( HasNodeStory env err m
 flowSocialList Nothing u = flowSocialList' MySelfFirst u
 flowSocialList (Just (FlowSocialListWithPriority p)) u = flowSocialList' p u
 flowSocialList (Just (FlowSocialListWithLists    ls)) _ = getHistoryScores ls History_User
+flowSocialList (Just (NoList _)) _u = panic "[G.C.T.L.Social] Should not be executed"
 
 flowSocialList' :: ( HasNodeStory env err m
                    , CmdM     env err m

src/Gargantext/Database/Action/Flow.hs

@@ -81,7 +81,7 @@ import Gargantext.Core.Text
 import Gargantext.Core.Text.Corpus.Parsers (parseFile, FileFormat, FileType)
 import Gargantext.Core.Text.List (buildNgramsLists)
 import Gargantext.Core.Text.List.Group.WithStem ({-StopSize(..),-} GroupParams(..))
-import Gargantext.Core.Text.List.Social (FlowSocialListWith)
+import Gargantext.Core.Text.List.Social (FlowSocialListWith(..))
 import Gargantext.Core.Text.Terms
 import Gargantext.Core.Text.Terms.Mono.Stem.En (stemIt)
 import Gargantext.Core.Types (POS(NP), TermsCount)
@@ -325,13 +325,19 @@ flowCorpusUser l user corpusName ctype ids mfslw = do
 
   --let gp = (GroupParams l 2 3 (StopSize 3))
   -- Here the PosTagAlgo should be chosen according to the Lang
-  let gp = GroupWithPosTag l CoreNLP HashMap.empty
-  ngs    <- buildNgramsLists user userCorpusId masterCorpusId mfslw gp
-
-  -- printDebug "flowCorpusUser:ngs" ngs
-
-  _userListId <- flowList_DbRepo listId ngs
-  _mastListId <- getOrMkList masterCorpusId masterUserId
+  _ <- case mfslw of 
+         (Just (NoList _)) -> do
+           printDebug "Do not build list" mfslw
+           pure ()
+         _ -> do
+           ngs  <- buildNgramsLists user userCorpusId masterCorpusId mfslw
+                     $ GroupWithPosTag l CoreNLP HashMap.empty
+
+         -- printDebug "flowCorpusUser:ngs" ngs
+
+           _userListId <- flowList_DbRepo listId ngs
+           _mastListId <- getOrMkList masterCorpusId masterUserId
+           pure ()
   -- _ <- insertOccsUpdates userCorpusId mastListId
   -- printDebug "userListId" userListId
   -- User Graph Flow