Commit 6bc4257d authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[refactor] some code cleanup

parent 2574713c
Pipeline #1732 failed with stage
......@@ -44,7 +44,7 @@ let
repl = pkgs.writeShellScriptBin "repl" ''
#!/usr/bin/env bash
pulp repl
spago repl
'';
test-ps = pkgs.writeShellScriptBin "test-ps" ''
......
......@@ -70,7 +70,7 @@ annotatedFieldInner p = R.createElement annotatedFieldInnerCpt p []
annotatedFieldInnerCpt :: R.Component InnerProps
annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where
cpt { menuRef, ngrams, redrawMenu, setTermList, text: fieldText } _ = do
redrawMenu' <- T.useLive T.unequal redrawMenu
_redrawMenu' <- T.useLive T.unequal redrawMenu
-- menu <- T.useBox (Nothing :: Maybe (Record AnnotationMenu))
......@@ -109,7 +109,7 @@ onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } Nothing event =
, redrawMenu
, setTermList }
Nothing -> hideMenu { menuRef, redrawMenu }
onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } (Just (Tuple ngram list)) event = do
onAnnotationSelect { menuRef, redrawMenu, setTermList } (Just (Tuple ngram list)) event = do
showMenu { event
, getList: const (Just list)
, menuRef
......
......@@ -7,7 +7,6 @@ import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Effect.Uncurried (mkEffectFn1)
import Reactix as R
import Reactix.DOM.HTML as HTML
import Toestand as T
......
module Gargantext.Components.Charts.Options.Series where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Array (foldl)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), maybe)
import Data.Newtype (class Newtype)
import Data.Symbol (SProxy(..))
import Gargantext.Components.Charts.Options.Data (DataD1, DataD2)
import Gargantext.Components.Charts.Options.Data (DataD1, DataD2)
import Gargantext.Components.Charts.Options.Font (ItemStyle, Tooltip)
import Gargantext.Components.Charts.Options.Font (ItemStyle, Tooltip)
import Gargantext.Components.Charts.Options.Legend (SelectedMode)
import Gargantext.Prelude
import Gargantext.Types (class Optional)
import Prelude (class Eq, class Show, bind, map, pure, show, ($), (+), (<<<), (<>), eq)
import Prelude (class Eq, class Show, bind, map, pure, show, ($), (+), (<<<), (<>))
import Record as Record
import Record.Unsafe (unsafeSet)
import Simple.JSON as JSON
......
module Gargantext.Components.CodeEditor where
import DOM.Simple.Types (Element)
import Data.Argonaut.Parser (jsonParser)
import Data.Either (either, Either(..))
import Data.Generic.Rep (class Generic)
......@@ -9,6 +8,7 @@ import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable, null, toMaybe)
import Data.String.Utils (endsWith)
import DOM.Simple.Types (Element)
import Effect (Effect)
import FFI.Simple ((.=))
import Reactix as R
......@@ -355,7 +355,7 @@ initControls code defaultCodeType = do
}
reinitControls :: Record Controls -> Code -> CodeType -> Effect Unit
reinitControls c@{ codeType, codeS, error } code defaultCodeType = do
reinitControls { codeType, codeS, error } code defaultCodeType = do
T.write_ defaultCodeType codeType
T.write_ code codeS
T.write_ Nothing error
......@@ -65,7 +65,7 @@ contextMenuCpt = here.component "contextMenu" cpt
, style: position menu rect
, data: { placement: "right", toggle: "popover" }
}
elems ref menu Nothing = HTML.div
elems ref _menu Nothing = HTML.div
{ ref
, key: "context-menu"
, className: "context-menu"
......@@ -98,7 +98,7 @@ documentClickHandler onClose menu =
documentScrollHandler :: Effect Unit -> Callback DE.MouseEvent
documentScrollHandler onClose =
R2.named "hideMenuOnScroll" $ callback $ \e -> onClose
R2.named "hideMenuOnScroll" $ callback $ \_ -> onClose
position :: forall t. Record (Props t) -> DOMRect -> { left :: Number, top :: Number }
position mouse {width: menuWidth, height: menuHeight} = {left, top}
......
......@@ -194,13 +194,13 @@ searchBarCpt = here.component "searchBar" cpt
searchButton query queryText' =
H.button { className: "btn btn-primary"
, on: { click: \e -> T.write_ queryText' query }
, on: { click: \_ -> T.write_ queryText' query }
, type: "submit" }
[ H.span {className: "fa fa-search"} [] ]
clearButton query =
H.button { className: "btn btn-danger"
, on: { click: \e -> T.write_ "" query } }
, on: { click: \_ -> T.write_ "" query } }
[ H.span {className: "fa fa-times"} [] ]
mock :: Boolean
......@@ -274,7 +274,7 @@ pageLayoutCpt = here.component "pageLayout" cpt where
let path = { listId, mCorpusId, nodeId, params, query, tabType, yearFilter: yearFilter' }
handleResponse :: HashedResponse (TableResult Response) -> Tuple Int (Array DocumentsView)
handleResponse (HashedResponse { hash, value: res }) = ret
handleResponse (HashedResponse { value: res }) = ret
where
filters = filterDocs query
......
......@@ -336,14 +336,14 @@ pageCpt = here.component "page" cpt
let isDeleted (DocumentsView {id}) = Set.member id deletions'.deleted
rows path' = case rowsLoaded of
rows = case rowsLoaded of
Docs {docs} -> docRow path' <$> Seq.filter (not <<< isDeleted) docs
Contacts {contacts} -> contactRow path' <$> contacts
pure $ T.table { colNames
, container
, params
, rows: rows path'
, rows
, syncResetButton : [ H.div {} [] ]
, totalRecords
, wrapColElts
......
......@@ -306,9 +306,9 @@ performAction = performAction' where
deleteNode' nt p@{ nodeId: id, parentId: parent_id, session } = do
case nt of
NodePublic FolderPublic -> void $ deleteNode session nt id
NodePublic FolderPublic -> void $ deleteNode session id
NodePublic _ -> void $ unpublishNode session (Just parent_id) id
_ -> void $ deleteNode session nt id
_ -> void $ deleteNode session id
refreshFolders p
doSearch task { boxes: { tasks }, nodeId: id } = liftEffect $ do
......
......@@ -3,7 +3,6 @@ module Gargantext.Components.FolderView.Box where
import Gargantext.Prelude
import DOM.Simple as DOM
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Tools (prettyNodeType)
......@@ -13,7 +12,6 @@ import Gargantext.Utils.Glyphicon (glyphicon)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.FolderView.Box"
......@@ -30,7 +28,7 @@ nodePopupView props = R.createElement nodePopupCpt props []
nodePopupCpt :: R.Component NodePopupProps
nodePopupCpt = here.component "nodePopupView" cpt where
cpt props@{ id, name, nodeType } _ = do
cpt props _ = do
pure $ H.div tooltipProps
[ H.div { className: "popup-container" }
......@@ -43,7 +41,7 @@ nodePopupCpt = here.component "nodePopupView" cpt where
tooltipProps = { id: "node-popup-tooltip", title: "Node settings"
, data: { toggle: "tooltip", placement: "right" } }
panelHeading props@{id, name, nodeType } =
panelHeading props@{ nodeType } =
H.div { className: "card-header" }
[ R2.row
[ H.div { className: "col-4" }
......@@ -54,4 +52,4 @@ nodePopupCpt = here.component "nodePopupView" cpt where
, H.div { className: "col-1" }
[ H.a { type: "button", on: { click: closePopover props }, title: "Close"
, className: glyphicon "window-close" } [] ]]] where
SettingsBox { edit, doc, buttons } = settingsBox nodeType
SettingsBox _ = settingsBox nodeType
......@@ -223,13 +223,13 @@ refreshTree p@{ reloadTree } = liftEffect $ T2.reload reloadTree *> closePopover
deleteNode' nt p@{ boxes: { forestOpen }, session, tree: (NTree (LNode {id, parent_id}) _) } = do
case nt of
GT.NodePublic GT.FolderPublic -> void $ deleteNode session nt id
GT.NodePublic GT.FolderPublic -> void $ deleteNode session id
GT.NodePublic _ -> void $ unpublishNode session parent_id id
_ -> void $ deleteNode session nt id
_ -> void $ deleteNode session id
liftEffect $ T.modify_ (openNodesDelete (mkNodeId session id)) forestOpen
refreshTree p
doSearch task p@{ boxes: { tasks }, tree: NTree (LNode {id}) _ } = liftEffect $ do
doSearch task { boxes: { tasks }, tree: NTree (LNode {id}) _ } = liftEffect $ do
GAT.insert id task tasks
here.log2 "[doSearch] DoSearch task:" task
......@@ -244,7 +244,7 @@ renameNode name p@{ boxes: { errors }, session, tree: (NTree (LNode {id}) _) } =
handleRESTError errors eTask $ \_task -> pure unit
refreshTree p
shareTeam username p@{ boxes: { errors }, session, tree: (NTree (LNode {id}) _)} = do
shareTeam username { boxes: { errors }, session, tree: (NTree (LNode {id}) _)} = do
eTask <- Share.shareReq session id $ Share.ShareTeamParams { username }
handleRESTError errors eTask $ \_task -> pure unit
......@@ -255,7 +255,7 @@ sharePublic params p@{ boxes: { errors, forestOpen }, session } = traverse_ f pa
liftEffect $ T.modify_ (openNodesInsert (mkNodeId p.session out)) forestOpen
refreshTree p
addContact params p@{ boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do
addContact params { boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do
eTask <- Contact.contactReq session id params
handleRESTError errors eTask $ \_task -> pure unit
......@@ -265,13 +265,13 @@ addNode' name nodeType p@{ boxes: { errors, forestOpen }, session, tree: (NTree
liftEffect $ T.modify_ (openNodesInsert (mkNodeId session id)) forestOpen
refreshTree p
uploadFile' nodeType fileType mName contents p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } = do
uploadFile' nodeType fileType mName contents { boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } = do
eTask <- uploadFile { contents, fileType, id, mName, nodeType, session }
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
here.log2 "[uploadFile'] UploadFile, uploaded, task:" task
uploadArbitraryFile' mName blob p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } = do
uploadArbitraryFile' mName blob { boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } = do
eTask <- uploadArbitraryFile session id { blob, mName }
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
......
......@@ -112,7 +112,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
pure $ H.span (dropProps droppedFile droppedFile' isDragOver isDragOver')
$ reverseHanded handed'
[ folderIcon { folderOpen, nodeType } []
, chevronIcon { folderOpen, handed, isLeaf, nodeType } []
, chevronIcon { folderOpen, handed, isLeaf } []
, nodeLink { boxes
, folderOpen
, frontends
......@@ -200,14 +200,14 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
{ className: "leaf " <> (dropClass droppedFile' isDragOver')
, on: { dragLeave: onDragLeave isDragOver
, dragOver: onDragOverHandler isDragOver
, drop: dropHandler droppedFile }
, drop: dropHandler }
}
where
dropClass (Just _) _ = "file-dropped"
dropClass _ true = "file-dropped"
dropClass Nothing _ = ""
dropHandler droppedFile e = do
dropHandler e = do
-- prevent redirection when file is dropped
E.preventDefault e
E.stopPropagation e
......@@ -247,7 +247,6 @@ type ChevronIconProps = (
folderOpen :: T.Box Boolean
, handed :: T.Box GT.Handed
, isLeaf :: Boolean
, nodeType :: GT.NodeType
)
chevronIcon :: R2.Component ChevronIconProps
......@@ -255,9 +254,9 @@ chevronIcon = R.createElement chevronIconCpt
chevronIconCpt :: R.Component ChevronIconProps
chevronIconCpt = here.component "chevronIcon" cpt
where
cpt { folderOpen, handed, isLeaf: true, nodeType } _ = do
cpt { isLeaf: true } _ = do
pure $ H.div {} []
cpt { folderOpen, handed, isLeaf: false, nodeType } _ = do
cpt { folderOpen, handed, isLeaf: false } _ = do
handed' <- T.useLive T.unequal handed
open <- T.useLive T.unequal folderOpen
pure $ H.a { className: "chevron-icon"
......
......@@ -77,8 +77,6 @@ addNodeView = R.createElement addNodeViewCpt
addNodeViewCpt :: R.Component CreateNodeProps
addNodeViewCpt = here.component "addNodeView" cpt where
cpt { dispatch
, id
, name
, nodeTypes } _ = do
nodeName <- T.useBox "Name"
nodeName' <- T.useLive T.unequal nodeName
......
......@@ -23,8 +23,8 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Delete"
-- TODO Delete with asyncTaskWithType
deleteNode :: Session -> NodeType -> GT.ID -> Aff (Either RESTError GT.ID)
deleteNode session nt nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
deleteNode :: Session -> GT.ID -> Aff (Either RESTError GT.ID)
deleteNode session nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
{-
case nt of
......
......@@ -77,5 +77,5 @@ actionDownloadOther :: R2.Component ActionDownload
actionDownloadOther = R.createElement actionDownloadOtherCpt
actionDownloadOtherCpt :: R.Component ActionDownload
actionDownloadOtherCpt = here.component "actionDownloadOther" cpt where
cpt { id, session } _ = do
cpt _ _ = do
pure $ fragmentPT $ "Soon, you will be able to download your file here "
......@@ -7,7 +7,6 @@ import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup)
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar (searchBar)
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (defaultSearch)
import Gargantext.Components.Lang (allLangs)
......@@ -27,7 +26,6 @@ type Props =
( boxes :: Boxes
, dispatch :: Action -> Aff Unit
, id :: Maybe ID
, nodePopup :: Maybe NodePopup
, session :: Session )
-- | Action : Search
......@@ -36,24 +34,23 @@ actionSearch = R.createElement actionSearchCpt
actionSearchCpt :: R.Component Props
actionSearchCpt = here.component "actionSearch" cpt
where
cpt { boxes: { errors }, dispatch, id, nodePopup, session } _ = do
cpt { boxes: { errors }, dispatch, id, session } _ = do
search <- T.useBox $ defaultSearch { node_id = id }
pure $ R.fragment [ H.p { className: "action-search" }
[ H.text $ "Search and create a private "
<> "corpus with the search query as corpus name." ]
, searchBar { errors
, langs: allLangs
, onSearch: searchOn dispatch nodePopup
, onSearch: searchOn dispatch
, search
, session
} []
]
where
searchOn :: (Action -> Aff Unit)
-> Maybe NodePopup
-> GT.AsyncTaskWithType
-> Effect Unit
searchOn dispatch' p task = do
-> GT.AsyncTaskWithType
-> Effect Unit
searchOn dispatch' task = do
_ <- launchAff $ dispatch' (DoSearch task)
-- close popup
_ <- launchAff $ dispatch' ClosePopover
......
......@@ -9,7 +9,6 @@ import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
......@@ -44,7 +43,6 @@ type SearchIFramesProps = (
searchIframes :: R2.Component SearchIFramesProps
searchIframes = R.createElement searchIframesCpt
searchIframesCpt :: R.Component SearchIFramesProps
searchIframesCpt = here.component "searchIframes" cpt
where
......@@ -67,7 +65,6 @@ type IFrameProps = (
divIframe :: R2.Component IFrameProps
divIframe = R.createElement divIframeCpt
divIframeCpt :: R.Component IFrameProps
divIframeCpt = here.component "divIframe" cpt
where
......@@ -82,7 +79,6 @@ frameUrl Searx = "https://searx.frame.gargantext.org" -- 192.168.1.4:8080"
iframeWith :: R2.Component IFrameProps
iframeWith = R.createElement iframeWithCpt
iframeWithCpt :: R.Component IFrameProps
iframeWithCpt = here.component "iframeWith" cpt
where
......
......@@ -7,7 +7,6 @@ import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Newtype (over)
import Data.Nullable (null)
import Data.Set as Set
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
......@@ -61,7 +60,7 @@ searchFieldCpt = here.component "searchField" cpt
-- then
-- H.div {}[]
-- else
, H.div {} [ dataFieldNav { datafields: dataFields, search } []
, H.div {} [ dataFieldNav { search } []
, if isExternal search'.datafield
then databaseInput { databases: props.databases, search } []
......@@ -128,11 +127,10 @@ componentIMTCpt = here.component "componentIMT" cpt
componentCNRS :: R2.Component ComponentProps
componentCNRS = R.createElement componentCNRSCpt
componentCNRSCpt :: R.Component ComponentProps
componentCNRSCpt = here.component "componentCNRS" cpt
where
cpt { search } _ = do
cpt _ _ = do
pure $ R.fragment [
H.div {} []
--, filterInput fi
......@@ -261,15 +259,14 @@ langNavCpt = here.component "langNav" cpt
------------------------------------------------------------------------
type DataFieldNavProps =
( datafields :: Array DataField
, search :: T.Box Search )
( search :: T.Box Search )
dataFieldNav :: R2.Component DataFieldNavProps
dataFieldNav = R.createElement dataFieldNavCpt
dataFieldNavCpt :: R.Component DataFieldNavProps
dataFieldNavCpt = here.component "dataFieldNav" cpt
where
cpt { datafields, search } _ = do
cpt { search } _ = do
search'@{ datafield } <- T.useLive T.unequal search
pure $ R.fragment [ H.div { className: "text-primary center"} [H.text "with DataField"]
......
......@@ -88,7 +88,7 @@ uploadFileView props = R.createElement uploadFileViewCpt props []
uploadFileViewCpt :: R.Component Props
uploadFileViewCpt = here.component "uploadFileView" cpt
where
cpt {dispatch, id, nodeType} _ = do
cpt {dispatch, nodeType} _ = do
-- mFile :: R.State (Maybe UploadFile) <- R.useState' Nothing
mFile <- T.useBox (Nothing :: Maybe UploadFile)
fileType <- T.useBox CSV
......@@ -130,7 +130,6 @@ uploadFileViewCpt = here.component "uploadFileView" cpt
let footer = H.div {} [ uploadButton { dispatch
, fileType
, lang
, id
, mFile
, nodeType
}
......@@ -154,7 +153,6 @@ uploadFileViewCpt = here.component "uploadFileView" cpt
type UploadButtonProps =
( dispatch :: Action -> Aff Unit
, fileType :: T.Box FileType
, id :: GT.ID
, lang :: T.Box Lang
, mFile :: T.Box (Maybe UploadFile)
, nodeType :: GT.NodeType
......@@ -167,7 +165,6 @@ uploadButtonCpt = here.component "uploadButton" cpt
where
cpt { dispatch
, fileType
, id
, lang
, mFile
, nodeType
......@@ -186,7 +183,7 @@ uploadButtonCpt = here.component "uploadButton" cpt
, on: {click: onClick fileType' mFile'}
} [ H.text "Upload" ]
where
onClick fileType' mFile' e = do
onClick fileType' mFile' _ = do
let { blob, name } = unsafePartial $ fromJust mFile'
here.log2 "[uploadButton] fileType" fileType'
void $ launchAff do
......@@ -225,7 +222,7 @@ fileTypeViewCpt = here.component "fileTypeView" cpt
case droppedFile' of
Nothing -> pure $ H.div {} []
Just df@(DroppedFile { blob, fileType }) ->
Just df@(DroppedFile _) ->
pure $ H.div tooltipProps [ H.div { className: "card"}
[ panelHeading
, panelBody df
......@@ -259,12 +256,12 @@ fileTypeViewCpt = here.component "fileTypeView" cpt
panelBody (DroppedFile { blob }) =
H.div {className: "card-body"}
[ R2.select {className: "col-md-12 form-control"
, on: {change: onChange blob}
, on: {change: onChange}
}
(map renderOption [CSV, CSV_HAL, WOS])
]
where
onChange blob e l =
onChange e l =
T.write_ (Just $ DroppedFile $ { blob
, fileType: read $ R.unsafeEventValue e
, lang : fromMaybe EN $ read $ R.unsafeEventValue l
......@@ -464,7 +461,7 @@ uploadTermButtonCpt = here.component "uploadTermButton" cpt
, on: { click: onClick mFile' uploadType' }
} [ H.text "Upload" ]
where
onClick mFile' uploadType' e = do
onClick mFile' uploadType' _ = do
let {name, blob} = unsafePartial $ fromJust mFile'
void $ launchAff do
contents <- readUFBAsText blob
......
......@@ -25,7 +25,7 @@ import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), Settings
import Gargantext.Components.Forest.Tree.Node.Status (Status(..), hasStatus)
import Gargantext.Components.Forest.Tree.Node.Tools (textInputBox, fragmentPT)
import Gargantext.Sessions (Session)
import Gargantext.Types (FrontendError, ID, Name, prettyNodeType)
import Gargantext.Types (ID, Name, prettyNodeType)
import Gargantext.Types as GT
import Gargantext.Utils.Glyphicon (glyphicon, glyphiconActive)
import Gargantext.Utils.Reactix as R2
......@@ -83,14 +83,14 @@ nodePopupCpt = here.component "nodePopupView" cpt where
, H.div { className: "col-1" }
[ H.a { type: "button", on: { click: closePopover p }, title: "Close"
, className: glyphicon "window-close" } [] ]]] where
SettingsBox { edit, doc, buttons } = settingsBox nodeType
SettingsBox _ = settingsBox nodeType
editIcon _ true = H.div {} []
editIcon isOpen false =
H.a { className: glyphicon "pencil", id: "rename1"
, title : "Rename", on: { click: \_ -> T.write_ true isOpen } } []
panelBody :: T.Box (Maybe NodeAction) -> Record NodePopupProps -> R.Element
panelBody nodePopupState {dispatch: d, nodeType} =
let (SettingsBox { edit, doc, buttons}) = settingsBox nodeType in
panelBody nodePopupState { nodeType } =
let (SettingsBox { doc, buttons }) = settingsBox nodeType in
H.div {className: "card-body flex-space-between"}
$ [ H.p { className: "spacer" } []
, H.div { className: "flex-center" }
......@@ -183,26 +183,26 @@ panelAction p = R.createElement panelActionCpt p []
panelActionCpt :: R.Component PanelActionProps
panelActionCpt = here.component "panelAction" cpt
where
cpt {action: Documentation nodeType} _ = pure $ actionDoc { nodeType } []
cpt {action: Download, id, nodeType, session} _ = pure $ actionDownload { id, nodeType, session } []
cpt {action: Upload, dispatch, id, nodeType, session} _ = pure $ actionUpload { dispatch, id, nodeType, session } []
cpt {action: Delete, nodeType, dispatch} _ = pure $ actionDelete { dispatch, nodeType } []
cpt {action: Add xs, dispatch, id, name, nodeType} _ =
cpt { action: Documentation nodeType} _ = pure $ actionDoc { nodeType } []
cpt { action: Download, id, nodeType, session} _ = pure $ actionDownload { id, nodeType, session } []
cpt { action: Upload, dispatch, id, nodeType, session} _ = pure $ actionUpload { dispatch, id, nodeType, session } []
cpt { action: Delete, nodeType, dispatch} _ = pure $ actionDelete { dispatch, nodeType } []
cpt { action: Add xs, dispatch, id, name, nodeType} _ =
pure $ addNodeView {dispatch, id, name, nodeType, nodeTypes: xs} []
cpt {action: Refresh , dispatch, id, nodeType, session} _ = pure $ update { dispatch, nodeType } []
cpt {action: Config , dispatch, id, nodeType, session} _ =
cpt { action: Refresh , dispatch, nodeType } _ = pure $ update { dispatch, nodeType } []
cpt { action: Config, nodeType } _ =
pure $ fragmentPT $ "Config " <> show nodeType
-- Functions using SubTree
cpt { action: Merge {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ mergeNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
cpt {action: Move {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
cpt { action: Move {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ moveNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
cpt {action: Link {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
cpt { action: Link {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ linkNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
cpt {action : Share, dispatch, id, name } _ = pure $ Share.shareNode { dispatch, id } []
cpt {action : AddingContact, dispatch, id, name } _ = pure $ Contact.actionAddContact { dispatch, id } []
cpt {action : Publish {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
cpt { action : Share, dispatch, id } _ = pure $ Share.shareNode { dispatch, id } []
cpt { action : AddingContact, dispatch, id } _ = pure $ Contact.actionAddContact { dispatch, id } []
cpt { action : Publish {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ Share.publishNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
cpt props@{action: SearchBox, boxes, id, session, dispatch, nodePopup} _ =
pure $ actionSearch { boxes, dispatch, id: (Just id), nodePopup, session } []
cpt { action: SearchBox, boxes, id, session, dispatch } _ =
pure $ actionSearch { boxes, dispatch, id: (Just id), session } []
cpt _ _ = pure $ H.div {} []
module Gargantext.Components.Forest.Tree.Node.Settings where
import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow)
import Data.Eq.Generic (genericEq)
import Gargantext.Prelude (class Eq, class Show, show, (&&), (<>), (==))
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeParams(..))
import Data.Array (foldl)
import Gargantext.Types
------------------------------------------------------------------------
......@@ -55,15 +51,15 @@ instance Show NodeAction where
show Download = "Download"
show Upload = "Upload"
show Refresh = "Refresh"
show (Move t) = "Move with subtree params" -- <> show t
show (Move _) = "Move with subtree params" -- <> show t
show Clone = "Clone"
show Delete = "Delete"
show Share = "Share"
show Config = "Config"
show (Link x) = "Link to " -- <> show x
show (Add xs) = "Add Child" -- foldl (\a b -> a <> show b) "Add " xs
show (Merge t) = "Merge with subtree" -- <> show t
show (Publish x) = "Publish" -- <> show x
show (Link _) = "Link to " -- <> show x
show (Add _) = "Add Child" -- foldl (\a b -> a <> show b) "Add " xs
show (Merge _) = "Merge with subtree" -- <> show t
show (Publish _) = "Publish" -- <> show x
show AddingContact = "AddingContact"
show CloseNodePopover = "CloseNodePopover"
......
module Gargantext.Components.Forest.Tree.Node.Tools where
import Data.Maybe (fromMaybe, Maybe(..))
import Data.Nullable (null)
import Data.Set (Set)
import Data.Set as Set
import Data.String as S
......@@ -201,7 +200,6 @@ type CheckboxProps =
checkbox :: R2.Leaf CheckboxProps
checkbox props = R.createElement checkboxCpt props []
checkboxCpt :: R.Component CheckboxProps
checkboxCpt = here.component "checkbox" cpt
where
......@@ -223,11 +221,10 @@ type CheckboxesListGroup a =
checkboxesListGroup :: forall a. Ord a => Show a => R2.Component (CheckboxesListGroup a)
checkboxesListGroup = R.createElement checkboxesListGroupCpt
checkboxesListGroupCpt :: forall a. Ord a => Show a => R.Component (CheckboxesListGroup a)
checkboxesListGroupCpt = here.component "checkboxesListGroup" cpt
where
cpt { groups, options } _ = do
cpt { options } _ = do
options' <- T.useLive T.unequal options
let one a =
......@@ -278,8 +275,6 @@ nodeLinkCpt = here.component "nodeLink" cpt
, nodeType
, session
} _ = do
popoverRef <- R.useRef null
pure $
H.div { className: "node-link"
, on: { click } }
......
module Gargantext.Components.Forest.Tree.Node.Tools.FTree where
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Foreign as F
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
import Gargantext.Prelude
......
module Gargantext.Components.Forest.Tree.Node.Tools.Sync where
import Gargantext.Prelude
( Unit, bind, const, discard, pure, unit, ($), (<>), (==) )
( Unit, bind, discard, pure, unit, ($), (<>), (==) )
import Effect.Aff (Aff, launchAff_)
import Data.Tuple.Nested ((/\))
import Data.Maybe (Maybe(..))
import Data.Tuple (fst)
import Effect.Class (liftEffect)
import Reactix.DOM.HTML as H
import Reactix as R
......@@ -69,7 +67,7 @@ graphUpdateButtonCpt = here.component "graphUpdateButton" cpt
onClick true enabled = do
launchAff_ $ do
liftEffect $ T.write_ false enabled
g <- GraphAPI.updateGraphVersions { graphId: id, session }
_g <- GraphAPI.updateGraphVersions { graphId: id, session }
liftEffect $ T.write_ true enabled
refresh unit
pure unit
......@@ -86,7 +84,6 @@ type NodeActionsNodeListProps =
nodeActionsNodeList :: Record NodeActionsNodeListProps -> R.Element
nodeActionsNodeList p = R.createElement nodeActionsNodeListCpt p []
nodeActionsNodeListCpt :: R.Component NodeActionsNodeListProps
nodeActionsNodeListCpt = here.component "nodeActionsNodeList" cpt
where
......@@ -105,11 +102,10 @@ type NodeListUpdateButtonProps =
nodeListUpdateButton :: Record NodeListUpdateButtonProps -> R.Element
nodeListUpdateButton p = R.createElement nodeListUpdateButtonCpt p []
nodeListUpdateButtonCpt :: R.Component NodeListUpdateButtonProps
nodeListUpdateButtonCpt = here.component "nodeListUpdateButton" cpt
where
cpt { listId, nodeId, nodeType, session, refresh } _ = do
cpt _ _ = do
-- enabled <- T.useBox true
pure $ H.div {} [] {- { className: "update-button "
......
......@@ -2,7 +2,7 @@ module Gargantext.Components.GraphExplorer.API where
import Gargantext.Prelude
import Data.Either (Either(..))
import Data.Either (Either)
import Data.Maybe (Maybe)
import Effect.Aff (Aff)
import Gargantext.Components.GraphExplorer.Types as GET
......
......@@ -21,7 +21,6 @@ import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadArbitraryData
import Gargantext.Components.GraphExplorer.API (cloneGraph)
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Utils as GEU
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Sessions (Session)
......
......@@ -260,7 +260,7 @@ updateTermButtonCpt = here.component "updateTermButton" cpt
, rType
, session
, text } _ = do
{ removedNodeIds, sideTab, selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
{ removedNodeIds, selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
selectedNodeIds' <- T.useLive T.uneq