Node.purs 9.42 KB
Newer Older
1
module Gargantext.Components.Forest.Tree.Node where
2

3 4 5 6 7
import Data.Maybe (Maybe(..))
import Data.Nullable (null)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
8
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
9 10
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileContents(..))
11
import Gargantext.Components.Forest.Tree.Node.Action.Upload (DroppedFile(..), fileTypeView)
12
import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView)
13
import Gargantext.Components.Forest.Tree.Node.Box.Types (CommonProps)
14 15 16
import Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar (asyncProgressBar, BarType(..))
import Gargantext.Components.Forest.Tree.Node.Tools.Task (Tasks)
import Gargantext.Components.Forest.Tree.Node.Tools.Sync (nodeActionsGraph, nodeActionsNodeList)
17
import Gargantext.Components.Forest.Tree.Node.Tools (nodeText)
18 19 20 21 22 23 24
import Gargantext.Components.GraphExplorer.API as GraphAPI
import Gargantext.Components.Lang (Lang(EN))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, const, discard, map, pure, show, unit, void, ($), (<>), (==))
import Gargantext.Routes as Routes
25
import Gargantext.Version as GV
26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (Name, ID)
import Gargantext.Types as GT
import Gargantext.Utils.Popover as Popover
import Gargantext.Utils.Reactix as R2
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Web.File.FileReader.Aff (readAsText)


-- Main Node
type NodeMainSpanProps =
  ( id            :: ID
  , folderOpen    :: R.State Boolean
  , frontends     :: Frontends
  , mCurrentRoute :: Maybe Routes.AppRoute
  , name          :: Name
  , nodeType      :: GT.NodeType
  , tasks         :: Record Tasks
  | CommonProps
  )

nodeMainSpan :: Record NodeMainSpanProps
             -> R.Element
nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el p []
  where
    el = R.hooksComponent "G.C.F.T.N.B.NodeMainSpan" cpt
    cpt props@{id, mCurrentRoute, name, nodeType, tasks: { onTaskFinish, tasks }} _ = do
      -- only 1 popup at a time is allowed to be opened
      droppedFile   <- R.useState' (Nothing :: Maybe DroppedFile)
      isDragOver    <- R.useState' false

      popoverRef    <- R.useRef null

      pure $ H.span (dropProps droppedFile isDragOver) $
62 63
        [ chevronIcon nodeType folderOpen
        , folderIcon nodeType folderOpen
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
        , if showBox then
            Popover.popover { arrow: false
                            , open: false
                            , onClose: \_ -> pure unit
                            , onOpen: \_ -> pure unit
                            , ref: popoverRef } [
                popOverIcon
              , mNodePopupView props (onPopoverClose popoverRef)
            ]
          else H.div {} []
        , H.a { href: (url frontends (GT.NodePath (sessionId session) nodeType (Just id)))
              }
              [ nodeText { isSelected: mAppRouteId mCurrentRoute == Just id
                         , name: name' props
                         } ]
        , nodeActions { id
                      , nodeType
                      , refreshTree: const $ dispatch RefreshTree
                      , session }
        , fileTypeView {dispatch, droppedFile, id, isDragOver, nodeType}
        , H.div {} (map (\t -> asyncProgressBar { asyncTask: t
                                                , barType: Pie
                                                , corpusId: id
                                                , onFinish: const $ onTaskFinish t
                                                , session 
                                                }
                        ) tasks
                   )
92 93 94
        , if nodeType == GT.NodeUser
             then GV.versionView {session}
             else H.div {} []
95 96 97 98 99 100 101 102
        ]
          where
            SettingsBox {show: showBox} = settingsBox nodeType
            onPopoverClose popoverRef _ = Popover.setOpen popoverRef false

    name' {name, nodeType} = if nodeType == GT.NodeUser
                                then show session
                                else name
103

104 105 106 107 108 109 110 111 112
    chevronIcon nodeType folderOpen'@(open /\ _) =
      H.a { className: "chevron-icon"
          , onClick: R2.effToggler folderOpen'
          }
          [ H.i {
               className: if open
                          then "fa fa-chevron-down"
                          else "fa fa-chevron-right"
               } [] ]
113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160

    folderIcon nodeType folderOpen'@(open /\ _) =
      H.a { className: "folder-icon"
          , onClick: R2.effToggler folderOpen'
          }
          [ H.i {className: GT.fldr nodeType open} [] ]

    popOverIcon = H.a { className: "settings fa fa-cog" } []

    mNodePopupView props@{id, nodeType} onPopoverClose =
      nodePopupView { id
                    , dispatch
                    , name: name' props
                    , nodeType
                    , onPopoverClose
                    , session
                    }

    dropProps droppedFile isDragOver =
      { className: "leaf " <> (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          = do
          -- prevent redirection when file is dropped
          E.preventDefault e
          E.stopPropagation e
          blob <- R2.dataTransferFileBlob e
          void $ launchAff do
            contents <- readAsText blob
            liftEffect $ setDroppedFile
                       $ const
                       $ Just
                       $ DroppedFile { contents: (UploadFileContents contents)
                                     , fileType: Just CSV
                                     , lang    : EN
                                     }
    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
161 162

{-
163 164 165 166 167 168 169 170 171
fldr nt open = if open
               then "fa fa-globe" -- <> color nt
               else "fa fa-folder-globe" -- <> color nt
               --else "glyphicon glyphicon-folder-close" <> color nt
                 where
                   color GT.NodeUser     = ""
                   color FolderPublic = ""
                   color FolderShared = " text-warning"
                   color _            = " text-danger"
172
-}
173 174


175
-- START nodeActions
176

177 178 179 180 181 182
type NodeActionsProps =
  ( id          :: ID
  , nodeType    :: GT.NodeType
  , refreshTree :: Unit -> Aff Unit
  , session     :: Session
  )
183

184 185
nodeActions :: Record NodeActionsProps -> R.Element
nodeActions p = R.createElement nodeActionsCpt p []
186

187 188 189 190 191 192 193 194
nodeActionsCpt :: R.Component NodeActionsProps
nodeActionsCpt = R.hooksComponent "G.C.F.T.N.B.nodeActions" cpt
  where
    cpt { id
        , nodeType: GT.Graph
        , refreshTree
        , session
        } _ = do
195

196 197 198 199 200 201
      useLoader id (graphVersions session) $ \gv ->
        nodeActionsGraph { id
                         , graphVersions: gv
                         , session
                         , triggerRefresh: triggerRefresh refreshTree
                         }
202

203 204 205 206 207 208 209 210 211 212 213 214 215 216 217
    cpt { id
        , nodeType: GT.NodeList
        , refreshTree
        , session
        } _ = do
      useLoader { nodeId: id, session } loadCorpusWithChild $
        \{ corpusId } ->
          nodeActionsNodeList { listId: id
                              , nodeId: corpusId
                              , nodeType: GT.TabNgramType GT.CTabTerms
                              , session
                              , triggerRefresh: triggerRefresh refreshTree
                              }
    cpt _ _ = do
      pure $ H.div {} []
218

219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237
    graphVersions session graphId = GraphAPI.graphVersions { graphId, session }
    triggerRefresh refreshTree    = refreshTree


-- END nodeActions

mAppRouteId :: Maybe Routes.AppRoute -> Maybe Int
mAppRouteId (Just (Routes.Folder         _ id)) = Just id
mAppRouteId (Just (Routes.FolderPrivate  _ id)) = Just id
mAppRouteId (Just (Routes.FolderPublic   _ id)) = Just id
mAppRouteId (Just (Routes.FolderShared   _ id)) = Just id
mAppRouteId (Just (Routes.Team           _ id)) = Just id
mAppRouteId (Just (Routes.Corpus         _ id)) = Just id
mAppRouteId (Just (Routes.PGraphExplorer _ id)) = Just id
mAppRouteId (Just (Routes.Dashboard      _ id)) = Just id
mAppRouteId (Just (Routes.Texts          _ id)) = Just id
mAppRouteId (Just (Routes.Lists          _ id)) = Just id
mAppRouteId (Just (Routes.Annuaire       _ id)) = Just id
mAppRouteId (Just (Routes.UserPage       _ id)) = Just id
238 239
mAppRouteId (Just (Routes.RouteFrameWrite _ id)) = Just id
mAppRouteId (Just (Routes.RouteFrameCalc  _ id)) = Just id
240 241 242 243
mAppRouteId (Just (Routes.Document       _ id _  )) = Just id
mAppRouteId (Just (Routes.ContactPage    _ id _  )) = Just id
mAppRouteId (Just (Routes.CorpusDocument _ id _ _)) = Just id
mAppRouteId _ = Nothing
244