Commit 9661e284 authored by James Laver's avatar James Laver

Upgrade Reactix to 0.4.0

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