diff --git a/src/Gargantext/Components/DocsTable.purs b/src/Gargantext/Components/DocsTable.purs
index 66ba2bacadaeb1a5043c953cfa850511bbebbe52..f98229d494021317ac94a3b4749ae89339e148b0 100644
--- a/src/Gargantext/Components/DocsTable.purs
+++ b/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
diff --git a/src/Gargantext/Components/DocsTable/SubcorpusCreation.purs b/src/Gargantext/Components/DocsTable/SubcorpusCreation.purs
new file mode 100644
index 0000000000000000000000000000000000000000..d1349fc1d300e3d2459aaf0a51a9339d5b7f0af1
--- /dev/null
+++ b/src/Gargantext/Components/DocsTable/SubcorpusCreation.purs
@@ -0,0 +1,60 @@
+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
+ }
diff --git a/src/Gargantext/Components/DocsTable/Types.purs b/src/Gargantext/Components/DocsTable/Types.purs
index 148d5fb162177cf7f382ed90cc786bc72484f3bb..52d3ec965a05c15c9aa3be350c8cacfe2b1c9714 100644
--- a/src/Gargantext/Components/DocsTable/Types.purs
+++ b/src/Gargantext/Components/DocsTable/Types.purs
@@ -1,12 +1,17 @@
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
diff --git a/src/Gargantext/Components/Login/LoginForm.purs b/src/Gargantext/Components/Login/LoginForm.purs
index 8d77a70281cadc33ff2c53dcee27c0d4a9770a37..06c5c04193120e054f8151e8f006fa029cc050ba 100644
--- a/src/Gargantext/Components/Login/LoginForm.purs
+++ b/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
diff --git a/src/Gargantext/Ends.purs b/src/Gargantext/Ends.purs
index 0bc4d0a29f98edd442ecfe4e7cb69294170bba90..8dafe4a64852a969e5fef76c942966eb24d07cb4 100644
--- a/src/Gargantext/Ends.purs
+++ b/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
diff --git a/src/Gargantext/Routes.purs b/src/Gargantext/Routes.purs
index 1076c5cfe128ce87dfac719f1e615bf10826f8fd..7a4af1e1020895c8b0a49176162ba342d78045dd 100644
--- a/src/Gargantext/Routes.purs
+++ b/src/Gargantext/Routes.purs
@@ -148,6 +148,7 @@ data SessionRoute
| PhyloAPI Id
| Members
| ShareURL Id NodeType
+ | SubCorpus Id
------------------------------------------------------