module Gargantext.Components.Forest.Tree where

import Gargantext.Prelude

import Data.Array as A
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Data.Traversable (traverse_, traverse)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node (nodeSpan)
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact
import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode, unpublishNode)
import Gargantext.Components.Forest.Tree.Node.Action.Link (linkNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Merge (mergeNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Move (moveNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), rename)
import Gargantext.Components.Forest.Tree.Node.Action.Share as Share
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile, uploadArbitraryFile, uploadFrameCalc)
import Gargantext.Components.Forest.Tree.Node.Action.WriteNodesDocuments (documentsFromWriteNodesReq)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..), fTreeID)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
import Gargantext.Config.REST (RESTError, logRESTError)
import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, get, mkNodeId)
import Gargantext.Sessions.Types (useOpenNodesMemberBox, openNodesInsert, openNodesDelete)
import Gargantext.Types (Handed, ID, isPublic, publicize, switchHanded)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE
import Toestand as T

here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree"

-- Shared by every component here
type Common =
  ( boxes     :: Boxes
  , frontends :: Frontends
  , handed    :: Handed
  , reload    :: T2.ReloadS
  )

type LoaderProps =
 ( root    :: ID
 , session :: Session
 | Common )

type NodeProps =
 ( reloadTree :: T2.ReloadS
 , session :: Session
 | Common )

type TreeProps =
 ( root :: ID
 , tree :: FTree
 | NodeProps )

type ChildrenTreeProps =
  ( childProps :: { children'  :: Array FTree
                  , folderOpen :: T.Box Boolean
                  , render     :: R2.Leaf TreeProps }
  | TreeProps )

--- The properties tree shares in common with performAction
type PACommon =
  ( boxes      :: Boxes
  , reloadTree :: T2.ReloadS
  , session    :: Session
  , tree       :: FTree
  )

-- The properties tree shares in common with nodeSpan
type NSCommon =
  ( frontends :: Frontends
  , handed    :: Handed
  , session   :: Session  )

-- The annoying 'render' here is busting a cycle in the low tech
-- way. This function is only called by functions in this module, so
-- we just have to careful in what we pass.
type ChildLoaderProps =
  ( id     :: ID
  , render :: R2.Leaf TreeProps
  , root   :: ID
  | NodeProps )

type PerformActionProps =
  ( setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
  | PACommon )

-- | Loads and renders the tree starting at the given root node id.
treeLoader :: R2.Component LoaderProps
treeLoader = R.createElement treeLoaderCpt
treeLoaderCpt :: R.Component LoaderProps
treeLoaderCpt = here.component "treeLoader" cpt where
-- treeLoaderCpt :: R.Memo LoaderProps
-- treeLoaderCpt = R.memo (here.component "treeLoader" cpt) memoCmp where
--   memoCmp ({ root: t1 }) ({ root: t2 }) = t1 == t2
  cpt p@{ root, session } _ = do
    -- app     <- T.useLive T.unequal p.reloadRoot
    let fetch { root: r } = getNodeTree session r
    useLoader { errorHandler
              , loader: fetch
              , path: { root }
              , render: loaded }
      where
        loaded tree' = tree props where
          props = Record.merge common extra where
            common = RecordE.pick p :: Record Common
            extra = { reloadTree: p.reload, root, session, tree: tree' }
        errorHandler = logRESTError here "[treeLoader]"

getNodeTree :: Session -> ID -> Aff (Either RESTError FTree)
getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) ""

getNodeTreeFirstLevel :: Session -> ID -> Aff (Either RESTError FTree)
getNodeTreeFirstLevel session nodeId = get session $ GR.TreeFirstLevel (Just nodeId) ""

tree :: R2.Leaf TreeProps
tree props = R.createElement treeCpt props []
treeCpt :: R.Component TreeProps
treeCpt = here.component "tree" cpt where
  cpt p@{ boxes: boxes@{ forestOpen }
        , frontends
        , handed
        , reload
        , root
        , session
        , tree: NTree (LNode { id, name, nodeType }) children } _ = do
    setPopoverRef <- R.useRef Nothing
    folderOpen <- useOpenNodesMemberBox nodeId forestOpen
    pure $ H.ul { className: ulClass }
      [ H.li { className: childrenClass children' }
        [ nodeSpan { boxes
                   , dispatch: dispatch setPopoverRef
                   , folderOpen
                   , frontends
                   , id
                   , isLeaf
                   , name
                   , nodeType
                   , reload
                   , root
                   , session
                   , setPopoverRef }
          [ renderChildren (Record.merge p { childProps: { children', folderOpen, render: tree } } ) [] ]
        ]
      ]
    where
      isLeaf = A.null children
      nodeId = mkNodeId session id
      ulClass  = switchHanded "ml left" "mr right" handed <> "-auto tree handed"
      children' = A.sortWith fTreeID pubChildren
      pubChildren = if isPublic nodeType then map (map pub) children else children
      dispatch setPopoverRef a = performAction a (Record.merge common' spr) where
        common' = RecordE.pick p :: Record PACommon
        spr = { setPopoverRef }
  pub (LNode n@{ nodeType: t }) = LNode (n { nodeType = publicize t })
  childrenClass [] = "no-children"
  childrenClass _  = "with-children"


renderChildren :: R2.Component ChildrenTreeProps
renderChildren = R.createElement renderChildrenCpt
renderChildrenCpt :: R.Component ChildrenTreeProps
renderChildrenCpt = here.component "renderChildren" cpt where
  cpt p@{ childProps: { folderOpen } } _ = do
    folderOpen' <- T.useLive T.unequal folderOpen

    if folderOpen' then
      pure $ renderTreeChildren p []
    else
      pure $ H.div {} []

renderTreeChildren :: R2.Component ChildrenTreeProps
renderTreeChildren = R.createElement renderTreeChildrenCpt
renderTreeChildrenCpt :: R.Component ChildrenTreeProps
renderTreeChildrenCpt = here.component "renderTreeChildren" cpt where
  cpt p@{ childProps: { children'
                      , render }
        , root } _ = do
    pure $ R.fragment (map renderChild children')

    where
      nodeProps = RecordE.pick p :: Record NodeProps
      renderChild (NTree (LNode {id: cId}) _) = childLoader props [] where
        props = Record.merge nodeProps { id: cId, render, root }

childLoader :: R2.Component ChildLoaderProps
childLoader = R.createElement childLoaderCpt
childLoaderCpt :: R.Component ChildLoaderProps
childLoaderCpt = here.component "childLoader" cpt where
  cpt p@{ boxes: { reloadRoot }
        , reloadTree
        , render
        , root } _ = do
    reload <- T.useBox T2.newReload
    let reloads = [ reload, reloadRoot, reloadTree ]
    cache <- (A.cons p.id) <$> traverse (T.useLive T.unequal) reloads
    useLoader { errorHandler
              , loader: fetch
              , path: cache
              , render: paint reload }
    where
      errorHandler = logRESTError here "[childLoader]"
      fetch _ = getNodeTreeFirstLevel p.session p.id
      paint reload tree' = render (Record.merge base extra) where
        base = nodeProps { reload = reload }
        extra = { root, tree: tree' }
        nodeProps = RecordE.pick p :: Record NodeProps

closePopover { setPopoverRef } =
   liftEffect $ traverse_ (\set -> set false) (R.readRef setPopoverRef)

refreshTree p@{ reloadTree } = liftEffect $ T2.reload reloadTree *> closePopover p

deleteNode' nt p@{ boxes: { forestOpen }, session, tree: (NTree (LNode {id, parent_id}) _) } = do
  case nt of
    GT.NodePublic GT.FolderPublic -> void $ deleteNode session id
    GT.NodePublic _               -> void $ unpublishNode session parent_id id
    _                             -> void $ deleteNode session id
  liftEffect $ T.modify_ (openNodesDelete (mkNodeId session id)) forestOpen
  refreshTree p

doSearch task { boxes: { tasks }, tree: NTree (LNode {id}) _ } = liftEffect $ do
  GAT.insert id task tasks
  here.log2 "[doSearch] DoSearch task:" task

updateNode params { boxes: { errors, tasks }, session, tree: (NTree (LNode {id}) _) } = do
  eTask <- updateRequest params session id
  handleRESTError errors eTask $ \task -> liftEffect $ do
    GAT.insert id task tasks
    here.log2 "[updateNode] UpdateNode task:" task

renameNode name p@{ boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do
  eTask <- rename session id $ RenameValue { text: name }
  handleRESTError errors eTask $ \_task -> pure unit
  refreshTree p

shareTeam username { boxes: { errors }, session, tree: (NTree (LNode {id}) _)} = do
  eTask <- Share.shareReq session id $ Share.ShareTeamParams { username }
  handleRESTError errors eTask $ \_task -> pure unit

sharePublic params p@{ boxes: { errors, forestOpen }, session } = traverse_ f params where
  f (SubTreeOut { in: inId, out }) = do
    eTask <- Share.shareReq session inId $ Share.SharePublicParams { node_id: out }
    handleRESTError errors eTask $ \_task -> do
      liftEffect $ T.modify_ (openNodesInsert (mkNodeId p.session out)) forestOpen
      refreshTree p

addContact params { boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do
  eTask <- Contact.contactReq session id params
  handleRESTError errors eTask $ \_task -> pure unit

addNode' name nodeType p@{ boxes: { errors, forestOpen }, session, tree: (NTree (LNode { id }) _) } = do
  eId <- addNode session id $ AddNodeValue { name, nodeType }
  handleRESTError errors eId $ \_id -> liftEffect $ do
    liftEffect $ T.modify_ (openNodesInsert (mkNodeId session id)) forestOpen
    refreshTree p

uploadFile' nodeType fileType mName contents p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do
  eTask <- uploadFile { contents, fileType, id, mName, nodeType, selection, session }
  handleRESTError errors eTask $ \task -> liftEffect $ do
    GAT.insert id task tasks
    here.log2 "[uploadFile'] UploadFile, uploaded, task:" task

uploadArbitraryFile' mName blob p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } selection = do
  eTask <- uploadArbitraryFile session id { blob, mName } selection
  handleRESTError errors eTask $ \task -> liftEffect $ do
    GAT.insert id task tasks
    here.log2 "[uploadArbitraryFile'] UploadArbitraryFile, uploaded, task:" task

uploadFrameCalc' p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } = do
  eTask <- uploadFrameCalc session id
  handleRESTError errors eTask $ \task -> liftEffect $ do
    GAT.insert id task tasks
    here.log2 "[performAction] UploadFrameCalc, uploaded, task:" task

moveNode params p@{ boxes: { errors, forestOpen }, session } = traverse_ f params where
  f (SubTreeOut { in: in', out }) = do
    eTask <- moveNodeReq session in' out
    handleRESTError errors eTask $ \_task -> pure unit
    liftEffect $ T.modify_ (openNodesInsert (mkNodeId session out)) forestOpen
    refreshTree p

mergeNode params p@{ boxes: { errors }, session } = traverse_ f params where
  f (SubTreeOut { in: in', out }) = do
    eTask <- mergeNodeReq session in' out
    handleRESTError errors eTask $ \_task -> pure unit
    refreshTree p

linkNode nodeType params p@{ boxes: { errors }, session } = traverse_ f params where
  f (SubTreeOut { in: in', out }) = do
    eTask <- linkNodeReq session nodeType in' out
    handleRESTError errors eTask $ \_task -> pure unit
    refreshTree p

documentsFromWriteNodes id p@{ boxes: { errors }, session } = do
  eTask <- documentsFromWriteNodesReq session id
  handleRESTError errors eTask $ \_task -> pure unit
  refreshTree p

-- | This thing is basically a hangover from when garg was a thermite
-- | application. we should slowly get rid of it.
performAction :: Action -> Record PerformActionProps -> Aff Unit
performAction (DeleteNode nt) p                               = deleteNode' nt p
performAction (DoSearch task) p                               = doSearch task p
performAction (UpdateNode params) p                           = updateNode params p
performAction (RenameNode name) p                             = renameNode name p
performAction (ShareTeam username) p                          = shareTeam username p
performAction (SharePublic { params }) p                      = sharePublic params p
performAction (AddContact params) p                           = addContact params p
performAction (AddNode name nodeType) p                       = addNode' name nodeType p
performAction UploadFrameCalc p                               = uploadFrameCalc' p
performAction (UploadFile nodeType fileType mName contents selection) p =
  uploadFile' nodeType fileType mName contents p selection
performAction (UploadArbitraryFile mName blob selection) p              =
  uploadArbitraryFile' mName blob p selection
performAction DownloadNode _                                  = liftEffect $ here.log "[performAction] DownloadNode"
performAction (MoveNode {params}) p                           = moveNode params p
performAction (MergeNode {params}) p                          = mergeNode params p
performAction (LinkNode { nodeType, params }) p               = linkNode nodeType params p
performAction RefreshTree p                                   = refreshTree p
performAction ClosePopover p                                  = closePopover p
performAction (DocumentsFromWriteNodes { id }) p              = documentsFromWriteNodes id p
performAction NoAction _                                      = liftEffect $ here.log "[performAction] NoAction"