Commit 733a974d authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

tree: rewrite toHtml to use Reactix. Now most of Tree uses Reactix

parent 1b25f351
...@@ -128,6 +128,7 @@ li a#rename-leaf { ...@@ -128,6 +128,7 @@ li a#rename-leaf {
display:none; display:none;
position:absolute; position:absolute;
text-decoration:none; text-decoration:none;
margin-left: 20px;
} }
li:hover a#rename-leaf { li:hover a#rename-leaf {
......
...@@ -16,9 +16,8 @@ import Data.Tuple.Nested ((/\)) ...@@ -16,9 +16,8 @@ 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, throwException) import Effect.Exception (error)
import Effect.Uncurried (mkEffectFn1) import Effect.Uncurried (mkEffectFn1)
import Effect.Unsafe (unsafePerformEffect)
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)
...@@ -29,9 +28,8 @@ import Gargantext.Utils.Reactix as R2 ...@@ -29,9 +28,8 @@ import Gargantext.Utils.Reactix as R2
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import React (ReactClass, ReactElement) import React (ReactClass, ReactElement)
import React as React import React as React
import React.DOM (a, div, i, input, li, span, text, ul, b, u) import React.DOM (a, div, i)
import React.DOM.Props (_id, _type, className, href, title, onClick, onDrop, onDragOver, onInput, placeholder, style, defaultValue, _data) import React.DOM.Props (className, style)
import React.DOM.Props as DOM
import React.SyntheticEvent as E import React.SyntheticEvent as E
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
...@@ -65,12 +63,9 @@ filterNTree p (NTree x ary) = ...@@ -65,12 +63,9 @@ filterNTree p (NTree x ary) =
newtype LNode = LNode { id :: ID newtype LNode = LNode { id :: ID
, name :: String , name :: String
, nodeType :: NodeType , nodeType :: NodeType
, open :: Boolean
, popOver :: Boolean , popOver :: Boolean
, nodeValue :: String , nodeValue :: String
, createNode :: Boolean , createOpen :: Boolean}
, droppedFile :: Maybe DroppedFile
, showRenameBox :: Boolean}
derive instance newtypeLNode :: Newtype LNode _ derive instance newtypeLNode :: Newtype LNode _
...@@ -83,12 +78,9 @@ instance decodeJsonLNode :: DecodeJson LNode where ...@@ -83,12 +78,9 @@ instance decodeJsonLNode :: DecodeJson LNode where
pure $ LNode { id : id_ pure $ LNode { id : id_
, name , name
, nodeType , nodeType
, open : true
, popOver : false , popOver : false
, createNode : false
, nodeValue : "" , nodeValue : ""
, droppedFile: Nothing , createOpen : false}
, showRenameBox : false}
instance decodeJsonFTree :: DecodeJson (NTree LNode) where instance decodeJsonFTree :: DecodeJson (NTree LNode) where
decodeJson json = do decodeJson json = do
...@@ -101,6 +93,10 @@ instance decodeJsonFTree :: DecodeJson (NTree LNode) where ...@@ -101,6 +93,10 @@ instance decodeJsonFTree :: DecodeJson (NTree LNode) where
type FTree = NTree LNode type FTree = NTree LNode
setName v (NTree (LNode s@{name}) ary) = NTree (LNode $ s {name = v}) ary
setPopOver v (NTree (LNode s@{popOver}) ary) = NTree (LNode $ s {popOver = v}) ary
setCreateOpen v (NTree (LNode s@{createOpen}) ary) = NTree (LNode $ s {createOpen = v}) ary
-- file upload types -- file upload types
data FileType = CSV | PresseRIS data FileType = CSV | PresseRIS
derive instance genericFileType :: Generic FileType _ derive instance genericFileType :: Generic FileType _
...@@ -108,10 +104,10 @@ instance eqFileType :: Eq FileType where ...@@ -108,10 +104,10 @@ instance eqFileType :: Eq FileType where
eq = genericEq eq = genericEq
instance showFileType :: Show FileType where instance showFileType :: Show FileType where
show = genericShow show = genericShow
readFileType :: String -> FileType readFileType :: String -> Maybe FileType
readFileType "CSV" = CSV readFileType "CSV" = Just CSV
readFileType "PresseRIS" = PresseRIS readFileType "PresseRIS" = Just PresseRIS
readFileType ft = unsafePerformEffect $ throwException $ error $ "File type unknown: " <> ft readFileType _ = Nothing
newtype UploadFileContents = UploadFileContents String newtype UploadFileContents = UploadFileContents String
data DroppedFile = DroppedFile { data DroppedFile = DroppedFile {
...@@ -121,18 +117,11 @@ data DroppedFile = DroppedFile { ...@@ -121,18 +117,11 @@ data DroppedFile = DroppedFile {
type FileHash = String type FileHash = String
data Action = ShowPopOver ID data Action = Submit ID String
| ToggleFolder ID
| Submit ID String
| DeleteNode ID | DeleteNode ID
| Create ID
| CreateSubmit ID String NodeType | CreateSubmit ID String NodeType
| SetNodeValue String ID | SetNodeValue String ID
| ToggleCreateNode ID
| ShowRenameBox ID
| CancelRename ID
| CurrentNode ID | CurrentNode ID
| PrepareUploadFile ID UploadFileContents
| UploadFile ID FileType UploadFileContents | UploadFile ID FileType UploadFileContents
...@@ -146,37 +135,16 @@ mapFTree f {state, currentNode} = {state: f state, currentNode: currentNode} ...@@ -146,37 +135,16 @@ mapFTree f {state, currentNode} = {state: f state, currentNode: currentNode}
-- TODO: make it a local function -- TODO: make it a local function
performAction :: forall props. PerformAction State props Action performAction :: forall props. PerformAction State props Action
performAction (ToggleFolder i) _ _ =
modifyState_ $ mapFTree $ toggleNode i
performAction (ShowPopOver id) _ _ =
modifyState_ $ mapFTree $ map $ popOverNode id
performAction (ShowRenameBox id) _ _ =
modifyState_ $ mapFTree $ map $ showPopOverNode id
performAction (CancelRename id) _ _ =
modifyState_ $ mapFTree $ map $ showPopOverNode id
performAction (ToggleCreateNode id) _ _ = do
modifyState_ $ mapFTree $ map $ hidePopOverNode id
modifyState_ $ mapFTree $ showCreateNode id
performAction (DeleteNode nid) _ _ = do performAction (DeleteNode nid) _ _ = do
void $ lift $ deleteNode nid void $ lift $ deleteNode nid
modifyState_ $ mapFTree $ filterNTree (\(LNode {id}) -> id /= nid) modifyState_ $ mapFTree $ filterNTree (\(LNode {id}) -> id /= nid)
performAction (Submit rid name) _ _ = do performAction (Submit rid name) _ _ = do
void $ lift $ renameNode rid $ RenameValue {name} void $ lift $ renameNode rid $ RenameValue {name}
modifyState_ $ mapFTree $ map $ popOverNode rid
<<< onNode rid (\(LNode node) -> LNode (node { name = name }))
performAction (CreateSubmit nid name nodeType) _ _ = do performAction (CreateSubmit nid name nodeType) _ _ = do
void $ lift $ createNode nid $ CreateValue {name, nodeType} void $ lift $ createNode nid $ CreateValue {name, nodeType}
modifyState_ $ mapFTree $ map $ hidePopOverNode nid --modifyState_ $ mapFTree $ map $ hidePopOverNode nid
performAction (Create nid) _ _ = do
modifyState_ $ mapFTree $ showCreateNode nid
performAction (SetNodeValue v nid) _ _ = performAction (SetNodeValue v nid) _ _ =
modifyState_ $ mapFTree $ setNodeValue nid v modifyState_ $ mapFTree $ setNodeValue nid v
...@@ -184,9 +152,6 @@ performAction (SetNodeValue v nid) _ _ = ...@@ -184,9 +152,6 @@ performAction (SetNodeValue v nid) _ _ =
performAction (CurrentNode nid) _ _ = performAction (CurrentNode nid) _ _ =
modifyState_ $ \{state: s} -> {state: s, currentNode : Just nid} modifyState_ $ \{state: s} -> {state: s, currentNode : Just nid}
performAction (PrepareUploadFile nid contents) _ _ = do
modifyState_ $ mapFTree $ map $ toggleFileTypeBox nid contents
performAction (UploadFile nid fileType contents) _ _ = do performAction (UploadFile nid fileType contents) _ _ = do
hashes <- lift $ uploadFile nid fileType contents hashes <- lift $ uploadFile nid fileType contents
liftEffect $ log2 "uploaded:" hashes liftEffect $ log2 "uploaded:" hashes
...@@ -201,31 +166,11 @@ onNode id f l@(LNode node) ...@@ -201,31 +166,11 @@ onNode id f l@(LNode node)
| node.id == id = f l | node.id == id = f l
| otherwise = l | otherwise = l
popOverNode :: ID -> LNode -> LNode --toggleFileTypeBox :: ID -> UploadFileContents -> LNode -> LNode
popOverNode sid (LNode node) = --toggleFileTypeBox sid contents (LNode node@{id, droppedFile: Nothing}) | sid == id = LNode $ node {droppedFile = droppedFile}
LNode $ node { popOver = toggleIf (sid == node.id) node.popOver -- where
, showRenameBox = false } -- droppedFile = Just $ DroppedFile {contents: contents, fileType: Nothing}
--toggleFileTypeBox sid _ (LNode node) = LNode $ node {droppedFile = Nothing}
hidePopOverNode :: ID -> LNode -> LNode
hidePopOverNode sid (LNode node) =
LNode $ node { popOver = false }
showPopOverNode :: ID -> LNode -> LNode
showPopOverNode sid (LNode node) =
LNode $ node {showRenameBox = toggleIf (sid == node.id) node.showRenameBox}
toggleFileTypeBox :: ID -> UploadFileContents -> LNode -> LNode
toggleFileTypeBox sid contents (LNode node@{id, droppedFile: Nothing}) | sid == id = LNode $ node {droppedFile = droppedFile}
where
droppedFile = Just $ DroppedFile {contents: contents, fileType: Nothing}
toggleFileTypeBox sid _ (LNode node) = LNode $ node {droppedFile = Nothing}
-- TODO: DRY, NTree.map
showCreateNode :: ID -> NTree LNode -> NTree LNode
showCreateNode sid (NTree (LNode node@{id, createNode}) ary) =
NTree (LNode $ node {createNode = createNode'}) $ map (showCreateNode sid) ary
where
createNode' = if sid == id then not createNode else createNode
-- TODO: DRY, NTree.map -- TODO: DRY, NTree.map
setNodeValue :: ID -> String -> NTree LNode -> NTree LNode setNodeValue :: ID -> String -> NTree LNode -> NTree LNode
...@@ -234,13 +179,6 @@ setNodeValue sid v (NTree (LNode node@{id}) ary) = ...@@ -234,13 +179,6 @@ setNodeValue sid v (NTree (LNode node@{id}) ary) =
where where
nvalue = if sid == id then v else "" nvalue = if sid == id then v else ""
-- TODO: DRY, NTree.map
toggleNode :: ID -> NTree LNode -> NTree LNode
toggleNode sid (NTree (LNode node@{id, open}) ary) =
NTree (LNode $ node {open = nopen}) $ map (toggleNode sid) ary
where
nopen = if sid == id then not open else open
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -279,8 +217,8 @@ loadedTreeview = simpleSpec performAction render ...@@ -279,8 +217,8 @@ loadedTreeview = simpleSpec performAction render
render :: Render State LoadedTreeViewProps Action render :: Render State LoadedTreeViewProps Action
render dispatch _ {state, currentNode} _ = render dispatch _ {state, currentNode} _ =
[ div [className "tree"] [ div [className "tree"]
[ toHtml dispatch state currentNode [ --toHtml dispatch state currentNode
(R2.scuff $ toHtml dispatch state currentNode)
] ]
] ]
...@@ -303,18 +241,19 @@ treeview = simpleSpec defaultPerformAction render ...@@ -303,18 +241,19 @@ treeview = simpleSpec defaultPerformAction render
} ] } ]
nodePopupView :: (Action -> Effect Unit) -> FTree -> R.Element --nodePopupView :: forall s. (Action -> Effect Unit) -> FTree -> RAction s -> R.Element
nodePopupView d s@(NTree (LNode {id, name, popOver: true, showRenameBox }) ary) = 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
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"
, style: { border:"1px solid rgba(0,0,0,0.2)" , style: { border:"1px solid rgba(0,0,0,0.2)"
, boxShadow : "0 2px 5px rgba(0,0,0,0.2)"} , boxShadow : "0 2px 5px rgba(0,0,0,0.2)"}
} }
[ panelHeading [ panelHeading renameBoxOpen
, panelBody , panelBody
] ]
] ]
...@@ -324,45 +263,40 @@ nodePopupView d s@(NTree (LNode {id, name, popOver: true, showRenameBox }) ary) ...@@ -324,45 +263,40 @@ nodePopupView d s@(NTree (LNode {id, name, popOver: true, showRenameBox }) ary)
, 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"}
panelHeading = panelHeading renameBoxOpen@(open /\ _) =
H.div {className: "panel-heading"} H.div {className: "panel-heading"}
[ H.div {className: "row" } [ H.div {className: "row" }
( (
[ H.div {className: if (showRenameBox) then "col-md-10" else "col-md-8"} [ H.div {className: if (open) then "col-md-10" else "col-md-8"}
[ renameBox d s ] [ renameBox d nodeState renameBoxOpen ]
] <> [ editIcon showRenameBox ] <> [ ] <> [ editIcon renameBoxOpen ] <> [
H.div {className: "col-md-2"} H.div {className: "col-md-2"}
[ H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove" [ H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove"
, onClick: mkEffectFn1 $ \_ -> d $ ShowPopOver id , onClick: mkEffectFn1 $ \_ -> setNodeState $ setPopOver false s
, title: "Close"} [] , title: "Close"} []
] ]
] ]
) )
] ]
glyphicon t = "glyphitem glyphicon glyphicon-" <> t glyphicon t = "glyphitem glyphicon glyphicon-" <> t
editIcon false = H.div {className: "col-md-2"} editIcon (false /\ setRenameBoxOpen) =
[ H.a {style: {color:"black"} H.div {className: "col-md-2"}
, className: "btn glyphitem glyphicon glyphicon-pencil" [ H.a {style: {color: "black"}
, id: "rename1" , className: "btn glyphitem glyphicon glyphicon-pencil"
, title: "Rename" , id: "rename1"
, onClick: mkEffectFn1 $ (\_-> d $ (ShowRenameBox id))} , title: "Rename"
[] , onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen true
] }
editIcon true = H.div {} [] []
]
editIcon (true /\ _) = H.div {} []
panelBody = panelBody =
H.div {className: "panel-body" H.div {className: "panel-body"
, style: { display:"flex" , style: { display:"flex"
, justifyContent : "center" , justifyContent : "center"
, backgroundColor: "white" , backgroundColor: "white"
, border: "none"}} , border: "none"}}
[ H.div {className: "col-md-4"} [ createButton
[ H.a {style: iconAStyle
, className: (glyphicon "plus")
, id: "create"
, title: "Create"
, onClick: mkEffectFn1 $ (\_ -> d $ (ToggleCreateNode id))}
[]
]
, H.div {className: "col-md-4"} , H.div {className: "col-md-4"}
[ H.a {style: iconAStyle [ H.a {style: iconAStyle
, className: (glyphicon "download-alt") , className: (glyphicon "download-alt")
...@@ -386,14 +320,24 @@ nodePopupView d s@(NTree (LNode {id, name, popOver: true, showRenameBox }) ary) ...@@ -386,14 +320,24 @@ nodePopupView d s@(NTree (LNode {id, name, popOver: true, showRenameBox }) ary)
[] []
] ]
] ]
where
createButton =
H.div {className: "col-md-4"}
[ H.a {style: iconAStyle
, className: (glyphicon "plus")
, id: "create"
, title: "Create"
, onClick: mkEffectFn1 $ \_ -> setNodeState $ setCreateOpen (not createOpen) $ setPopOver false s
}
[]
]
nodePopupView _ _ = R.createElement el {} [] nodePopupView _ _ = R.createElement el {} []
where where
el = R.hooksComponent "CreateNodeView" cpt el = R.hooksComponent "CreateNodeView" cpt
cpt props _ = pure $ H.div {} [] cpt props _ = pure $ H.div {} []
renameBox :: (Action -> Effect Unit) -> FTree -> R.Element renameBox d (s@(NTree (LNode {id, name}) _) /\ setNodeState) (true /\ setRenameBoxOpen) = R.createElement el {} []
renameBox d s@(NTree (LNode {id, name, showRenameBox: true}) _) = R.createElement el {} []
where where
el = R.hooksComponent "RenameBox" cpt el = R.hooksComponent "RenameBox" cpt
cpt props _ = do cpt props _ = do
...@@ -416,23 +360,25 @@ renameBox d s@(NTree (LNode {id, name, showRenameBox: true}) _) = R.createElemen ...@@ -416,23 +360,25 @@ renameBox d s@(NTree (LNode {id, name, showRenameBox: true}) _) = R.createElemen
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 $ \_ -> d $ (Submit id newName) , onClick: mkEffectFn1 $ \_ -> do
setNodeState $ setPopOver false $ setName newName s
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 $ \_ -> d $ (CancelRename id) , onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen false
, title: "Cancel" , title: "Cancel"
} [] } []
renameBox _ s@(NTree (LNode {name}) _) = R.createElement el {} [] renameBox _ (s@(NTree (LNode {name}) _) /\ _) (false /\ _) = R.createElement el {} []
where where
el = R.hooksComponent "RenameBox" cpt el = R.hooksComponent "RenameBox" cpt
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) -> FTree -> R.Element
createNodeView d s@(NTree (LNode {id, createNode: true, nodeValue}) _) = 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
...@@ -456,7 +402,7 @@ createNodeView d s@(NTree (LNode {id, createNode: true, nodeValue}) _) = R.creat ...@@ -456,7 +402,7 @@ createNodeView d s@(NTree (LNode {id, createNode: true, nodeValue}) _) = R.creat
[ 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" [ H.a { className: "btn text-danger glyphitem glyphicon glyphicon-remove"
, onClick: mkEffectFn1 $ \_ -> d $ ToggleCreateNode id , onClick: mkEffectFn1 $ \_ -> setNodeState $ setCreateOpen false s
, title: "Close"} [] , title: "Close"} []
] ]
] ]
...@@ -497,17 +443,16 @@ createNodeView _ _ = R.createElement el {} [] ...@@ -497,17 +443,16 @@ createNodeView _ _ = R.createElement el {} []
fileTypeView :: (Action -> Effect Unit) -> FTree -> R.Element --fileTypeView :: (Action -> Effect Unit) -> FTree -> R.Element
fileTypeView d s@(NTree (LNode {id, droppedFile: Just (DroppedFile {contents, fileType: Nothing})}) _) = R.createElement el {} [] fileTypeView d (s@(NTree (LNode {id}) _) /\ _) (Just (DroppedFile {contents, fileType}) /\ setDroppedFile) = R.createElement el {} []
where where
el = R.hooksComponent "FileTypeView" cpt el = R.hooksComponent "FileTypeView" cpt
cpt props _ = do cpt props _ = do
fileType <- R.useState $ \_ -> pure CSV
pure $ H.div tooltipProps $ pure $ H.div tooltipProps $
[ H.div {className: "panel panel-default"} [ H.div {className: "panel panel-default"}
[ panelHeading [ panelHeading
, panelBody fileType , panelBody
, panelFooter fileType , panelFooter
] ]
] ]
where where
...@@ -521,98 +466,119 @@ fileTypeView d s@(NTree (LNode {id, droppedFile: Just (DroppedFile {contents, fi ...@@ -521,98 +466,119 @@ fileTypeView d s@(NTree (LNode {id, droppedFile: Just (DroppedFile {contents, fi
[ H.h5 {} [H.text "Choose file type"] ] [ H.h5 {} [H.text "Choose file type"] ]
, H.div {className: "col-md-2"} , H.div {className: "col-md-2"}
[ H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove" [ H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove"
, onClick: mkEffectFn1 $ \_ -> d $ PrepareUploadFile id contents , onClick: mkEffectFn1 $ \_ -> setDroppedFile $ Nothing
, title: "Close"} [] , title: "Close"} []
] ]
] ]
] ]
panelBody (_ /\ setFileType) = panelBody =
H.div {className: "panel-body"} H.div {className: "panel-body"}
[ R2.select {className: "col-md-12 form-control" [ R2.select {className: "col-md-12 form-control"
, onChange: onChange} , onChange: onChange}
(map renderOption [CSV, PresseRIS]) (map renderOption [CSV, PresseRIS])
] ]
where where
onChange = mkEffectFn1 $ \e -> setFileType $ readFileType $ e .. "target" .. "value" onChange = mkEffectFn1 $ \e ->
setDroppedFile $ 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 (ft /\ _) = panelFooter =
H.div {className: "panel-footer"} H.div {className: "panel-footer"}
[ H.button {className: "btn btn-success" [
, _type: "button" case fileType of
, onClick: mkEffectFn1 $ \_ -> d $ (UploadFile id ft contents) Just ft ->
} [H.text "Upload"] H.button {className: "btn btn-success"
, _type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setDroppedFile $ Nothing
d $ (UploadFile id ft contents)
} [H.text "Upload"]
Nothing ->
H.button {className: "btn btn-success disabled"
, _type: "button"
} [H.text "Upload"]
] ]
fileTypeView _ _ = R.createElement el {} [] fileTypeView _ _ (Nothing /\ _) = R.createElement el {} []
where where
el = R.hooksComponent "FileTypeView" cpt el = R.hooksComponent "FileTypeView" cpt
cpt props _ = pure $ H.div {} [] cpt props _ = pure $ H.div {} []
popOverValue :: FTree -> Boolean
popOverValue (NTree (LNode {popOver}) ary) = popOver
getCreateNodeValue :: FTree -> String getCreateNodeValue :: FTree -> String
getCreateNodeValue (NTree (LNode {nodeValue}) ary) = nodeValue getCreateNodeValue (NTree (LNode {nodeValue}) ary) = nodeValue
toHtml :: (Action -> Effect Unit) -> FTree -> Maybe ID -> ReactElement toHtml :: (Action -> Effect Unit) -> FTree -> Maybe ID -> R.Element
toHtml d s@(NTree (LNode {id, name, nodeType}) []) n = toHtml d s@(NTree (LNode {id, name, nodeType}) ary) n = R.createElement el {} []
ul []
[
li [] $ [span []
[ a [className "glyphicon glyphicon-cog", _id "rename-leaf",onClick $ (\_-> d $ (ShowPopOver id))] []
, a [ href (toUrl Front nodeType (Just id)), style {"margin-left":"22px"}
, onClick $ (\e -> d $ CurrentNode id)
]
[ if n == (Just id) then u [] [b [] [text ("| " <> name <> " | ")]] else text (name <> " ") ]
, (R2.scuff $ nodePopupView d s)
, (R2.scuff $ createNodeView d s)
, (R2.scuff $ fileTypeView d s)
]
]]
--- need to add renameTreeview value to this function
toHtml d s@(NTree (LNode {id, name, nodeType, open}) ary) n =
ul []
[ li [] $
( [span [onDrop dropHandler, onDragOver onDragOverHandler] [
a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []]
, a [ href (toUrl Front nodeType (Just id)), style {"margin-left":"22px"}
, onClick $ (\e -> d $ CurrentNode id)
]
--[ text name ]
[ if n == (Just id) then u [] [b [] [text $ "| " <> name <> " |"]] else text name ]
, a [ className "glyphicon glyphicon-cog"
, _id "rename"
, onClick $ (\_-> d $ (ShowPopOver id))
] []
, (R2.scuff $ nodePopupView d s)
, (R2.scuff $ createNodeView d s)
, (R2.scuff $ fileTypeView d s)
]
] <> if open then
map (\cs -> toHtml d cs n) ary
else []
)
]
where where
dropHandler = \e -> unsafePartial $ do el = R.hooksComponent "NodeView" cpt
let ff = fromJust $ item 0 $ ((e .. "dataTransfer" .. "files") :: FileList) cpt props _ = do
liftEffect $ log2 "drop:" ff nodeState <- R.useState $ \_ -> pure s
-- prevent redirection when file is dropped folderOpen <- R.useState $ \_ -> pure true
E.preventDefault e droppedFile <- R.useState $ \_ -> pure (Nothing :: Maybe DroppedFile)
E.stopPropagation e
let blob = toBlob $ ff pure $ H.ul {}
void $ runAff (\_ -> pure unit) do [ H.li {}
contents <- readAsText blob ( [H.span (dropProps droppedFile)
liftEffect $ d $ PrepareUploadFile id (UploadFileContents contents) [ folderIcon folderOpen
onDragOverHandler = \e -> do , H.a { href: (toUrl Front nodeType (Just id))
-- prevent redirection when file is dropped , style: {"margin-left": "22px"}
-- https://stackoverflow.com/a/6756680/941471 , onClick: mkEffectFn1 $ (\e -> d $ CurrentNode id)
E.preventDefault e }
E.stopPropagation e [ nodeText s n ]
, popOverIcon nodeState
, nodePopupView d nodeState
fldr :: Boolean -> DOM.Props , createNodeView d nodeState
fldr open = if open then className "fas fa-folder-open" else className "fas fa-folder" , fileTypeView d nodeState droppedFile
]
] <> childNodes d n ary folderOpen
)
]
where
folderIcon folderOpen@(open /\ _) =
H.a {onClick: R2.effToggler folderOpen}
[ H.i {className: fldr open} [] ]
dropProps (_ /\ setDroppedFile) = {
onDrop: dropHandler
, onDragOver: onDragOverHandler
}
where
dropHandler = mkEffectFn1 $ \e -> unsafePartial $ do
let ff = fromJust $ item 0 $ ((e .. "dataTransfer" .. "files") :: FileList)
liftEffect $ log2 "drop:" ff
-- prevent redirection when file is dropped
E.preventDefault e
E.stopPropagation e
let blob = toBlob $ ff
void $ runAff (\_ -> pure unit) do
contents <- readAsText blob
liftEffect $ setDroppedFile $ Just $ DroppedFile {contents: (UploadFileContents contents), fileType: Just CSV}
onDragOverHandler = mkEffectFn1 $ \e -> do
-- prevent redirection when file is dropped
-- https://stackoverflow.com/a/6756680/941471
E.preventDefault e
E.stopPropagation e
childNodes :: forall s. (Action -> Effect Unit) -> Maybe ID -> (Array (NTree LNode)) -> Tuple Boolean (Boolean -> Effect s) -> Array R.Element
childNodes d n [] _ = []
childNodes d n _ (false /\ _) = []
childNodes d n ary (true /\ _) = map (\cs -> toHtml d cs n) ary
nodeText (NTree (LNode {id, name}) _) n = if n == (Just id) then
H.u {} [H.b {} [H.text ("| " <> name <> " | ")]]
else
H.text (name <> " ")
popOverIcon (s@(NTree (LNode {popOver}) _) /\ setNodeState) =
H.a { className: "glyphicon glyphicon-cog"
, id: "rename-leaf"
, onClick: mkEffectFn1 $ \_ -> setNodeState $ setPopOver (not popOver) s
} []
fldr :: Boolean -> String
fldr open = if open then "fas fa-folder-open" else "fas fa-folder"
loadNode :: ID -> Aff FTree loadNode :: ID -> Aff FTree
......
...@@ -2,20 +2,22 @@ module Gargantext.Utils.Reactix ...@@ -2,20 +2,22 @@ module Gargantext.Utils.Reactix
where where
import Prelude import Prelude
import Data.Maybe ( Maybe(..) )
import Data.Nullable ( Nullable, null, toMaybe )
import Data.Traversable ( traverse_ )
import Data.Tuple ( Tuple(..) )
import Data.Tuple.Nested ( (/\) )
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable, null, toMaybe)
import Data.Traversable (traverse_)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import FFI.Simple ( (...), defineProperty ) import Effect.Uncurried (mkEffectFn1)
import React ( ReactElement ) import FFI.Simple ((...), defineProperty)
import React (ReactElement)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML (ElemFactory) import Reactix.DOM.HTML (ElemFactory)
import Reactix.React (createElement) import Reactix.React (createElement)
import Reactix.SyntheticEvent as RE import Reactix.SyntheticEvent as RE
import Unsafe.Coerce ( unsafeCoerce ) import Unsafe.Coerce (unsafeCoerce)
newtype Point = Point { x :: Number, y :: Number } newtype Point = Point { x :: Number, y :: Number }
-- | Turns a ReactElement into a Reactix Element -- | Turns a ReactElement into a Reactix Element
...@@ -46,3 +48,5 @@ useLayoutEffect1' a f = R.useLayoutEffect1 a $ \_ -> ...@@ -46,3 +48,5 @@ useLayoutEffect1' a f = R.useLayoutEffect1 a $ \_ ->
select :: ElemFactory select :: ElemFactory
select = createElement "select" select = createElement "select"
effToggler (value /\ setValue) = mkEffectFn1 $ \_ -> setValue $ not value
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