Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Grégoire Locqueville
purescript-gargantext
Commits
9661e284
Commit
9661e284
authored
Jul 03, 2019
by
James Laver
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Upgrade Reactix to 0.4.0
parent
994d62b0
Changes
12
Show whitespace changes
Inline
Side-by-side
Showing
12 changed files
with
102 additions
and
93 deletions
+102
-93
packages.json
.psc-package/local/.set/packages.json
+1
-1
packages.dhall
packages.dhall
+1
-1
psc-package.json
psc-package.json
+1
-0
AnnotatedField.purs
src/Gargantext/Components/Annotation/AnnotatedField.purs
+6
-6
Menu.purs
src/Gargantext/Components/Annotation/Menu.purs
+3
-3
ContextMenu.purs
src/Gargantext/Components/ContextMenu/ContextMenu.purs
+14
-14
Sigmajs.purs
src/Gargantext/Components/GraphExplorer/Sigmajs.purs
+2
-0
SearchField.purs
src/Gargantext/Components/Search/SearchField.purs
+6
-6
Tree.purs
src/Gargantext/Components/Tree.purs
+58
-47
Specs.purs
src/Gargantext/Pages/Layout/Specs.purs
+2
-2
SearchBar.purs
src/Gargantext/Pages/Layout/Specs/SearchBar.purs
+4
-5
Reactix.purs
src/Gargantext/Utils/Reactix.purs
+4
-8
No files found.
.psc-package/local/.set/packages.json
View file @
9661e284
...
...
@@ -2102,7 +2102,7 @@
"ffi-simple"
],
"repo"
:
"https://github.com/irresponsible/purescript-reactix"
,
"version"
:
"v0.
3.1
"
"version"
:
"v0.
4.0
"
},
"read"
:
{
"dependencies"
:
[
...
...
packages.dhall
View file @
9661e284
...
...
@@ -194,7 +194,7 @@ let additions =
, "ffi-simple"
]
"https://github.com/irresponsible/purescript-reactix"
"v0.
3.1
"
"v0.
4.0
"
, uint =
mkPackage
[ "maybe", "math", "generics-rep" ]
...
...
psc-package.json
View file @
9661e284
...
...
@@ -21,6 +21,7 @@
"random"
,
"reactix"
,
"routing"
,
"sequences"
,
"spec-discovery"
,
"spec-quickcheck"
,
"string-parsers"
,
...
...
src/Gargantext/Components/Annotation/AnnotatedField.purs
View file @
9661e284
...
...
@@ -49,7 +49,7 @@ annotatedFieldComponent :: R.Component Props
annotatedFieldComponent = R.hooksComponent "AnnotatedField" cpt
where
cpt {ngrams,setTermList,text} _ = do
menu /\ setMenu <- R.useState $
\_ -> pure
Nothing
menu /\ setMenu <- R.useState $
const
Nothing
let wrapperProps =
{ className: "annotated-field-wrapper" }
...
...
@@ -59,8 +59,8 @@ annotatedFieldComponent = R.hooksComponent "AnnotatedField" cpt
y = E.clientY event
setList t = do
setTermList (S.toLower text') (Just list) t
setMenu
Nothing
setMenu
$ Just {x, y, list: Just list, menuType: SetTermListItem, setList}
setMenu
(const Nothing)
setMenu
(const $ Just {x, y, list: Just list, menuType: SetTermListItem, setList} )
mapCompile (Tuple t l) = {text: t, list: l, onSelect}
compiled = map mapCompile $ compile ngrams text
...
...
@@ -82,13 +82,13 @@ maybeShowMenu setMenu setTermList ngrams event = do
list = findNgram ngrams sel'
setList t = do
setTermList sel' list t
setMenu
Nothing
setMenu
(const Nothing)
E.preventDefault event
setMenu
$ Just { x, y, list, menuType: NewNgram, setList }
setMenu
(const $ Just { x, y, list, menuType: NewNgram, setList })
Nothing -> pure unit
maybeAddMenu
:: (
Maybe AnnotationMenu
-> Effect Unit)
:: (
(Maybe AnnotationMenu -> Maybe AnnotationMenu)
-> Effect Unit)
-> R.Element
-> Maybe AnnotationMenu
-> R.Element
...
...
src/Gargantext/Components/Annotation/Menu.purs
View file @
9661e284
...
...
@@ -2,7 +2,7 @@
module Gargantext.Components.Annotation.Menu where
import Prelude ( Unit, (==), ($), (<>), unit, pure, otherwise )
import Prelude ( Unit, (==), ($), (<>), unit, pure, otherwise
, const
)
import Data.Array as A
import Data.Maybe ( Maybe(..), maybe' )
import Effect ( Effect )
...
...
@@ -22,14 +22,14 @@ data MenuType = NewNgram | SetTermListItem
type Props =
( list :: Maybe TermList
, menuType :: MenuType
, setList :: TermList -> Effect Unit
, setList :: TermList -> Effect Unit
-- not a state hook setter
)
type AnnotationMenu = { x :: Number, y :: Number | Props }
-- | An Annotation Menu is parameterised by a Maybe Termlist of the
-- | TermList the currently selected text belongs to
annotationMenu :: (
Maybe AnnotationMenu
-> Effect Unit) -> AnnotationMenu -> R.Element
annotationMenu :: (
(Maybe AnnotationMenu -> Maybe AnnotationMenu)
-> Effect Unit) -> AnnotationMenu -> R.Element
annotationMenu setMenu { x,y,list,menuType,setList } =
CM.contextMenu { x,y,setMenu } [
R.createElement annotationMenuCpt {list,menuType,setList} []
...
...
src/Gargantext/Components/ContextMenu/ContextMenu.purs
View file @
9661e284
...
...
@@ -26,7 +26,7 @@ import Reactix.SyntheticEvent as E
import Gargantext.Utils.Reactix as R2
type Props t = ( x :: Number, y :: Number, setMenu ::
Maybe t
-> Effect Unit)
type Props t = ( x :: Number, y :: Number, setMenu ::
(Maybe t -> Maybe t)
-> Effect Unit)
getPortalHost :: R.Hooks DOM.Element
getPortalHost = R.unsafeHooksEffect $ delay unit $ \_ -> pure $ document ... "getElementById" $ ["menu-portal"]
...
...
@@ -40,12 +40,12 @@ contextMenuCpt = R.hooksComponent "ContextMenu" cpt
cpt menu children = do
host <- getPortalHost
root <- R.useRef null
rect /\ setRect <- R.useState $ \_ ->
pure
Nothing
R.useLayoutEffect1 (R.readRef root) $
\_ ->
do
rect /\ setRect <- R.useState $ \_ -> Nothing
R.useLayoutEffect1 (R.readRef root) $ do
traverse_
(\r -> setRect
$ Just (Element.boundingRect r
))
(\r -> setRect
(\_ -> Just (Element.boundingRect r)
))
(toMaybe $ R.readRef root)
pure $
\_ ->
pure unit
pure $ pure unit
R.useLayoutEffect2 root rect (contextMenuEffect menu.setMenu root)
let cs = [
HTML.div { className: "popover-content" }
...
...
@@ -61,31 +61,31 @@ contextMenuCpt = R.hooksComponent "ContextMenu" cpt
contextMenuEffect
:: forall t
. (
Maybe t
-> Effect Unit)
. (
(Maybe t -> Maybe t)
-> Effect Unit)
-> R.Ref (Nullable DOM.Element)
->
Unit -> Effect (Unit ->
Effect Unit)
contextMenuEffect setMenu rootRef
_
=
->
Effect (
Effect Unit)
contextMenuEffect setMenu rootRef =
case R.readNullableRef rootRef of
Just root -> do
let onClick = documentClickHandler setMenu root
let onScroll = documentScrollHandler setMenu
DOM.addEventListener document "click" onClick
DOM.addEventListener document "scroll" onScroll
pure $
\_ ->
do
pure $ do
DOM.removeEventListener document "click" onClick
DOM.removeEventListener document "scroll" onScroll
Nothing -> pure
$ \_ -> pure unit
Nothing -> pure
R.nothing
documentClickHandler :: forall t. (
Maybe t
-> Effect Unit) -> DOM.Element -> Callback DE.MouseEvent
documentClickHandler :: forall t. (
(Maybe t -> Maybe t)
-> Effect Unit) -> DOM.Element -> Callback DE.MouseEvent
documentClickHandler hide menu =
R2.named "hideMenuOnClickOutside" $ callback $ \e ->
if Element.contains menu (DE.target e)
then pure unit
else hide
Nothing
else hide
(const Nothing)
documentScrollHandler :: forall t. (
Maybe t
-> Effect Unit) -> Callback DE.MouseEvent
documentScrollHandler :: forall t. (
(Maybe t -> Maybe t)
-> Effect Unit) -> Callback DE.MouseEvent
documentScrollHandler hide =
R2.named "hideMenuOnScroll" $ callback $ \e -> hide
Nothing
R2.named "hideMenuOnScroll" $ callback $ \e -> hide
(const Nothing)
position :: forall t. Record (Props t) -> DOMRect -> { left :: Number, top :: Number }
position mouse {width: menuWidth, height: menuHeight} = {left, top}
...
...
src/Gargantext/Components/GraphExplorer/Sigmajs.purs
View file @
9661e284
...
...
@@ -3,6 +3,8 @@ module Gargantext.Components.GraphExplorer.Sigmajs where
import Prelude
import Data.Nullable (Nullable)
import Data.Sequence (Seq)
import Data.Sequence as Seq
import Effect (Effect)
import Effect.Uncurried (EffectFn1, EffectFn2, mkEffectFn1, runEffectFn1)
import React (Children, ReactClass, ReactElement, ReactRef, SyntheticEventHandler, createElement, unsafeCreateElement)
...
...
src/Gargantext/Components/Search/SearchField.purs
View file @
9661e284
...
...
@@ -46,8 +46,8 @@ searchFieldComponent = R.memo (R.hooksComponent "SearchField" cpt) hasChanged
where
cpt props _ = do
let search = maybe defaultSearch identity (fst props.search)
term <- R.useState $ \_ ->
pure
search.term
db <- R.useState $ \_ ->
pure
Nothing
term <- R.useState $ \_ -> search.term
db <- R.useState $ \_ -> Nothing
pure $
div { className: "search-field input-group" }
[ databaseInput db props.databases
...
...
@@ -68,7 +68,7 @@ databaseInput (db /\ setDB) dbs =
liItem db = li { onClick }
[ a {href: "#"} [text (show db) ] ]
where
onClick = mkEffectFn1 $ \_ -> setDB
$ Just db
onClick = mkEffectFn1 $ \_ -> setDB
(const $ Just db)
dropdownBtnProps = { id: "search-dropdown"
, className: "btn btn-default dropdown-toggle"
, type: "button"} .= "data-toggle" $ "dropdown"
...
...
@@ -82,7 +82,7 @@ searchInput (term /\ setTerm) =
, type: "text"
, onChange
, placeholder }
where onChange = mkEffectFn1 $ \e -> setTerm
$ e .. "target" .. "value"
where onChange = mkEffectFn1 $ \e -> setTerm
(const $ e .. "target" .. "value")
submitButton :: R.State (Maybe Database) -> R.State String -> R.State (Maybe Search) -> R.Element
...
...
@@ -91,5 +91,5 @@ submitButton (database /\ _) (term /\ _) (_ /\ setSearch) =
where
click = mkEffectFn1 $ \_ -> do
case term of
"" -> setSearch
Nothing
_ -> setSearch
$ Just { database, term }
"" -> setSearch
(const Nothing)
_ -> setSearch
(const $ Just { database, term })
src/Gargantext/Components/Tree.purs
View file @
9661e284
...
...
@@ -16,8 +16,7 @@ import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, runAff)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Effect.Uncurried (mkEffectFn1)
import Effect.Uncurried (EffectFn1, mkEffectFn1)
import FFI.Simple ((..), (.=))
import Gargantext.Components.Loader as Loader
import Gargantext.Config (toUrl, End(..), NodeType(..), readNodeType)
...
...
@@ -93,8 +92,13 @@ instance decodeJsonFTree :: DecodeJson (NTree LNode) where
type FTree = NTree LNode
setName :: String -> NTree LNode -> NTree LNode
setName v (NTree (LNode s@{name}) ary) = NTree (LNode $ s {name = v}) ary
setPopOver :: Boolean -> NTree LNode -> NTree LNode
setPopOver v (NTree (LNode s@{popOver}) ary) = NTree (LNode $ s {popOver = v}) ary
setCreateOpen :: Boolean -> NTree LNode -> NTree LNode
setCreateOpen v (NTree (LNode s@{createOpen}) ary) = NTree (LNode $ s {createOpen = v}) ary
-- file upload types
...
...
@@ -241,12 +245,13 @@ treeview = simpleSpec defaultPerformAction render
} ]
--nodePopupView :: forall s. (Action -> Effect Unit) -> FTree -> RAction s -> R.Element
nodePopupView d nodeState@(s@(NTree (LNode {id, name, popOver: true, createOpen}) _) /\ setNodeState) = R.createElement el {} []
nodePopupView :: (Action -> Effect Unit) -> R.State (NTree LNode) -> R.Element
nodePopupView d nodeState@(s@(NTree (LNode {id, name, popOver: true, createOpen}) _) /\ setNodeState) =
R.createElement el {} []
where
el = R.hooksComponent "NodePopupView" cpt
cpt props _ = do
renameBoxOpen <- R.useState
$ \_ -> pure
false
renameBoxOpen <- R.useState
'
false
pure $ H.div tooltipProps $
[ H.div {id: "arrow"} []
, H.div { className: "panel panel-default"
...
...
@@ -263,21 +268,17 @@ nodePopupView d nodeState@(s@(NTree (LNode {id, name, popOver: true, createOpen}
, title: "Node settings"
} .= "data-toggle" $ "tooltip") .= "data-placement" $ "right"
iconAStyle = {color:"black", paddingTop: "6px", paddingBottom: "6px"}
rowClass true = "col-md-10"
rowClass false = "col-md-8"
panelHeading renameBoxOpen@(open /\ _) =
H.div {className: "panel-heading"}
[ H.div {className: "row" }
(
[ H.div {className: if (open) then "col-md-10" else "col-md-8"}
[ renameBox d nodeState renameBoxOpen ]
] <> [ editIcon renameBoxOpen ] <> [
H.div {className: "col-md-2"}
[ H.div {className: rowClass open} [ renameBox d nodeState renameBoxOpen ]
, editIcon renameBoxOpen
, H.div {className: "col-md-2"}
[ H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove-circle"
, onClick: mkEffectFn1 $ \_ -> setNodeState $ setPopOver false s
, title: "Close"} []
]
]
)
]
, onClick: mkEffectFn1 $ \_ -> setNodeState $ const (setPopOver false s)
, title: "Close"} [] ] ] ]
glyphicon t = "glyphitem glyphicon glyphicon-" <> t
editIcon (false /\ setRenameBoxOpen) =
H.div {className: "col-md-2"}
...
...
@@ -285,7 +286,7 @@ nodePopupView d nodeState@(s@(NTree (LNode {id, name, popOver: true, createOpen}
, className: "btn glyphitem glyphicon glyphicon-pencil"
, id: "rename1"
, title: "Rename"
, onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen
true
, onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen
(const true)
}
[]
]
...
...
@@ -327,7 +328,7 @@ nodePopupView d nodeState@(s@(NTree (LNode {id, name, popOver: true, createOpen}
, className: (glyphicon "plus")
, id: "create"
, title: "Create"
, onClick: mkEffectFn1 $ \_ -> setNodeState
$ setCreateOpen (not createOpen) $ setPopOver false s
, onClick: mkEffectFn1 $ \_ -> setNodeState
(const $ setCreateOpen (not createOpen) $ setPopOver false s)
}
[]
]
...
...
@@ -337,11 +338,12 @@ nodePopupView _ _ = R.createElement el {} []
cpt props _ = pure $ H.div {} []
renameBox :: (Action -> Effect Unit) -> R.State (NTree LNode) -> R.State Boolean -> R.Element
renameBox d (s@(NTree (LNode {id, name}) _) /\ setNodeState) (true /\ setRenameBoxOpen) = R.createElement el {} []
where
el = R.hooksComponent "RenameBox" cpt
cpt props _ = do
renameNodeName <- R.useState
$ \_ -> pure
name
renameNodeName <- R.useState
'
name
pure $ H.div {className: "from-group row-no-padding"}
[ renameInput renameNodeName
, renameBtn renameNodeName
...
...
@@ -354,21 +356,21 @@ renameBox d (s@(NTree (LNode {id, name}) _) /\ setNodeState) (true /\ setRenameB
, placeholder: "Rename Node"
, defaultValue: name
, className: "form-control"
, onInput: mkEffectFn1 $ \e -> setRenameNodeName
$ e .. "target" .. "value"
, onInput: mkEffectFn1 $ \e -> setRenameNodeName
(const $ e .. "target" .. "value")
}
]
renameBtn (newName /\ _) =
H.a {className: "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setNodeState
$ setPopOver false $ setName newName s
d
$
(Submit id newName)
setNodeState
(setPopOver false <<< setName newName)
d (Submit id newName)
, title: "Rename"
} []
cancelBtn =
H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen
false
, onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen
(const false)
, title: "Cancel"
} []
renameBox _ (s@(NTree (LNode {name}) _) /\ _) (false /\ _) = R.createElement el {} []
...
...
@@ -377,13 +379,13 @@ renameBox _ (s@(NTree (LNode {name}) _) /\ _) (false /\ _) = R.createElement el
cpt props _ = pure $ H.div {} [ H.text name ]
--createNodeView :: (Action -> Effect Unit) ->
FTree -> R.Element
createNodeView :: (Action -> Effect Unit) -> R.State
FTree -> R.Element
createNodeView d (s@(NTree (LNode {id, nodeValue, createOpen: true}) _) /\ setNodeState) = R.createElement el {} []
where
el = R.hooksComponent "CreateNodeView" cpt
cpt props _ = do
nodeName <- R.useState
$ \_ -> pure
""
nodeType <- R.useState
$ \_ -> pure
Corpus
nodeName <- R.useState
'
""
nodeType <- R.useState
'
Corpus
pure $ H.div tooltipProps $
[ H.div {className: "panel panel-default"}
[ panelHeading
...
...
@@ -402,11 +404,12 @@ createNodeView d (s@(NTree (LNode {id, nodeValue, createOpen: true}) _) /\ setNo
[ H.h5 {} [H.text "Create Node"] ]
, H.div {className: "col-md-2"}
[ H.a { className: "btn text-danger glyphitem glyphicon glyphicon-remove-circle"
, onClick: mkEffectFn1 $ \_ -> setNodeState
$ setCreateOpen false s
, onClick: mkEffectFn1 $ \_ -> setNodeState
(setCreateOpen false)
, title: "Close"} []
]
]
]
panelBody :: R.State String -> R.State NodeType -> R.Element
panelBody (_ /\ setNodeName) (nt /\ setNodeType) =
H.div {className: "panel-body"}
[ H.div {className: "row"}
...
...
@@ -417,12 +420,12 @@ createNodeView d (s@(NTree (LNode {id, nodeValue, createOpen: true}) _) /\ setNo
, placeholder: "Node name"
, defaultValue: getCreateNodeValue s
, className: "form-control"
, onInput: mkEffectFn1 $ \e -> setNodeName
$ e .. "target" .. "value"
, onInput: mkEffectFn1 $ \e -> setNodeName
(const $ e .. "target" .. "value")
}
]
, H.div {className: "form-group"}
[ R2.select { className: "form-control"
, onChange: mkEffectFn1 $ \e -> setNodeType
$ readNodeType $ e .. "target" .. "value"
, onChange: mkEffectFn1 $ \e -> setNodeType
(const $ readNodeType $ e .. "target" .. "value")
}
(map renderOption [Corpus, Folder])
]
...
...
@@ -431,6 +434,7 @@ createNodeView d (s@(NTree (LNode {id, nodeValue, createOpen: true}) _) /\ setNo
]
]
renderOption (opt :: NodeType) = H.option {} [ H.text $ show opt ]
panelFooter :: R.State String -> R.State NodeType -> R.Element
panelFooter (name /\ _) (nt /\ _) =
H.div {className: "panel-footer"}
[ H.button {className: "btn btn-success"
...
...
@@ -443,7 +447,7 @@ createNodeView _ _ = R.createElement el {} []
el = R.hooksComponent "CreateNodeView" cpt
cpt props _ = pure $ H.div {} []
--fileTypeView :: (Action -> Effect Unit) -> FTree
-> R.Element
fileTypeView :: (Action -> Effect Unit) -> R.State FTree -> R.State (Maybe DroppedFile) -> R.State Boolean
-> R.Element
fileTypeView d (s@(NTree (LNode {id}) _) /\ _) (Just (DroppedFile {contents, fileType}) /\ setDroppedFile) (_ /\ setIsDragOver) = R.createElement el {} []
where
el = R.hooksComponent "FileTypeView" cpt
...
...
@@ -467,8 +471,8 @@ fileTypeView d (s@(NTree (LNode {id}) _) /\ _) (Just (DroppedFile {contents, fil
, H.div {className: "col-md-2"}
[ H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove-circle"
, onClick: mkEffectFn1 $ \_ -> do
setDroppedFile
Nothing
setIsDragOver
false
setDroppedFile
(const Nothing)
setIsDragOver
(const false)
, title: "Close"} []
]
]
...
...
@@ -481,7 +485,7 @@ fileTypeView d (s@(NTree (LNode {id}) _) /\ _) (Just (DroppedFile {contents, fil
]
where
onChange = mkEffectFn1 $ \e ->
setDroppedFile
$ Just $ DroppedFile $ {contents, fileType: readFileType $ e .. "target" .. "value"}
setDroppedFile
(const $ Just $ DroppedFile $ {contents, fileType: readFileType $ e .. "target" .. "value"})
renderOption opt = H.option {} [ H.text $ show opt ]
panelFooter =
H.div {className: "panel-footer"}
...
...
@@ -491,7 +495,7 @@ fileTypeView d (s@(NTree (LNode {id}) _) /\ _) (Just (DroppedFile {contents, fil
H.button {className: "btn btn-success"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setDroppedFile
$ Nothing
setDroppedFile
(const Nothing)
d $ (UploadFile id ft contents)
} [H.text "Upload"]
Nothing ->
...
...
@@ -513,10 +517,10 @@ toHtml d s@(NTree (LNode {id, name, nodeType}) ary) n = R.createElement el {} []
where
el = R.hooksComponent "NodeView" cpt
cpt props _ = do
nodeState <- R.useState
$ \_ -> pure
s
folderOpen <- R.useState
$ \_ -> pure
true
droppedFile <- R.useState
$ \_ -> pure (Nothing :: Maybe DroppedFile)
isDragOver <- R.useState
$ \_ -> pure
false
nodeState <- R.useState
'
s
folderOpen <- R.useState
'
true
droppedFile <- R.useState
' Nothing
isDragOver <- R.useState
'
false
pure $ H.ul {}
[ H.li {}
...
...
@@ -525,6 +529,7 @@ toHtml d s@(NTree (LNode {id, name, nodeType}) ary) n = R.createElement el {} []
)
]
where
mainSpan :: R.State FTree -> R.State Boolean -> R.State (Maybe DroppedFile) -> R.State Boolean -> R.Element
mainSpan nodeState folderOpen droppedFile isDragOver =
H.span (dropProps droppedFile isDragOver)
[ folderIcon folderOpen
...
...
@@ -540,18 +545,20 @@ toHtml d s@(NTree (LNode {id, name, nodeType}) ary) n = R.createElement el {} []
, createNodeView d nodeState
, fileTypeView d nodeState droppedFile isDragOver
]
folderIcon :: R.State Boolean -> R.Element
folderIcon folderOpen@(open /\ _) =
H.a {onClick: R2.effToggler folderOpen}
[ H.i {className: fldr open} [] ]
dropProps droppedFile isDragOver = {
className: dropClass droppedFile isDragOver
, onDrop: dropHandler droppedFile
, onDragOver:
onD
ragOverHandler isDragOver
, onDragLeave:
onD
ragLeave isDragOver
, onDragOver:
d
ragOverHandler isDragOver
, onDragLeave:
d
ragLeave isDragOver
}
dropClass (Just _ /\ _) _ = "file-dropped"
dropClass _ (true /\ _) = "file-dropped"
dropClass (Nothing /\ _) _ = ""
dropHandler :: forall e. R.State (Maybe DroppedFile) -> EffectFn1 (E.SyntheticEvent_ e) Unit
dropHandler (_ /\ setDroppedFile) = mkEffectFn1 $ \e -> unsafePartial $ do
let ff = fromJust $ item 0 $ ((e .. "dataTransfer" .. "files") :: FileList)
liftEffect $ log2 "drop:" ff
...
...
@@ -561,32 +568,36 @@ toHtml d s@(NTree (LNode {id, name, nodeType}) ary) n = R.createElement el {} []
let blob = toBlob $ ff
void $ runAff (\_ -> pure unit) do
contents <- readAsText blob
liftEffect $ setDroppedFile $ Just $ DroppedFile {contents: (UploadFileContents contents), fileType: Just CSV}
onDragOverHandler (_ /\ setIsDragOver) = mkEffectFn1 $ \e -> do
liftEffect $ setDroppedFile (const $ Just $ DroppedFile {contents: (UploadFileContents contents), fileType: Just CSV})
dragOverHandler :: forall e. R.State Boolean -> EffectFn1 (E.SyntheticEvent_ e) Unit
dragOverHandler (_ /\ setIsDragOver) = mkEffectFn1 $ \e -> do
-- prevent redirection when file is dropped
-- https://stackoverflow.com/a/6756680/941471
E.preventDefault e
E.stopPropagation e
setIsDragOver true
onDragLeave (_ /\ setIsDragOver) = mkEffectFn1 $ \_ -> setIsDragOver false
setIsDragOver (const true)
dragLeave :: forall e. R.State Boolean -> EffectFn1 e Unit
dragLeave (_ /\ setIsDragOver) = mkEffectFn1 $ \_ -> setIsDragOver (const false)
childNodes :: forall s. (Action -> Effect Unit) -> Maybe ID -> (Array (NTree LNode)) ->
Tuple Boolean (Boolean -> Effect s)
-> Array R.Element
childNodes :: forall s. (Action -> Effect Unit) -> Maybe ID -> (Array (NTree LNode)) ->
R.State Boolean
-> Array R.Element
childNodes d n [] _ = []
childNodes d n _ (false /\ _) = []
childNodes d n ary (true /\ _) = map (\cs -> toHtml d cs n) ary
nodeText :: FTree -> Maybe Int -> R.Element
nodeText (NTree (LNode {id, name}) _) n = if n == (Just id) then
H.u {} [H.b {} [H.text ("| " <> name <> " | ")]]
else
H.text (name <> " ")
popOverIcon :: R.State FTree -> R.Element
popOverIcon (s@(NTree (LNode {popOver}) _) /\ setNodeState) =
H.a { className: "glyphicon glyphicon-cog"
, id: "rename-leaf"
, onClick: mkEffectFn1 $ \_ -> setNodeState
$ setPopOver (not popOver) s
, onClick: mkEffectFn1 $ \_ -> setNodeState
(setPopOver (not popOver))
} []
...
...
src/Gargantext/Pages/Layout/Specs.purs
View file @
9661e284
...
...
@@ -29,7 +29,7 @@ import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Pages.Layout.Specs.SearchBar as SB
import Gargantext.Pages.Layout.States (AppState, _addCorpusState, _graphExplorerState, _loginState, _searchState)
import Gargantext.Router (Routes(..))
import Gargantext.Utils.Reactix
as R'
import Gargantext.Utils.Reactix
(scuff)
layoutSpec :: Spec AppState {} Action
layoutSpec =
...
...
@@ -180,7 +180,7 @@ searchBar = simpleSpec defaultPerformAction render
, div [ className "collapse navbar-collapse"
]
$ [ divDropdownLeft ]
<> [
R'.
scuff (SB.searchBar SB.defaultProps) ]
<> [ scuff (SB.searchBar SB.defaultProps) ]
<> [ divDropdownRight d s ]
]
]
...
...
src/Gargantext/Pages/Layout/Specs/SearchBar.purs
View file @
9661e284
...
...
@@ -15,7 +15,6 @@ import Thermite (Spec, defaultPerformAction, simpleSpec)
import Reactix as R
import DOM.Simple.Console
import Effect.Aff (launchAff)
import Gargantext.Utils.Reactix as R'
import Reactix.DOM.HTML as H
import Gargantext.Components.Search.Types
import Gargantext.Components.Search.Ajax as Ajax
...
...
@@ -35,8 +34,8 @@ searchBarComponent :: R.Component Props
searchBarComponent = R.hooksComponent "SearchBar" cpt
where
cpt props _ = do
open <- R.useState $
\_ -> pure $
props.open
search <- R.useState $
\_ -> pure
Nothing
open <- R.useState $
const
props.open
search <- R.useState $
const
Nothing
onSearchChange search
pure $ H.div { className: "search-bar-container" }
[ toggleButton open
...
...
@@ -50,7 +49,7 @@ searchFieldContainer (open /\ _) databases search =
onSearchChange :: R.State (Maybe Search) -> R.Hooks Unit
onSearchChange (search /\ setSearch) =
R
'.useLayoutEffect1' search $ \_ ->
traverse_ triggerSearch search
R
.useLayoutEffect1' search $
traverse_ triggerSearch search
where
triggerSearch q = do
launchAff $ do
...
...
@@ -68,4 +67,4 @@ toggleButton open =
[ H.text "control_point" ] ]
onToggleExpanded :: forall e. R.State Boolean -> EffectFn1 e Unit
onToggleExpanded
open = mkEffectFn1 $ \_ -> R'.overState not open
onToggleExpanded
(_open /\ setOpen) = mkEffectFn1 $ \_ -> setOpen not
src/Gargantext/Utils/Reactix.purs
View file @
9661e284
...
...
@@ -10,7 +10,7 @@ import Data.Traversable (traverse_)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Uncurried (mkEffectFn1)
import Effect.Uncurried (
EffectFn1,
mkEffectFn1)
import FFI.Simple ((...), defineProperty)
import React (ReactElement)
import Reactix as R
...
...
@@ -38,15 +38,11 @@ named :: forall o. String -> o -> o
named = flip $ defineProperty "name"
overState :: forall t. (t -> t) -> R.State t -> Effect Unit
overState f (state /\ setState) = setState $ f state
useLayoutEffect1' :: forall a. a -> (Unit -> Effect Unit) -> R.Hooks Unit
useLayoutEffect1' a f = R.useLayoutEffect1 a $ \_ ->
do f unit
pure $ \_ -> pure unit
overState f (_state /\ setState) = setState f
select :: ElemFactory
select = createDOMElement "select"
effToggler (value /\ setValue) = mkEffectFn1 $ \_ -> setValue $ not value
effToggler :: forall e. R.State Boolean -> EffectFn1 e Unit
effToggler (_value /\ setValue) = mkEffectFn1 $ \e -> setValue not
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment