module Gargantext.Components.NgramsTable.Tree where

import Gargantext.Prelude

import Data.Array (length)
import Data.Array as A
import Data.Lens ((^..), (^.), view)
import Data.Lens.Fold (folded)
import Data.Lens.Index (ix)
import Data.List (List, intercalate)
import Data.List as L
import Data.Maybe (Maybe(..), maybe)
import Data.Set (Set)
import Data.Set as Set
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.App.Store as Store
import Gargantext.Components.Bootstrap as B
import Gargantext.Components.Bootstrap.Types (Variant(..))
import Gargantext.Components.Table as Tbl
import Gargantext.Core.NgramsTable.Functions (applyNgramsPatches, setTermListA, tablePatchHasNgrams)
import Gargantext.Core.NgramsTable.Types (Action(..), CoreAction, NgramsClick, NgramsDepth, NgramsElement, NgramsTable, NgramsTablePatch, NgramsTerm, _NgramsElement, _NgramsRepoElement, _children, _list, _ngrams, _occurrences, ngramsTermText, replace)
import Gargantext.Hooks.FirstEffect (useFirstEffect')
import Gargantext.Types as GT
import Gargantext.Utils ((?))
import Gargantext.Utils.Reactix as R2
import React.DOM (a, span, text)
import React.DOM.Props as DOM
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
import Type.Proxy (Proxy(..))

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


type RenderNgramsTree =
  ( getNgramsChildrenAff :: Maybe (NgramsTerm -> Aff (Array NgramsTerm))
  , getNgramsChildren :: Maybe (NgramsTerm -> Array NgramsTerm)
  --, ngramsChildren    :: List NgramsTerm
  , ngramsClick       :: NgramsClick
  , ngramsDepth       :: NgramsDepth
  , ngramsEdit        :: NgramsClick
  , ngramsStyle       :: Array DOM.Props
  --, ngramsTable    :: NgramsTable
  , key               :: String -- used to refresh the tree on diff change
  )

renderNgramsTree :: Record RenderNgramsTree -> R.Element
renderNgramsTree p = R.createElement renderNgramsTreeCpt p []
renderNgramsTreeCpt :: R.Component RenderNgramsTree
renderNgramsTreeCpt = here.component "renderNgramsTree" cpt
  where
    cpt { getNgramsChildrenAff
        , getNgramsChildren
        , ngramsClick
        , ngramsDepth
        , ngramsEdit
        , ngramsStyle
        } _ = do
      pure $
        H.ul
        { className: "render-ngrams-tree" }
        [ H.span { className: "tree" }
          [ H.span { className: "righthanded" }
            [ tree { getNgramsChildren
                   , getNgramsChildrenAff
                     --, ngramsChildren
                   , ngramsClick
                   , ngramsDepth
                   , ngramsEdit
                   , ngramsStyle
                   }
            ]
          ]
        ]


type TagProps =
  ( ngramsClick :: NgramsClick
  , ngramsDepth :: NgramsDepth
  , ngramsStyle :: Array DOM.Props
  )

{- TODO refactor here
-- tag :: TagProps -> Array R.Element -> R.Element
tag tagProps =
  case tagProps.ngramsClick tagProps.ngramsDepth of
    Just effect ->
      a (tagProps.ngramsStyle <> [DOM.onClick $ const effect])
    Nothing ->
      span tagProps.ngramsStyle
-}

type TreeProps =
  ( getNgramsChildrenAff :: Maybe (NgramsTerm -> Aff (Array NgramsTerm))
  , getNgramsChildren :: Maybe (NgramsTerm -> Array NgramsTerm)
  , ngramsEdit           :: NgramsClick
  --, ngramsTable :: NgramsTable
  | TagProps
  )

-- | /!\ Multiple issues to deal in this specific component:
-- |     - stack of patch surgery: monolitic use of the <doctable> +
-- |       design choice of rendering ngrams children on the fly +
-- |       setting up a facade for the `getNgramsChildren` thunk ALWAYS as an
-- |       `Aff` even if not necessary
-- |     - ReactJS re-rendering flaw causing flickering UI effect
-- |     - PureScript pattern matching recursive limitation
-- |
-- |      ↳ workaround: employ a delegation pattern with the an input bearing
-- |        both the `Aff` thunk and a pure one. Note that we could create a
-- |        Typing way, due to the PureScript limitation (see above)
tree :: Record TreeProps -> R.Element
tree p = R.createElement treeCpt p []
treeCpt :: R.Component TreeProps
treeCpt = here.component "tree" cpt where
  cpt props@{ getNgramsChildrenAff
            , getNgramsChildren
            , ngramsDepth
            } _ = do
    -- | States
    -- |
    defaultNgramsChildren <- R.useMemo $ const $
      maybe
        (mempty :: List NgramsTerm)
        (\thunk -> L.fromFoldable $ thunk ngramsDepth.ngrams)
        getNgramsChildren

    ngramsChildren /\ ngramsChildren' <-
      R2.useBox' (defaultNgramsChildren :: List NgramsTerm)

    -- | Hooks
    -- |
    useFirstEffect' $ maybe
      (R.nothing)
      (\aff -> launchAff_ do
        res <- aff ngramsDepth.ngrams
        liftEffect $
          flip T.write_ ngramsChildren' $ L.fromFoldable res
      )
      (getNgramsChildrenAff)

    -- | Render
    -- |
    pure $

      treeLoaded (Record.merge props { ngramsChildren })



type TreeLoaded =
  ( ngramsChildren    :: List NgramsTerm
  | TreeProps )

treeLoaded :: Record TreeLoaded -> R.Element
treeLoaded p = R.createElement treeLoadedCpt p []
treeLoadedCpt :: R.Component TreeLoaded
treeLoadedCpt = here.component "treeLoaded" cpt where
  cpt params@{ ngramsChildren
             , ngramsClick
             , ngramsDepth
             , ngramsEdit
             , ngramsStyle
             } _ = do
    pure $

      H.li
      -- { className: "ngrams-tree-loaded-node" }
      { className: intercalate " "
          [ "ngrams-tree-loaded-node"
          , ngramsDepth.depth == 1 ?
              "ngrams-tree-loaded-node--first-child" $
              ""
          , ngramsDepth.depth > 1 ?
              "ngrams-tree-loaded-node--grand-child" $
              ""
          ]
      }
      (
        -- @NOTE #414: currently commenting this, as the below icon is not
        --             a call-to-action, thus deceiving the user of possible
        --             yet-to-become reveal/collapse node children feature
        -- [ H.i { className, style } [] ]
      -- <>
        [ R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] ]
      <>
        maybe [] edit (ngramsEdit ngramsDepth)
      <>
        [ forest ngramsChildren ]
      )
    where
      tag =
        case ngramsClick ngramsDepth of
          Just effect ->
            a (ngramsStyle <> [DOM.onClick $ const effect])
          Nothing ->
            span ngramsStyle
      edit effect =
        [
          B.iconButton
          { name: "plus-minus"
          , className: "tree-loaded-plus"
          , variant: Secondary
          , callback: const effect
          , overlay: false
          , title: "Combine and separate"
          }
        ]
      -- leaf = L.null ngramsChildren
      -- className = "fa fa-chevron-" <> if open then "down" else "right"
      -- style = if leaf then {color: "#adb5bd"} else {color: ""}
      -- open = not leaf || false {- TODO -}
      --cs   = ngramsTable ^.. ix ngramsDepth.ngrams <<< _NgramsRepoElement <<< _children <<< folded
      -- cs has a list is ok, the length is the number of direct children of an ngram which is generally < 10.

      forest =
        let depth = ngramsDepth.depth + 1 in
        if depth > 10 then
          const $ H.text "ERROR DEPTH > 10"
        else
          H.ul {} <<< map (\ngrams -> tree ((Record.delete (Proxy :: Proxy "ngramsChildren") params) { ngramsDepth = {depth, ngrams, parent: Just ngramsDepth.ngrams} })) <<< L.toUnfoldable

type RenderNgramsItem =
  ( corpusId          :: GT.CorpusId
  , dispatch             :: Action -> Effect Unit
  , getNgramsChildrenAff :: Maybe (NgramsTerm -> Aff (Array NgramsTerm))
  , getNgramsChildren :: Maybe (NgramsTerm -> Array NgramsTerm)
  , isEditing         :: T.Box Boolean
  , mListId           :: Maybe GT.ListId
  , ngrams            :: NgramsTerm
  , ngramsElement     :: NgramsElement
  , ngramsLocalPatch  :: NgramsTablePatch
  , ngramsSelection   :: Set NgramsTerm
  , ngramsTable       :: NgramsTable
  )

renderNgramsItem :: R2.Component RenderNgramsItem
renderNgramsItem = R.createElement renderNgramsItemCpt
renderNgramsItemCpt :: R.Component RenderNgramsItem
renderNgramsItemCpt = here.component "renderNgramsItem" cpt
  where
    cpt { corpusId
        , dispatch
        --, getNgramsChildren
        , isEditing
        , mListId
        , ngrams
        , ngramsElement
        , ngramsLocalPatch
        , ngramsSelection
        , ngramsTable
        } _ = do
      { sidePanelLists } <- Store.use
      isEditing' <- T.useLive T.unequal isEditing

      mCurrentNgrams <-
        T.useFocused
        (maybe Nothing _.mCurrentNgrams)
        (\val -> maybe Nothing (\sp -> Just $ sp { mCurrentNgrams = val })) sidePanelLists
      mCurrentNgrams' <- T.useLive T.unequal mCurrentNgrams

      let currentRowSelected = mCurrentNgrams' == Just ngrams
          className = currentRowSelected ? "page-paint-raw page-paint-raw--selected" $ ""

      pure $ Tbl.makeRow' { className }
        [ selected
        ,
          ngramsContext { corpusId
                        , mListId
                        , ngrams } []
        ,
          B.wad'
          [ "col-score" ] $
          show $ A.length $ A.fromFoldable (ngramsElement ^. _NgramsElement <<< _occurrences)
        ,
          H.div {}
          ( if isEditing'
            then
              if (length $ getNgramsChildren' ngrams) > 0
                then
                  [ H.div {className: "tree-expanded"} [
                    B.iconButton
                    { name: "plus"
                    , className: "mr-1 align-bottom"
                    , overlay: false
                    , variant: Primary
                    , callback: const $ dispatch $ ToggleChild true ngrams
                    }
                  ,
                    R2.buff $
                    tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ]
                  ] ]
                else
                  [
                    B.iconButton
                    { name: "plus"
                    , className: "mr-1 align-bottom"
                    , overlay: false
                    , variant: Primary
                    , callback: const $ dispatch $ ToggleChild true ngrams
                    }
                  ,
                    R2.buff $
                    tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ]
                  ]
            else
              [
                renderNgramsTree
                { getNgramsChildrenAff: Nothing
                , getNgramsChildren: Just $ getNgramsChildren'
                , ngramsClick
                , ngramsDepth
                , ngramsEdit
                , ngramsStyle
                , key: ""
                }
              ]
          )
      ]
      where
        ngramsDepth = { ngrams, depth: 0, parent: Nothing }
        tag =
          case ngramsClick ngramsDepth of
            Just effect ->
              a (ngramsStyle <> [DOM.onClick $ const effect])
            Nothing ->
              span ngramsStyle

        termList :: GT.TermList
        termList    = ngramsElement ^. _NgramsElement <<< _list
        ngramsStyle :: Array DOM.Props
        ngramsStyle = [termStyle termList ngramsOpacity]
        ngramsEdit :: NgramsDepth -> Maybe (Effect Unit)
        ngramsEdit { ngrams: n, depth: 0 } =
          Just $ dispatch $ SetParentResetChildren (Just n) (ngramsChildren n)
        -- NOTE: Currently we allow modifying children only for root
        -- terms. I.e. we don't allow trees with depth greater than 1
        -- See: https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/565
        ngramsEdit _ = Nothing
        tbl :: NgramsTable
        tbl = applyNgramsPatches { ngramsLocalPatch
                                 , ngramsStagePatch: mempty
                                 , ngramsValidPatch: mempty
                                 , ngramsVersion: 0 } ngramsTable
        getNgramsChildren' :: NgramsTerm -> Array NgramsTerm
        getNgramsChildren' n = A.fromFoldable $ ngramsChildren n
        ngramsChildren :: NgramsTerm -> List NgramsTerm
        ngramsChildren n = tbl ^.. ix n <<< _NgramsRepoElement <<< _children <<< folded
        ngramsClick :: NgramsClick
        ngramsClick p@{ depth: 0 } = Just $ do
            (dispatch <<< CoreAction <<< cycleTermListItem <<< view _ngrams) p
            -- traverse_ (dispatch <<< CoreAction <<< cycleTermListItem) (A.cons p.ngrams $ getNgramsChildren' p.ngrams)
        ngramsClick p@{ parent: Nothing } = Just $ do
          here.log2 "[renderNgramsItem] unexpected empty parent for ngrams depth" p
        ngramsClick { parent: Just p' } = Just $ do
          (dispatch <<< CoreAction <<< cycleTermListItem) p'
          -- ^ This is the old behavior it is nicer to use since one can
          --   rapidly change the ngram list without waiting for confirmation.
          --   However this might expose bugs. One of them can be reproduced
          --   by clicking a multiple times on the same ngram, sometimes it stays
          --   transient.
          -- | ngramsTransient = const Nothing
          -- | otherwise       = Just <<< dispatch <<< cycleTermListItem <<< view _ngrams
        selected    =
          H.div
          { on: { click: const $ dispatch $ ToggleSelect ngrams
                }
          }
          [
            B.icon
            { name: Set.member ngrams ngramsSelection ?
                "check-square" $
                "square-o"
            , className: Set.member ngrams ngramsSelection ?
                "color-primary" $
                ""
            }
          ]

        -- (?) removing quick action turning ngram to Candidate or Stop via
        --     a checkbox click
        -- checkbox termList' =
        --   let chkd = termList == termList'
        --       termList'' = if chkd then GT.CandidateTerm else termList'
        --   in
        --     B.wad
        --     [ "text-center" ]
        --     [
        --       H.input
        --       { checked: chkd
        --       , className: "checkbox"
        --       , on: { change: const $ dispatch $ CoreAction $
        --               setTermListA ngrams (replace termList termList'') }
        --       , readOnly: ngramsTransient
        --       , type: "checkbox"
        --       , style:
        --           { cursor: "pointer"
        --           , marginTop: "6px"
        --           }
        --       }
        --     ]

        ngramsTransient = tablePatchHasNgrams ngramsLocalPatch ngrams
          -- ^ TODO here we do not look at ngramsNewElems, shall we?
        ngramsOpacity
          | ngramsTransient = 0.5
          | otherwise       = 1.0

        cycleTermListItem :: NgramsTerm -> CoreAction
        cycleTermListItem n = setTermListA n (replace termList (nextTermList termList))


termStyle :: GT.TermList -> Number -> DOM.Props
termStyle GT.MapTerm       opacity = DOM.style
  { color: "#11AA11"
  , opacity
  }
termStyle GT.StopTerm      opacity = DOM.style
  { color: "#EE3311"
  , opacity
  , textDecoration: "line-through"
  }
termStyle GT.CandidateTerm opacity = DOM.style
  { color: "#5A90B6"
  , fontStyle: "italic"
  , opacity
  }


nextTermList :: GT.TermList -> GT.TermList
nextTermList GT.MapTerm       = GT.StopTerm
nextTermList GT.StopTerm      = GT.CandidateTerm
nextTermList GT.CandidateTerm = GT.MapTerm


type NgramsContextProps =
  ( corpusId  :: GT.CorpusId
  , mListId   :: Maybe GT.ListId
  , ngrams    :: NgramsTerm
  )

ngramsContext :: R2.Component NgramsContextProps
ngramsContext = R.createElement ngramsContextCpt
ngramsContextCpt :: R.Component NgramsContextProps
ngramsContextCpt = here.component "ngramsContext" cpt where
  cpt { ngrams
      , corpusId
      , mListId } _ = do
    { sidePanelLists, sidePanelState } <- Store.use
    mCurrentNgrams <-
      T.useFocused
      (maybe Nothing _.mCurrentNgrams)
      (\val -> maybe Nothing (\sp -> Just $ sp { mCurrentNgrams = val })) sidePanelLists
    mCurrentNgrams' <- T.useLive T.unequal mCurrentNgrams

    let selected = mCurrentNgrams' == Just ngrams
        eyeClass = selected ? "eye" $ "eye-slash"
        variant = selected ? Info $ Dark

        onClick sel _ = do
          -- here.log2 "[docChooser] onClick, listId" listId
          -- here.log2 "[docChooser] onClick, corpusId" corpusId
          -- here.log2 "[docChooser] onClick, nodeId" nodeId
          -- R2.callTrigger triggerAnnotatedDocIdChange { corpusId, listId, nodeId }
          -- T2.reload tableReload
          if sel then do
            T.write_ Nothing sidePanelLists
            T.write_ GT.Closed sidePanelState
          else do
            T.write_ (Just { mCorpusId: Just corpusId
                           , mListId
                           , mCurrentNgrams: Just ngrams }) sidePanelLists
            T.write_ GT.Opened sidePanelState

    pure $ H.div { className: "doc-chooser text-center" }
      [ B.iconButton
        { name: eyeClass
        , overlay: false
        , variant
        , callback: onClick selected }
      ]