Tree.purs

module Gargantext.Components.Forest.Tree where

import DOM.Simple.Console (log2)
import Data.Array as A
import Data.Maybe (Maybe)
import Data.Set as Set
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), CreateValue(..), FTree, ID, LNode(..), NTree(..), Reload, RenameValue(..), Tree, createNode, deleteNode, loadNode, renameNode)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
import Gargantext.Components.Forest.Tree.Node.Box (nodeMainSpan)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, const, discard, map, pure, void, ($), (+), (/=), (<>))
import Gargantext.Routes (AppRoute)
import Gargantext.Sessions (OpenNodes, Session, mkNodeId)
import Gargantext.Types as GT
import Reactix as R
import Reactix.DOM.HTML as H

type CommonProps =
  (
      frontends :: Frontends
    , mCurrentRoute :: Maybe AppRoute
    , openNodes :: R.State OpenNodes
    , reload :: R.State Reload
    , session :: Session
  )

------------------------------------------------------------------------
type Props = ( root          :: ID
             | CommonProps
             )

treeView :: Record Props -> R.Element
treeView props = R.createElement treeViewCpt props []

treeViewCpt :: R.Component Props
treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt
  where
    cpt { root, mCurrentRoute, session, frontends, openNodes, reload } _children = do
      pure $ treeLoadView
        { root, mCurrentRoute, session, frontends, openNodes, reload }

treeLoadView :: Record Props -> R.Element
treeLoadView p = R.createElement treeLoadView' p []

treeLoadView' :: R.Component Props
treeLoadView' = R.hooksComponent "TreeLoadView" cpt
  where
    cpt {root, mCurrentRoute, session, frontends, openNodes, reload} _ = do
      let fetch _ = loadNode session root
      let paint loaded = loadedTreeView {tree: loaded, mCurrentRoute, session, frontends, openNodes, reload}
      useLoader {root, counter: fst reload} fetch paint

type TreeViewProps = ( tree          :: FTree
                     | CommonProps
                     )


loadedTreeView :: Record TreeViewProps -> R.Element
loadedTreeView p = R.createElement loadedTreeView' p []

loadedTreeView' :: R.Component TreeViewProps
loadedTreeView' = R.hooksComponent "LoadedTreeView" cpt
  where
    cpt {tree, mCurrentRoute, session, frontends, openNodes, reload} _ = do
      tasks <- R.useState' []

      pure $ H.div {className: "tree"}
        [ toHtml { frontends, mCurrentRoute, openNodes, reload, session, tasks, tree } ]

------------------------------------------------------------------------

type ToHtmlProps =
  (
    tasks :: R.State (Array GT.AsyncTaskWithType)
  , tree :: FTree
  | CommonProps
  )

toHtml :: Record ToHtmlProps -> R.Element
toHtml { frontends
       , mCurrentRoute
       , openNodes
       , reload: reload@(_ /\ setReload)
       , session
       , tasks: tasks@(asyncTasks /\ setAsyncTasks)
       , tree: tree@(NTree (LNode {id, name, nodeType}) ary) } = R.createElement el {} []
  where
    el = R.hooksComponent "NodeView" cpt
    pAction = performAction {openNodes, reload, session, tasks, tree}

    cpt props _ = do
      let nodeId = mkNodeId session id
      let folderIsOpen = Set.member nodeId (fst openNodes)
      let setFn = if folderIsOpen then Set.delete else Set.insert
      let toggleFolderIsOpen _ = (snd openNodes) (setFn nodeId)
      let folderOpen = Tuple folderIsOpen toggleFolderIsOpen

      let withId (NTree (LNode {id: id'}) _) = id'

      pure $ H.ul {}
        [ H.li {}
          ( [ nodeMainSpan { id
                           , asyncTasks
                           , dispatch: pAction
                           , folderOpen
                           , frontends
                           , mCurrentRoute
                           , name
                           , nodeType
                           , onAsyncTaskFinish
                           , session
                           } ]
            <> childNodes {children: ary, folderOpen, frontends, mCurrentRoute, openNodes, reload, session }
          )
        ]

    onAsyncTaskFinish (GT.AsyncTaskWithType {task: GT.AsyncTask {id: id'}}) = do
      setAsyncTasks $ const newAsyncTasks
      setReload (_ + 1)
      where
        newAsyncTasks = A.filter (\(GT.AsyncTaskWithType {task: GT.AsyncTask {id: id''}}) -> id' /= id'') asyncTasks


type ChildNodesProps =
  (
      children :: Array FTree
    , folderOpen :: R.State Boolean
    | CommonProps
  )


childNodes :: Record ChildNodesProps -> Array R.Element
childNodes { children: [] } = []
childNodes { folderOpen: (false /\ _) } = []
childNodes { children, folderOpen: (true /\ _), frontends, mCurrentRoute, openNodes, reload, session } =
  map (\ctree -> childNode {tree: ctree, asyncTasks: []}) $ sorted children
    where
      sorted :: Array FTree -> Array FTree
      sorted = A.sortWith (\(NTree (LNode {id}) _) -> id)
      childNode :: Tree -> R.Element
      childNode props = R.createElement el props []
      el = R.hooksComponent "ChildNodeView" cpt
      cpt {tree, asyncTasks} _ = do
        tasks <- R.useState' asyncTasks
        pure $ toHtml { frontends, mCurrentRoute, openNodes, reload, session, tasks, tree }

performAction :: { openNodes :: R.State OpenNodes
                 , reload :: R.State Reload
                 , session :: Session
                 , tasks :: R.State (Array GT.AsyncTaskWithType)
                 , tree :: FTree }
              -> Action
              -> Aff Unit
performAction { openNodes: (_ /\ setOpenNodes)
              , reload: (_ /\ setReload)
              , session
              , tree: (NTree (LNode {id}) _) } DeleteNode = do
  void $ deleteNode session id
  liftEffect do
    setOpenNodes (Set.delete (mkNodeId session id))
    setReload (_ + 1)

performAction { reload: (_ /\ setReload)
              , session
              , tasks: (_ /\ setAsyncTasks)
              , tree: (NTree (LNode {id}) _) } (SearchQuery task) = do
  liftEffect $ setAsyncTasks $ A.cons task
  liftEffect $ log2 "[performAction] SearchQuery task:" task
  liftEffect $ setReload (_ + 1)

performAction { reload: (_ /\ setReload)
              , session
              , tree: (NTree (LNode {id}) _) } (Submit name)  = do
  void $ renameNode session id $ RenameValue {name}
  liftEffect do
    setReload (_ + 1)

performAction { openNodes: (_ /\ setOpenNodes)
              , reload: (_ /\ setReload)
              , session
              , tree: (NTree (LNode {id}) _) } (CreateSubmit name nodeType) = do
  void $ createNode session id $ CreateValue {name, nodeType}
  liftEffect do
    setOpenNodes (Set.insert (mkNodeId session id))
    setReload (_ + 1)

performAction { session
              , tasks: (_ /\ setAsyncTasks)
              , tree: (NTree (LNode {id}) _) } (UploadFile nodeType fileType mName contents) = do
  task <- uploadFile session nodeType id fileType {mName, contents}
  liftEffect $ setAsyncTasks $ A.cons task
  liftEffect $ log2 "uploaded, task:" task