module Gargantext.Components.Forest.Tree.Node.Tools where import Gargantext.Prelude import Data.Array as A import Data.Maybe (fromMaybe, Maybe(..)) import Data.Set (Set) import Data.Set as Set import Data.String as S import Data.Tuple.Nested ((/\)) import Effect (Effect) import Effect.Aff (Aff, launchAff, launchAff_) import Gargantext.Components.Bootstrap as B import Gargantext.Components.Bootstrap.Types (Elevation(..), Variant(..)) import Gargantext.Components.Forest.Tree.Node.Action (icon, text) import Gargantext.Components.Forest.Tree.Node.Action.Types (Action) import Gargantext.Components.InputWithEnter (inputWithEnter) import Gargantext.Types as GT import Gargantext.Utils (toggleSet) import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Show as GUS import Reactix as R import Reactix.DOM.HTML as H import Record.Extra as RX import Toestand as T 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 PanelProps = ( mError :: Maybe String ) -- | Last element of panel's children goes to footer, all others go to body panel :: R2.Component PanelProps panel = R.createElement panelCpt panelCpt :: R.Component PanelProps panelCpt = here.component "panel" cpt where cpt { mError } children = do let errorCpt = R2.fromMaybe mError $ \err -> R2.row [ R2.col 12 [ H.div { className: "alert alert-danger" } [ H.text err ] ] ] pure $ R.fragment [ H.div { className: "card-body" } [ H.div { className: "card-text" } [ R2.row -- TODO add type for text or form here [ H.form {className: "form-horizontal"} bodies ] [ R2.col 12 bodies ] , errorCpt ] ] , H.div {className: "card-footer"} [ R2.row [ H.div { className: "mx-auto"} [ footer ] ] ] ] where bodies /\ footer = case A.unsnoc children of Nothing -> [] /\ (H.div {} []) Just { init, last } -> init /\ last -- | A panel without a footer panelNoFooter :: R2.Component PanelProps panelNoFooter = R.createElement panelNoFooterCpt panelNoFooterCpt :: R.Component PanelProps panelNoFooterCpt = here.component "panelNoFooter" cpt where cpt props children = pure $ panel props (children <> [ H.div {} [] ]) type PanelWithSubmitButtonProps = ( action :: Action , dispatch :: Action -> Aff Unit | PanelProps ) -- | A panel with 'submitButton { action, dispatch }' panelWithSubmitButton :: R2.Component PanelWithSubmitButtonProps panelWithSubmitButton = R.createElement panelWithSubmitButtonCpt panelWithSubmitButtonCpt :: R.Component PanelWithSubmitButtonProps panelWithSubmitButtonCpt = here.component "panelWithSubmitButton" cpt where cpt props@{ action, dispatch } children = do let pProps = (RX.pick props :: Record PanelProps) pure $ panel pProps (children -- footer <> [ submitButton { action, dispatch } ]) type PanelWithSubmitButtonHrefProps = ( action :: Action , href :: String | PanelProps ) -- | A panel with 'submitButtonHref { action, href }' panelWithSubmitButtonHref :: R2.Component PanelWithSubmitButtonHrefProps panelWithSubmitButtonHref = R.createElement panelWithSubmitButtonHrefCpt panelWithSubmitButtonHrefCpt :: R.Component PanelWithSubmitButtonHrefProps panelWithSubmitButtonHrefCpt = here.component "panelWithSubmitButtonHref" cpt where cpt props@{ action, href } children = do let pProps = (RX.pick props :: Record PanelProps) pure $ panel pProps (children -- footer <> [ submitButtonHref { action, href } ]) 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, isOpen, text } _ = content <$> T.useLive T.unequal isOpen <*> R.useRef text where content false _ = (R.fragment []) content true renameNodeNameRef = H.div { className: "d-flex align-items-center justify-content-space-between" } [ textInput renameNodeNameRef , submitBtn renameNodeNameRef , cancelBtn ] textInput renameNodeNameRef = H.div { className: "w-10/12" } [ inputWithEnter { autoFocus: true , className: "form-control" , defaultValue: text , onBlur: R.setRef renameNodeNameRef , onEnter: submit renameNodeNameRef , onValueChanged: R.setRef renameNodeNameRef , placeholder: (boxName <> " Node") , type: "text" , required: false } ] submitBtn renameNodeNameRef = B.iconButton { callback: submit renameNodeNameRef , title: "Submit" , name: "floppy-o" , elevation: Level1 } cancelBtn = B.iconButton { callback: const $ T.write_ false isOpen , variant: Danger , title: "Cancel" , name: "times" } submit ref _ = do launchAff_ $ dispatch (boxAction $ R.readRef ref) T.write_ false isOpen type InviteInputBoxProps = ( id :: GT.ID , dispatch :: Action -> Aff Unit , text :: String , boxName :: String , boxAction :: String -> Action , username :: T.Box String ) inviteInputBox :: R2.Component InviteInputBoxProps inviteInputBox = R.createElement inviteInputBoxCpt inviteInputBoxCpt :: R.Component InviteInputBoxProps inviteInputBoxCpt = here.component "textInputBox" cpt where cpt { boxAction, boxName, dispatch, text, username } _ = content <$> R.useRef text where content renameNodeNameRef = H.div { className: "d-flex align-items-center" } [ textInput renameNodeNameRef , B.wad_ [ "d-inline-block", "w-3" ] , submitBtn renameNodeNameRef ] textInput renameNodeNameRef = H.div {} [ inputWithEnter { autoFocus: true , className: "form-control" , defaultValue: text , onBlur: R.setRef renameNodeNameRef , onEnter: submit renameNodeNameRef , onValueChanged: R.setRef renameNodeNameRef , placeholder: (boxName <> " Node") , type: "text" , required: false } ] submitBtn renameNodeNameRef = B.iconButton { callback: submit renameNodeNameRef , title: "Submit" , name: "plus" , elevation: Level1 } submit ref _ = do T.write_ ("Invited " <> R.readRef ref <> " to the team") username launchAff_ $ dispatch (boxAction $ R.readRef ref) -- 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 type FormChoiceSafeProps item m = ( items :: Array item , default :: item , callback :: item -> Effect m , print :: item -> String ) -- | Form Choice input -- if the list of options is not big enough, a button is used instead formChoiceSafe :: forall item m . Show item => R2.Component (FormChoiceSafeProps item m) formChoiceSafe = R.createElement formChoiceSafeCpt formChoiceSafeCpt :: forall item m. Show item => R.Component (FormChoiceSafeProps item m) formChoiceSafeCpt = here.component "formChoiceSafe" cpt where cpt { items, default, callback, print } _ = do pure $ case items of [] -> H.div {} [] [n] -> formButton { item: n, callback, print } [] _ -> formChoice { items, default, callback, print } [] type FormChoiceProps item m = ( items :: Array item , default :: item , callback :: item -> Effect m , print :: item -> String ) -- | List Form formChoice :: forall item m . Show item => R2.Component (FormChoiceProps item m) formChoice = R.createElement formChoiceCpt formChoiceCpt :: forall item m. Show item => R.Component (FormChoiceProps item m) formChoiceCpt = here.component "formChoice" cpt where cpt { items, callback, default, print } _ = do pure $ H.div { className: "form-group"} [ R2.select { className: "form-control with-icon-font" , defaultValue: show default , on: { change } } $ map option items ] where change e = callback $ fromMaybe default $ reader $ R.unsafeEventValue e option opt = H.option { value: show opt } [ H.text $ print opt ] reader = GUS.reader items type FormButtonProps item m = ( item :: item , callback :: item -> Effect m , print :: item -> String ) -- | Button Form -- FIXME: currently needs a click from the user (by default, we could avoid such click) formButton :: forall item m. R2.Component (FormButtonProps item m) formButton = R.createElement formButtonCpt formButtonCpt :: forall item m. R.Component (FormButtonProps item m) formButtonCpt = here.component "formButton" cpt where cpt { item, callback, print} _ = do pure $ H.div {} [ H.text $ "Confirm the selection of: " <> print item , cta ] where cta = H.button { className : "cold-md-5 btn btn-primary center" , type : "button" , title: "Form Button" , style : { width: "100%" } , on: { click: \_ -> callback item } } [ H.text "Confirmation" ] ------------------------------------------------------------------------ ------------------------------------------------------------------------ type SubmitButtonProps = ( action :: Action , dispatch :: Action -> Aff Unit ) submitButton :: R2.Leaf SubmitButtonProps submitButton = R2.leaf submitButtonCpt submitButtonCpt :: R.Component SubmitButtonProps submitButtonCpt = here.component "submitButton" cpt where cpt { action , dispatch } _ = do pure $ 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.span {className: "font-family-theme mx-1"} [ H.text $ " " <> text action] ] type Href = String type SubmitButtonHrefProps = ( action :: Action , href :: Href ) submitButtonHref :: R2.Leaf SubmitButtonHrefProps submitButtonHref = R2.leaf submitButtonHrefCpt submitButtonHrefCpt :: R.Component SubmitButtonHrefProps submitButtonHrefCpt = here.component "submitButtonHref" cpt where cpt { action, href } _ = do pure $ H.a { className, href, target: "_blank" } [ H.span {className: "font-family-theme mx-1"} [ 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 = R2.leaf checkboxCpt 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 { 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'