{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE MultiWayIf #-}
-- |

module Test.Sandwich.Formatters.TerminalUI.Filter (
  filterRunTree
  , treeToList
  ) where

import Control.Monad
import Control.Monad.Trans.Reader
import Data.Function
import qualified Data.List as L
import Test.Sandwich.Formatters.TerminalUI.Types
import Test.Sandwich.RunTree
import Test.Sandwich.Types.RunTree

filterRunTree :: Int -> [RunNodeFixed context] -> [RunNodeFixed context]
filterRunTree visibilityThreshold rtsFixed = rtsFixed
  & fmap (mapCommon (hideIfThresholdAbove visibilityThreshold))
  & fmap hideClosed

mapCommon :: (RunNodeCommonWithStatus s l t -> RunNodeCommonWithStatus s l t) -> RunNodeWithStatus context s l t -> RunNodeWithStatus context s l t
mapCommon f node@(RunNodeIt {}) = node { runNodeCommon = f (runNodeCommon node) }
mapCommon f (RunNodeIntroduce {..}) = RunNodeIntroduce { runNodeCommon = f runNodeCommon
                                                       , runNodeChildrenAugmented = fmap (mapCommon f) runNodeChildrenAugmented
                                                       , .. }
mapCommon f (RunNodeIntroduceWith {..}) = RunNodeIntroduceWith { runNodeCommon = f runNodeCommon
                                                               , runNodeChildrenAugmented = fmap (mapCommon f) runNodeChildrenAugmented
                                                               , .. }
mapCommon f node = node { runNodeCommon = f (runNodeCommon node)
                        , runNodeChildren = fmap (mapCommon f) (runNodeChildren node) }


hideIfThresholdAbove :: Int -> RunNodeCommonFixed -> RunNodeCommonFixed
hideIfThresholdAbove visibilityThreshold node@(RunNodeCommonWithStatus {..}) =
  if | runTreeVisibilityLevel <= visibilityThreshold -> node { runTreeVisible = True }
     | otherwise -> node { runTreeVisible = False
                         , runTreeOpen = True -- Must be open so children have a chance to be seen
                         }

markClosed :: RunNodeCommonWithStatus s l Bool -> RunNodeCommonWithStatus s l Bool
markClosed node@(RunNodeCommonWithStatus {..}) = node { runTreeVisible = False }

hideClosed :: RunNodeWithStatus context s l Bool -> RunNodeWithStatus context s l Bool
hideClosed node@(RunNodeIt {}) = node
hideClosed (RunNodeIntroduce {..})
  | runTreeOpen runNodeCommon = RunNodeIntroduce { runNodeChildrenAugmented = fmap hideClosed runNodeChildrenAugmented, .. }
  | otherwise = RunNodeIntroduce { runNodeChildrenAugmented = fmap (mapCommon markClosed) runNodeChildrenAugmented, .. }
hideClosed (RunNodeIntroduceWith {..})
  | runTreeOpen runNodeCommon = RunNodeIntroduceWith { runNodeChildrenAugmented = fmap hideClosed runNodeChildrenAugmented, .. }
  | otherwise = RunNodeIntroduceWith { runNodeChildrenAugmented = fmap (mapCommon markClosed) runNodeChildrenAugmented, .. }
hideClosed node
  | runTreeOpen (runNodeCommon node) = node { runNodeChildren = fmap hideClosed (runNodeChildren node) }
  | otherwise = node { runNodeChildren = fmap (mapCommon markClosed) (runNodeChildren node) }


treeToList :: (RunNodeFixed context, RunNode context) -> [MainListElem]
treeToList (nodeFixed, node) = L.zip (runReader (getCommonsWithVisibleDepth' nodeFixed) 0) (getCommons node)
  & L.filter (isVisible . fst . fst)
  & fmap commonToMainListElem
  where

    isVisible :: RunNodeCommonFixed -> Bool
    isVisible (RunNodeCommonWithStatus {..}) = runTreeVisible

    commonToMainListElem :: ((RunNodeCommonFixed, Int), RunNodeCommon) -> MainListElem
    commonToMainListElem ((RunNodeCommonWithStatus {..}, depth), common) = MainListElem {
      label = runTreeLabel
      , depth = depth
      , toggled = runTreeToggled
      , open = runTreeOpen
      , status = runTreeStatus
      , logs = runTreeLogs
      , visibilityLevel = runTreeVisibilityLevel
      , folderPath = runTreeFolder
      , node = common
      , ident = runTreeId
      }

getCommonsWithVisibleDepth' :: RunNodeWithStatus context s l t -> Reader Int [(RunNodeCommonWithStatus s l t, Int)]
getCommonsWithVisibleDepth' node@(RunNodeIt {}) = ask >>= \vd -> return [(runNodeCommon node, vd)]
getCommonsWithVisibleDepth' (RunNodeIntroduce {..}) = do
  let context = if runTreeVisible runNodeCommon then (local (+1)) else id
  rest <- context $ (mconcat <$>) $ forM runNodeChildrenAugmented getCommonsWithVisibleDepth'
  ask >>= \vd -> return ((runNodeCommon, vd) : rest)
getCommonsWithVisibleDepth' (RunNodeIntroduceWith {..}) = do
  let context = if runTreeVisible runNodeCommon then (local (+1)) else id
  rest <- context $ (mconcat <$>) $ forM runNodeChildrenAugmented getCommonsWithVisibleDepth'
  ask >>= \vd -> return ((runNodeCommon, vd) : rest)
getCommonsWithVisibleDepth' node = do
  let context = if runTreeVisible (runNodeCommon node) then (local (+1)) else id
  rest <- context $ (mconcat <$>) $ forM (runNodeChildren node) getCommonsWithVisibleDepth'
  ask >>= \vd -> return ((runNodeCommon node, vd) : rest)