module Gargantext.Components.Forest.Tree.Node.Tools where
import Gargantext.Prelude
( class Ord, class Read, class Show, Unit
, bind, const, discard, map, not, pure, read, show, when, mempty
, ($), (<), (<<<), (<>), (<$>), (<*>) )
import Data.Maybe (fromMaybe, Maybe(..))
import Data.Nullable (null)
import Data.Set (Set)
import Data.Set as Set
import Data.String as S
import Data.String.CodeUnits as DSCU
import Effect (Effect)
import Effect.Aff (Aff, launchAff, launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.Forest.Tree.Node.Action (Action, icon, text)
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Ends (Frontends, url)
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types as GT
import Gargantext.Utils (toggleSet)
import Gargantext.Utils.Glyphicon (glyphicon)
import Gargantext.Utils.ReactTooltip as ReactTooltip
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools"
fragmentPT :: String -> R.Element
fragmentPT text = H.div { style: { margin: "10px" }} [ H.text text ]
type Body = Array R.Element
type Footer = R.Element
panel :: Body -> Footer -> R.Element
panel bodies submit =
R.fragment
[ H.div { className: "card-body" }
[ H.div { className: "row" }
-- TODO add type for text or form here [ H.form {className: "form-horizontal"} bodies ]
[ H.div { className: "col-12" } bodies ]]
, H.div {className: "card-footer"}
[ H.div { className: "row" }
[ H.div { className: "mx-auto"} [ submit ] ]]]
type TextInputBoxProps =
( id :: GT.ID
, dispatch :: Action -> Aff Unit
, text :: String
, isOpen :: T.Box Boolean
, boxName :: String
, boxAction :: String -> Action
)
textInputBox :: R2.Component TextInputBoxProps
textInputBox = R.createElement textInputBoxCpt
textInputBoxCpt :: R.Component TextInputBoxProps
textInputBoxCpt = here.component "textInputBox" cpt where
cpt { boxAction, boxName, dispatch, id, isOpen, text } _ =
content <$> T.useLive T.unequal isOpen <*> R.useRef text
where
content false _ = (R.fragment [])
content true renameNodeNameRef =
H.div { className: "from-group row" }
[ textInput renameNodeNameRef
, submitBtn renameNodeNameRef
, cancelBtn
]
textInput renameNodeNameRef =
H.div { className: "col-8" }
[ inputWithEnter {
autoFocus: true
, className: "form-control"
, defaultValue: text
, onBlur: R.setRef renameNodeNameRef
, onEnter: submit renameNodeNameRef
, onValueChanged: R.setRef renameNodeNameRef
, placeholder: (boxName <> " Node")
, type: "text"
}
]
submitBtn renameNodeNameRef =
H.a { type: "button"
, title: "Submit"
, on: { click: submit renameNodeNameRef }
, className: "col-2 " <> glyphicon "floppy-o" } []
cancelBtn =
H.a { type: "button", title: "Cancel", on: { click }
, className: "text-danger col-2 " <> glyphicon "times" } []
submit ref _ = do
launchAff_ $ dispatch (boxAction $ R.readRef ref)
T.write_ false isOpen
click _ = T.write_ false isOpen
type DefaultText = String
formEdit :: forall prev next
. DefaultText -> ((prev -> String) -> Effect next) -> R.Element
formEdit defaultValue setter =
H.div { className: "form-group" }
[ H.input { defaultValue, type: "text", on: { input }
, placeholder: defaultValue, className: "form-control" }
] where input = setter <<< const <<< R.unsafeEventValue
-- | Form Choice input
-- if the list of options is not big enough, a button is used instead
formChoiceSafe :: forall item m
. Read item
=> Show item
=> Array item
-> item
-> (item -> Effect m)
-> (item -> String)
-> R.Element
formChoiceSafe [] _ _ _ = mempty
formChoiceSafe [n] _ cbk prnt = formButton n cbk prnt
formChoiceSafe arr def cbk prnt = formChoice arr def cbk prnt
-- | List Form
formChoice :: forall item m
. Read item
=> Show item
=> Array item
-> item
-> (item -> Effect m)
-> (item -> String)
-> R.Element
formChoice items def cbk prnt =
H.div { className: "form-group"}
[
R2.select
{ className: "form-control with-icon-font"
, on: { change }
} $
map option items
]
where
change e = cbk $ fromMaybe def $ read $ R.unsafeEventValue e
option opt =
H.option { value: show opt }
[ H.text $ prnt opt ]
-- | Button Form
-- FIXME: currently needs a click from the user (by default, we could avoid such click)
formButton :: forall item m
. item
-> (item -> Effect m)
-> (item -> String)
-> R.Element
formButton item cbk prnt =
H.div {}
[
H.text $ "Confirm the selection of: " <> prnt item
,
cta
]
where
cta =
H.button
{ className : "cold-md-5 btn btn-primary center"
, type : "button"
, title: "Form Button"
, style : { width: "100%" }
, on: { click: \_ -> cbk item }
}
[ H.text "Confirmation" ]
------------------------------------------------------------------------
------------------------------------------------------------------------
submitButton :: Action -> (Action -> Aff Unit) -> R.Element
submitButton action dispatch =
H.button { className : "btn btn-primary fa fa-" <> icon action
, type: "button"
, id: S.toLower $ show action
, title: show action
, on: {click: \_ -> launchAff $ dispatch action}
}
[ H.text $ " " <> text action]
type Href = String
submitButtonHref :: Action -> Href -> R.Element
submitButtonHref action href =
H.a { className, href, target: "_blank" } [ H.text $ " " <> text action ] where
className = "btn btn-primary fa fa-" <> icon action
------------------------------------------------------------------------
-- | CheckBox tools
-- checkboxes: Array of boolean values (basic: without pending option)
-- checkbox : One boolean value only
type CheckboxProps =
( value :: T.Box Boolean )
checkbox :: R2.Leaf CheckboxProps
checkbox props = R.createElement checkboxCpt props []
checkboxCpt :: R.Component CheckboxProps
checkboxCpt = here.component "checkbox" cpt
where
cpt { value } _ = do
value' <- T.useLive T.unequal value
pure $ H.input { className: "form-check-input"
, on: { click }
, type: "checkbox"
, value: value' }
where
click _ = T.modify_ not value
data CheckBoxes = Multiple | Uniq
type CheckboxesListGroup a =
( groups :: Array a
, options :: T.Box (Set a) )
checkboxesListGroup :: forall a. Ord a => Show a => R2.Component (CheckboxesListGroup a)
checkboxesListGroup = R.createElement checkboxesListGroupCpt
checkboxesListGroupCpt :: forall a. Ord a => Show a => R.Component (CheckboxesListGroup a)
checkboxesListGroupCpt = here.component "checkboxesListGroup" cpt
where
cpt { groups, options } _ = do
options' <- T.useLive T.unequal options
let one a =
H.li { className: "list-group-item" }
[ H.div { className: "form-check" }
[ H.input { defaultChecked: Set.member a options'
, on: { click: \_ -> T.write_ (toggleSet a options') options
, type: "checkbox" }
, className: "form-check-input" }
, H.label { className: "form-check-label" } [ H.text (show a) ] ]
]
pure $ R.fragment $ map one $ Set.toUnfoldable options'
prettyNodeType :: GT.NodeType -> String
prettyNodeType
= S.replace (S.Pattern "Node") (S.Replacement " ")
<<< S.replace (S.Pattern "Folder") (S.Replacement " ")
<<< show
tooltipId :: GT.NodeID -> String
tooltipId id = "node-link-" <> show id
-- START node link
type NodeLinkProps = (
frontends :: Frontends
, folderOpen :: T.Box Boolean
, handed :: GT.Handed
, id :: Int
, isSelected :: Boolean
, name :: GT.Name
, nodeType :: GT.NodeType
, session :: Session
)
nodeLink :: R2.Component NodeLinkProps
nodeLink = R.createElement nodeLinkCpt
nodeLinkCpt :: R.Component NodeLinkProps
nodeLinkCpt = here.component "nodeLink" cpt
where
cpt { folderOpen
, frontends
, handed
, id
, isSelected
, name
, nodeType
, session
} _ = do
popoverRef <- R.useRef null
pure $
H.div { className: "node-link"
, on: { click } }
[ H.a { href, data: { for: tooltipId id, tip: true } }
[ nodeText { handed, isSelected, name } []
, ReactTooltip.reactTooltip { effect: "float", id: tooltipId id, type: "dark" }
[ R2.row
[ H.h4 {className: GT.fldr nodeType true}
[ H.text $ GT.prettyNodeType nodeType ]
]
, R2.row [ H.span {} [ H.text $ name ]]
]
]
]
where
-- NOTE Don't toggle tree if it is not selected
-- click on closed -> open
-- click on open -> ?
click _ = when (not isSelected) (T.write_ true folderOpen)
href = url frontends $ GT.NodePath (sessionId session) nodeType (Just id)
-- END node link
type NodeTextProps =
( isSelected :: Boolean
, handed :: GT.Handed
, name :: GT.Name
)
nodeText :: R2.Component NodeTextProps
nodeText = R.createElement nodeTextCpt
nodeTextCpt :: R.Component NodeTextProps
nodeTextCpt = here.component "nodeText" cpt where
cpt { isSelected, handed, name } _ =
pure $ if isSelected then
H.u { className }
[ H.b {}
[ H.text ("| " <> name15 name <> " | ") ]
]
else
GT.flipHanded l r handed where
l = H.text "..."
r = H.text (name15 name)
name_ len n =
if S.length n < len then n
else case (DSCU.slice 0 len n) of
Nothing -> "???"
Just s -> s <> "..."
name15 = name_ 15
className = "node-text"