Merge remote-tracking branch 'origin/718-dev-subcorpus-frontend' into dev

src/Gargantext/Components/DocsTable.purs

@@ -3,11 +3,12 @@ module Gargantext.Components.DocsTable where
 
 import Gargantext.Prelude
 
+import CSS (query)
 import DOM.Simple.Event as DE
-import Data.Array (any)
 import Data.Array as A
+import Data.Either (Either(..))
 import Data.Generic.Rep (class Generic)
-import Data.Lens ((^.))
+import Data.Lens (is, re, (^.))
 import Data.Lens.At (at)
 import Data.Lens.Record (prop)
 import Data.Map as Map
@@ -20,32 +21,30 @@ import Data.String as Str
 import Data.Tuple (Tuple(..))
 import Data.Tuple.Nested ((/\))
 import Effect (Effect)
-import Effect.Aff (Aff, launchAff_)
+import Effect.Aff (launchAff_)
 import Effect.Class (liftEffect)
-import Effect.Timer (setTimeout)
-import Gargantext.AsyncTasks as GAT
 import Gargantext.Components.App.Store as Store
 import Gargantext.Components.Bootstrap as B
-import Gargantext.Components.Bootstrap.Types (ComponentStatus(..), ModalSizing(..), Variant(..))
+import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), ComponentStatus(..), ModalSizing(..), Variant(..), SpinnerTheme(..))
 import Gargantext.Components.Category (ratingSimple)
 import Gargantext.Components.Category.Types (Category(..), cat2score, markCategoryChecked)
 import Gargantext.Components.DocsTable.DocumentFormCreation as DFC
-import Gargantext.Components.DocsTable.Types (DocumentsView(..), Hyperdata(..), LocalCategories, Query, Response(..), Year, sampleData, showSource)
+import Gargantext.Components.DocsTable.SubcorpusCreation (subcorpusCreation)
+import Gargantext.Components.DocsTable.Types (DocumentsView(..), Hyperdata(..), LocalCategories, Query, Response(..), SubcorpusParams(..), Year, createSubCorpus, sampleData, showSource)
 import Gargantext.Components.GraphQL.Endpoints (updateNodeContextCategory)
+import Gargantext.Components.Modal (modal)
 import Gargantext.Components.Nodes.Lists.Types as NT
 import Gargantext.Components.Reload (textsReloadContext)
 import Gargantext.Components.Table as TT
 import Gargantext.Components.Table.Types as TT
 import Gargantext.Config.REST (AffRESTError)
-import Gargantext.Config.Utils (handleRESTError)
 import Gargantext.Ends (Frontends, url)
 import Gargantext.Hooks.LinkHandler (useLinkHandler)
 import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..))
-import Gargantext.Routes (SessionRoute(NodeAPI))
+import Gargantext.Routes (SessionRoute(..))
 import Gargantext.Routes as Routes
-import Gargantext.Sessions (Session, sessionId, get, delete)
+import Gargantext.Sessions (Session, delete, get, sessionId)
 import Gargantext.Types (ListId, NodeID, NodeType(..), OrderBy(..), SidePanelState(..), TabSubType, TabType, TableResult, showTabType')
-import Gargantext.Types as GT
 import Gargantext.Utils (sortWith, (?))
 import Gargantext.Utils.CacheAPI as GUC
 import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParamS, mQueryParamS', queryParam, queryParamS)
@@ -147,12 +146,15 @@ docViewCpt = R2.hereComponent here "docView" hCpt
     }
     _ = do
     -- State
-    { errors } <- Store.use
+    { errors, reloadForest } <- Store.use
     cacheState' <- T.useLive T.unequal cacheState
     query' <- T.useLive T.unequal query
     isDocumentModalVisibleBox <- T.useBox false
+    isSubcorpusModalVisibleBox <- T.useBox false
     onDocumentCreationPending /\ onDocumentCreationPendingBox <-
       R2.useBox' false
+    onSubcorpusCreationPending' /\ onSubcorpusCreationPending <- R2.useBox' false
+    { goToRoute } <- useLinkHandler
 
     -- Context
     mReloadContext <- R.useContext textsReloadContext
@@ -181,6 +183,22 @@ docViewCpt = R2.hereComponent here "docView" hCpt
 
       liftEffect $ here.log "[docView] TODO onCreateDocumentEnd handler"
 
+    createSubcorpusCallback <- pure $ \q p -> launchAff_ do
+
+      liftEffect $
+        T.write_ true onSubcorpusCreationPending
+
+      case mCorpusId of
+        Nothing -> liftEffect $ here.warn2 "[docsTable subCorpusButton RESTError]" mCorpusId
+        Just cId -> do
+          res <- createSubCorpus session cId $ SubcorpusParams { query: q, reuseParentList: p }
+          liftEffect $ do
+            case res of
+              Left err -> here.warn2 "[docsTable subCorpusButton RESTError]" err
+              Right id -> do
+                T2.reload reloadForest
+                goToRoute $ Routes.Corpus (sessionId session) id
+
     -- handleRESTError hp errors eTask
     --   \t -> liftEffect $ launchDocumentCreationProgress
     --                         errors
@@ -208,7 +226,7 @@ docViewCpt = R2.hereComponent here "docView" hCpt
                         ]
                     ]
                 , H.div { className: "form-group" }
-                    [ if showSearch then searchBar { query } [] else H.div {} [] ]
+                    [ if showSearch then searchBar { query, isSubcorpusModalVisibleBox, onSubcorpusCreationPending' } [] else H.div {} [] ]
                 ]
 
             , R2.row
@@ -245,6 +263,20 @@ docViewCpt = R2.hereComponent here "docView" hCpt
                 , status: onDocumentCreationPending ? Deferred $ Enabled
                 }
             ]
+        ,
+          -- Subcorpus Creation Modal
+          B.baseModal
+            { isVisibleBox: isSubcorpusModalVisibleBox
+            , title: Just "Create a subcorpus"
+            , hasCollapsibleBackground: false
+            , size: MediumModalSize
+            }
+            [ subcorpusCreation
+                { callback: createSubcorpusCallback
+                , query'
+                , onSubcorpusCreationPending'
+                }
+            ]
         ]
 
 -- launchDocumentCreationProgress ::
@@ -289,7 +321,7 @@ docViewCpt = R2.hereComponent here "docView" hCpt
 ---------------------------------------------------
 
 type SearchBarProps =
-  (query :: T.Box Query)
+  (query :: T.Box Query, isSubcorpusModalVisibleBox :: T.Box Boolean, onSubcorpusCreationPending' :: Boolean)
 
 searchBar :: R2.Component SearchBarProps
 searchBar = R.createElement searchBarCpt
@@ -297,33 +329,45 @@ searchBar = R.createElement searchBarCpt
 searchBarCpt :: R.Component SearchBarProps
 searchBarCpt = here.component "searchBar" cpt
   where
-  cpt { query } _children = do
+  cpt { query, isSubcorpusModalVisibleBox, onSubcorpusCreationPending' } _children = do
     query' <- T.useLive T.unequal query
     queryText <- T.useBox query'
     queryText' <- T.useLive T.unequal queryText
 
-    pure $ H.div { className: "input-group px-5" }
-      [ H.input
-          { className: "form-control"
-          , id: "docs-input-search"
-          , defaultValue: query'
-          , on:
-              { change: onSearchChange queryText
-              , keyUp: onSearchKeyup query queryText'
+    pure $ R.fragment
+      [ H.div { className: "input-group px-5" }
+          [ H.input
+              { className: "form-control"
+              , id: "docs-input-search"
+              , defaultValue: query'
+              , on:
+                  { change: onSearchChange queryText
+                  , keyUp: onSearchKeyup query queryText'
+                  }
+              , placeholder: "Search in documents"
+              , type: "text"
               }
-          , placeholder: "Search in documents"
-          , type: "text"
-          }
-      , H.div { className: "input-group-append" }
-          [ if query' /= "" then
-              R.fragment
-                [ clearButton query
-                , searchButton query queryText'
-                ]
-            else
-              searchButton query queryText'
+          , H.div { className: "input-group-append" }
+              [ if query' /= "" then
+                  R.fragment
+                    [ clearButton query
+                    , searchButton query queryText'
+                    , subCorpusButton isSubcorpusModalVisibleBox queryText' query
+                    ]
+                else
+                  R.fragment
+                    [ searchButton query queryText'
+                    , subCorpusButton isSubcorpusModalVisibleBox queryText' query
+                    ]
+              ]
+          , H.div { className: "input-group-append" }
+              [ R2.when' onSubcorpusCreationPending'
+                  [ B.spinner
+                      { theme: BorderTheme }
+                  ]
+              ]
+          -- , H.div {className: "col-md-1"} [ searchButton query queryText' ]
           ]
-      -- , H.div {className: "col-md-1"} [ searchButton query queryText' ]
       ]
 
   onSearchChange :: forall e. T.Box Query -> e -> Effect Unit
@@ -352,6 +396,19 @@ searchBarCpt = here.component "searchBar" cpt
       }
       [ H.span { className: "text-danger fa fa-times" } [] ]
 
+  subCorpusButton modalVisible queryText' query =
+    H.button
+      { className: "input-group-text btn btn-light text-secondary"
+      , on:
+          { click: \_ -> do
+              T.write_ queryText' query
+              T.write_ true modalVisible
+          }
+      , type: "submit"
+      , title: "Create a subcorpus"
+      }
+      [ H.span { className: "fa fa-filter" } [] ]
+
 mock :: Boolean
 mock = false
 

src/Gargantext/Components/DocsTable/SubcorpusCreation.purs

+module Gargantext.Components.DocsTable.SubcorpusCreation where
+
+import Gargantext.Prelude
+
+import Effect (Effect)
+import Gargantext.Hooks.StateRecord (useStateRecord)
+import Gargantext.Components.Bootstrap as B
+import Gargantext.Components.Bootstrap.Types (ButtonVariant(..), ComponentStatus(..), Variant(..))
+import Gargantext.Utils.Reactix as R2
+import Reactix as R
+import Reactix.DOM.HTML as H
+import Toestand as T
+
+type Props =
+  ( callback :: String -> Boolean -> Effect Unit
+  , query' :: String
+  , onSubcorpusCreationPending' :: Boolean
+  )
+
+subcorpusCreation :: R2.Leaf Props
+subcorpusCreation = R2.leaf component
+
+component :: R.Component Props
+component = R.hooksComponent "subcorpusCreation" cpt
+  where
+  cpt { query', onSubcorpusCreationPending', callback } _ = do
+    { state, stateBox } <- useStateRecord (defaultData :: FormData)
+
+    let
+      onParentListCheckboxChange :: Boolean -> Effect Unit
+      onParentListCheckboxChange value = T.modify_
+        (\prev -> prev { reuseParentList = value })
+        stateBox
+
+    pure $ H.div {}
+      [ H.div { className: "form-group" }
+          [ H.label {} [ H.text $ "Creating subcorpus from query: " <> query' ]
+          ]
+      , H.div { className: "form-check" }
+          [ B.formCheckbox
+              { value: state.reuseParentList
+              , callback: onParentListCheckboxChange
+              }
+          , H.label { className: "form-check-label" } [ H.text "Reuse parent list?" ]
+          ]
+      , B.button
+          { callback: \_ -> callback query' state.reuseParentList
+          , type: "submit"
+          , variant: ButtonVariant Primary
+          , status: if query' == "" then Disabled else if onSubcorpusCreationPending' then Deferred else Enabled
+          }
+          [ H.text "Create!" ]
+      ]
+
+type FormData = { reuseParentList :: Boolean }
+
+defaultData :: FormData
+defaultData =
+  { reuseParentList: true
+  }

src/Gargantext/Components/DocsTable/Types.purs

 module Gargantext.Components.DocsTable.Types where
 
+import Gargantext.Prelude
+
 import Data.Eq.Generic (genericEq)
 import Data.Generic.Rep (class Generic)
 import Data.Map (Map)
 import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Tuple (Tuple(..))
 import Gargantext.Components.Category.Types (Category(..), Star, decodeCategory)
-import Gargantext.Prelude
+import Gargantext.Config.REST (AffRESTError)
+import Gargantext.Routes (SessionRoute(..))
+import Gargantext.Sessions (Session, post)
+import Gargantext.Types (NodeID)
 import Simple.JSON as JSON
 
 data Action = MarkCategory Int Category
@@ -115,6 +120,19 @@ type LocalUserScore = Map Int Star
 type Query = String
 type Year = String
 
+newtype SubcorpusParams = SubcorpusParams
+  { query :: Query
+  , reuseParentList :: Boolean
+  }
+
+derive instance Eq SubcorpusParams
+derive instance Generic SubcorpusParams _
+derive newtype instance JSON.ReadForeign SubcorpusParams
+derive newtype instance JSON.WriteForeign SubcorpusParams
+
+createSubCorpus :: Session -> Int -> SubcorpusParams -> AffRESTError NodeID
+createSubCorpus session parentId = post session (SubCorpus parentId)
+
 ---------------------------------------------------------
 sampleData' :: DocumentsView
 sampleData' = DocumentsView

src/Gargantext/Components/Login/LoginForm.purs

@@ -30,7 +30,6 @@ import Gargantext.Utils.Reactix as R2
 import Reactix as R
 import Reactix.DOM.HTML as H
 import Record as Record
-import Record.Unsafe (unsafeSet)
 import Toestand as T
 
 here :: R2.Here
@@ -119,13 +118,13 @@ componentCpt = here.component "main" cpt
       -- @XXX StateRecord with distinct value types
       onAgreedCheckboxChange :: Boolean -> Effect Unit
       onAgreedCheckboxChange value = T.modify_
-        (\prev -> unsafeSet "agreed" value prev)
+        (\prev -> prev { agreed = value })
         stateBox
 
       -- @XXX StateRecord with distinct value types
       onAgreedLabelClick :: Unit -> Effect Unit
       onAgreedLabelClick _ = T.modify_
-        (\prev -> unsafeSet "agreed" (not state.agreed) prev)
+        (\prev -> prev { agreed = not state.agreed })
         stateBox
 
     -- | Render

src/Gargantext/Ends.purs

@@ -273,6 +273,7 @@ sessionPath (R.ChartHash { chartType, listId, tabType } i) =
 sessionPath (R.PhyloAPI nId) = "node/" <> show nId <> "/phylo"
 sessionPath R.Members = "members"
 sessionPath (R.ShareURL i t) = "shareurl?type=" <> show t <> "&id=" <> show i
+sessionPath (R.SubCorpus i) = "corpus/" <> show i <> "/subcorpus"
 
 ------- misc routing stuff
 

src/Gargantext/Routes.purs

@@ -148,6 +148,7 @@ data SessionRoute
   | PhyloAPI Id
   | Members
   | ShareURL Id NodeType
+  | SubCorpus Id
 
 ------------------------------------------------------