module Gargantext.Components.Forest.Tree.Node.Box where
import DOM.Simple.Console (log2)
import Data.Array (filter, null)
import Data.Maybe (Maybe(..), fromJust, isJust)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff, runAff)
import Effect.Class (liftEffect)
import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..))
import Gargantext.Components.Forest.Tree.Node
import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Components.Forest.Tree.Node.Action.Add
import Gargantext.Components.Forest.Tree.Node.Action.Rename
import Gargantext.Components.Forest.Tree.Node.Action.Upload
import Gargantext.Components.Search.Types
import Gargantext.Components.Search.SearchBar
import Gargantext.Ends (Frontends, url)
import Gargantext.Routes (AppRoute, SessionRoute(..))
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, get, put, post, postWwwUrlencoded, delete)
import Gargantext.Types (class ToQuery, toQuery, NodeType(..), NodePath(..), readNodeType)
import Gargantext.Utils (id, glyphicon)
import Gargantext.Utils.Reactix as R2
import Partial.Unsafe (unsafePartial)
import Prelude hiding (div)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Web.File.File (toBlob)
import Web.File.FileList (FileList, item)
import Web.File.FileReader.Aff (readAsText)
-- Main Node
type NodeMainSpanProps =
( id :: ID
, name :: Name
, nodeType :: NodeType
, mCurrentRoute :: Maybe AppRoute
)
nodeMainSpan :: (Action -> Aff Unit)
-> Record NodeMainSpanProps
-> R.State Boolean
-> Session
-> Frontends
-> R.Element
nodeMainSpan d p folderOpen session frontends = R.createElement el p []
where
el = R.hooksComponent "NodeMainSpan" cpt
cpt {id, name, nodeType, mCurrentRoute} _ = do
-- only 1 popup at a time is allowed to be opened
popupOpen <- R.useState' (Nothing :: Maybe NodePopup)
droppedFile <- R.useState' (Nothing :: Maybe DroppedFile)
isDragOver <- R.useState' false
pure $ H.span (dropProps droppedFile isDragOver) $
[ folderIcon nodeType folderOpen
, H.a { href: (url frontends (NodePath (sessionId session) nodeType (Just id)))
, style: {marginLeft: "22px"}
}
[ nodeText { isSelected: (mCorpusId mCurrentRoute) == (Just id)
, name: name'} ]
, if showBox then popOverIcon popupOpen else H.div {} []
, if showBox
then nodePopupView d { id
, name:name'
, nodeType
, action: Nothing
, session
} popupOpen
else H.div {} []
, fileTypeView d {id, nodeType} droppedFile isDragOver
]
where
name' = if nodeType == NodeUser then show session else name
SettingsBox {show:showBox} = settingsBox nodeType
folderIcon nodeType folderOpen'@(open /\ _) =
H.a {onClick: R2.effToggler folderOpen'}
[ H.i {className: fldr nodeType open} [] ]
popOverIcon (popOver /\ setPopOver) =
H.a { className: "glyphicon glyphicon-cog"
, id: "rename-leaf"
, on: { click: \_ -> setPopOver $ toggle }
} []
where
toggle Nothing = Just NodePopup
toggle _ = Nothing
dropProps droppedFile isDragOver =
{ className: dropClass droppedFile isDragOver
, on: { drop: dropHandler droppedFile
, dragOver: onDragOverHandler isDragOver
, dragLeave: onDragLeave isDragOver } }
where
dropClass (Just _ /\ _) _ = "file-dropped"
dropClass _ (true /\ _) = "file-dropped"
dropClass (Nothing /\ _) _ = ""
dropHandler (_ /\ setDroppedFile) 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
$ const
$ Just
$ DroppedFile { contents: (UploadFileContents contents)
, fileType: Just CSV
}
onDragOverHandler (_ /\ setIsDragOver) e = do
-- prevent redirection when file is dropped
-- https://stackoverflow.com/a/6756680/941471
E.preventDefault e
E.stopPropagation e
setIsDragOver $ const true
onDragLeave (_ /\ setIsDragOver) _ = setIsDragOver $ const false
fldr :: NodeType -> Boolean -> String
fldr nt open = if open
then "glyphicon glyphicon-folder-open" <> color nt
else "glyphicon glyphicon-folder-close" <> color nt
where
color NodeUser = ""
color FolderPublic = ""
color FolderShared = " text-warning"
color _ = " text-danger"
-- START node text
type NodeTextProps =
( isSelected :: Boolean
, name :: Name
)
nodeText :: Record NodeTextProps -> R.Element
nodeText p = R.createElement el p []
where
el = R.hooksComponent "NodeText" cpt
cpt {isSelected: true, name} _ = do
pure $ H.u {} [H.b {} [H.text ("| " <> name <> " | ")]]
cpt {isSelected: false, name} _ = do
pure $ H.text (name <> " ")
-- END node text
mCorpusId :: Maybe AppRoute -> Maybe Int
mCorpusId (Just (Routes.Corpus _ id)) = Just id
mCorpusId (Just (Routes.CorpusDocument _ id _ _)) = Just id
mCorpusId _ = Nothing
-- | START Popup View
type NodePopupProps =
( id :: ID
, name :: Name
, nodeType :: NodeType
, action :: Maybe NodeAction
, session :: Session
)
iconAStyle = { color : "black"
, paddingTop : "6px"
, paddingBottom : "6px"}
nodePopupView :: (Action -> Aff Unit)
-> Record NodePopupProps
-> R.State (Maybe NodePopup)
-> R.Element
nodePopupView d p mPop@(Just NodePopup /\ setPopupOpen) = R.createElement el p []
where
el = R.hooksComponent "NodePopupView" cpt
cpt {id, name, nodeType, action, session} _ = do
renameBoxOpen <- R.useState' false
nodePopupState@(nodePopup /\ setNodePopup) <- R.useState' {id, name, nodeType, action}
pure $ H.div tooltipProps $
[ H.div {id: "arrow"} []
, H.div { className: "panel panel-default"
, style: { border : "1px solid rgba(0,0,0,0.2)"
, boxShadow : "0 2px 5px rgba(0,0,0,0.2)"
}
}
[ panelHeading renameBoxOpen
, panelBody nodePopupState d
, if isJust nodePopup.action
then H.div { className: glyphicon "remove-circle"
, onClick : setNodePopup $ const {id,name,nodeType,action :Nothing}
} []
else H.div {} []
, panelAction d {id,name,nodeType,action:nodePopup.action, session} mPop
]
]
where
tooltipProps = { className: ""
, id: "node-popup-tooltip"
, title: "Node settings"
, data: { toggle: "tooltip"
, placement: "right"}
}
SettingsBox {edit, buttons} = settingsBox nodeType
panelHeading renameBoxOpen@(open /\ _) =
H.div {className: "panel-heading"}
[ -- H.h1 {className : "col-md-12"} [H.text "Settings Box"]
H.div {className: "row" }
[ H.div {className: "col-md-8"} [ renameBox d {id, name} renameBoxOpen ]
, if edit then editIcon renameBoxOpen else H.div {} []
, H.div {className: "col-md-1"}
[ H.a { "type" : "button"
, className: glyphicon "remove-circle"
, onClick: mkEffectFn1 $ \_ -> setPopupOpen $ const Nothing
, title: "Close"} []
]
]
]
where
editIcon (false /\ setRenameBoxOpen) =
H.div {className: "col-md-1"}
[ H.a {style: {color: "black"}
, className: glyphicon "pencil"
, id: "rename1"
, title: "Rename"
, onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen $ const true
}
[]
]
editIcon (true /\ _) = H.div {} []
panelBody nodePopupState d =
H.div {className: "panel-body"
, style: { display:"flex"
, justifyContent : "center"
, backgroundColor: "white"
, border: "none"
}
}
$
[H.div {className: "col-md-1"} []]
<>
(map (buttonClick nodePopupState d) buttons)
nodePopupView _ p _ = R.createElement el p []
where
el = R.hooksComponent "CreateNodeView" cpt
cpt _ _ = pure $ H.div {} []
-- buttonAction :: NodeAction -> R.Element
buttonClick ({id,name,nodeType,action} /\ setNodePopup) _ todo@(Documentation x) = H.div {className: "col-md-2"}
[ H.a { style: iconAStyle
, className: "btn glyphitem glyphicon glyphicon-question-sign" <> if action == (Just todo) then " active" else ""
, id: "doc"
, title: "Documentation of " <> show x
, onClick : mkEffectFn1 $ \_ -> setNodePopup $ const $ {id,name,nodeType,action:Just todo}
}
[]
]
buttonClick ({id,name,nodeType,action} /\ setNodePopup) d Delete = H.div {className: "col-md-2"}
[ H.a { style: iconAStyle
, className: "btn glyphitem glyphicon glyphicon-trash" <> if action == (Just Delete) then " active" else ""
, id: "delete"
, title: "Delete"
, onClick: mkEffectFn1 $ \_ -> setNodePopup $ const { id
, name
, nodeType
, action : Just Delete
}
}
[]
]
buttonClick (node@{action} /\ setNodePopup) d (Add xs) = H.div {className: "col-md-2"}
[ H.a { style: iconAStyle
, className: "btn glyphitem glyphicon glyphicon-plus" <> if action == (Just $ Add xs) then " active" else ""
--, className: (glyphicon "trash")
, id: "add"
, title: "add"
, onClick: mkEffectFn1 $ \_ -> setNodePopup $ const $ node { action = Just $ Add xs}
}
[]
]
--{-
buttonClick ({id,name,nodeType,action} /\ setNodePopup) d SearchBox = H.div {className: "col-md-2"}
[ H.a { style: iconAStyle
, className: "btn glyphitem glyphicon glyphicon-search" <> if action == (Just SearchBox) then " active" else ""
, id: "search"
, title: "Search and create " <> show nodeType
, onClick: mkEffectFn1 $ \_ -> setNodePopup $ const {id, name, nodeType, action : Just SearchBox}
}
[]
]
--}
{-
buttonClick _ _ Upload = H.div {className: "col-md-1"}
[ H.a { style: iconAStyle
, className: (glyphicon "upload")
, id: "upload"
, title: "Upload [WIP]"}
[]
]
buttonClick _ _ Download = H.div {className: "col-md-1"}
[ H.a {style: iconAStyle
, className: (glyphicon "download")
, id: "download"
, title: "Download [WIP]"}
[]
]
-}
buttonClick _ _ _ = H.div {} []
buttonPop f = H.div {className: "col-md-4"}
[ H.a { style: iconAStyle
, className: (glyphicon "plus")
, id: "create"
, title: "Create"
, onClick: mkEffectFn1 $ \_ -> f $ const $ Just CreatePopup
}
[]
]
-- END Popup View
type NodeProps =
( id :: ID
, name :: Name
, nodeType :: NodeType
)
type Open = Boolean
panelAction :: (Action -> Aff Unit)
-> Record NodePopupProps
-> R.State (Maybe NodePopup)
-> R.Element
panelAction d {id,name,nodeType,action, session} p = case action of
(Just (Documentation NodeUser)) -> R.fragment [H.div {} [ H.p {} [ H.text "This account is personal"]
, H.p {} [ H.text "Its uses depends on the instances terms of uses."]
]
]
(Just (Documentation FolderPrivate)) -> R.fragment [H.div {} [H.text $ "This folder and its children are private only!"]]
(Just (Documentation FolderPublic)) -> R.fragment [H.div {} [H.text $ "Soon, you will be able to build public folders to share your work with the world!"]]
(Just (Documentation FolderShared)) -> R.fragment [H.div {} [H.text $ "Soon, you will be able to build teams folders to share your work"]]
(Just (Documentation x)) -> R.fragment [ H.div {} [H.text $ "More information on" <> show nodeType]]
(Just SearchBox) -> R.fragment [ H.div {} [ H.text $ "Search and create a private corpus with the search query as corpus name." ]
, searchBar {session, databases:allDatabases}
]
(Just Delete) -> case nodeType of
NodeUser -> R.fragment [ H.div {} [H.text "Yes, we are RGPD compliant! But you can not delete User Node yet (we are still on development). Thanks for your comprehensin."]]
_ -> R.fragment [ H.div {} [H.text "Are your sure you want to delete, if yes, click again ?"], reallyDelete d]
(Just (Add xs)) -> createNodeView d {id, name, nodeType} p xs
_ -> H.div {} []
reallyDelete d = H.div {className: "panel-footer"}
[ H.a { type: "button"
, className: "btn glyphicon glyphicon-trash"
, id: "delete"
, title: "Delete"
, onClick: mkEffectFn1 $ \_ -> launchAff $ d $ DeleteNode}
[H.text " Yes, delete!"]
]