{-# LANGUAGE KindSignatures #-}
-- | Functions that brick event handlers can use to move up or down while skipping a certain kind of elements.
--
-- ![ ](demo-01.png) ![ ](demo-02.png)
--
-- For example, in the above demo program, you can move in the list while skipping separators.
module Brick.Widgets.List.Skip (
-- * Types
  Dir(..)
, Amount(..)
, Move(..)
-- * Functions
, listSkip
, listSearchFromCurrent
, listShow
-- * Classes
, Searchable(..)
) where

-- base
import Prelude hiding (take, drop)
-- third party packages
import Lens.Micro
import qualified Data.Vector as V
import Data.Vector hiding (take, drop, modify)
import qualified Data.Sequence as S
import Data.Sequence hiding (take, drop)
-- brick
import qualified Brick.Widgets.List as L
import Brick.Types hiding (Direction(..))
import Brick.Main

-- | Should the search include the current location?
data IncludeCurrent = IncludeCurrent | ExcludeCurrent deriving (Show, Eq)

-- | The direction to move in
data Dir =
  -- | Backward, or Up
  Bwd |
  -- | Forward, or Down
  Fwd
  deriving (Show, Eq)

-- | The amount to move by
data Amount =
  -- | Move to the next element that fails the test.
  One |
  -- | Move forward or backward as much as possible, and start searching in the opposite direction.
  Most |
  -- | Move by one page. From there, start searching. If the search fails, start searching in the opposite direction.
  Page |
  -- | Move by half page. From there, start searching. If the search fails, start searching in the opposite direction.
  HalfPage
  deriving (Show, Eq)

-- | Description of a movement
data Move =
  Move Amount Dir |
  NoMove
  deriving (Show, Eq)

-- | Move by a specified amount. Skip elements that pass the test.
--
-- After moving, this function calls 'listShow' with the direction of 'Move'.
listSkip :: (Foldable t, L.Splittable t, Searchable t, Ord n)
  => (e -> Bool) -- ^ The test
  -> Move
  -> EventM n (L.GenericList n t e) ()
listSkip t m = case m of
  Move a Bwd -> do
    case a of
      One -> modify $ listSkipBackward t
      Most -> modify $ listSkipToBeginning t
      Page -> listSkipByPages t (-1.0)
      HalfPage -> listSkipByPages t (-0.5)
    listShow t Bwd
  Move a Fwd -> do
    case a of
      One -> modify $ listSkipForward t
      Most -> modify $ listSkipToEnd t
      Page -> listSkipByPages t 1.0
      HalfPage -> listSkipByPages t 0.5
    listShow t Fwd
  NoMove -> return ()

-- | From the current element, search for an element that fails the test, and go to it.
listSearchFromCurrent :: Searchable t
  => (e -> Bool) -- ^ The test
  -> Dir
  -> EventM n (L.GenericList n t e) ()
listSearchFromCurrent t d = let
  searchList = case d of
    Bwd -> skipListBackward
    Fwd -> skipListForward
  in modify $ \l -> case searchList IncludeCurrent t l of
    Nothing -> l
    Just ix -> l & L.listSelectedL ?~ ix

-- | If searching for an element that fails the test in the specified direction fails, show as many elements as possible
-- in the direction.
--
-- The current element is not included in the search.
listShow :: Searchable t
  => (e -> Bool) -- ^ The test
  -> Dir
  -> EventM n (L.GenericList n t e) ()
listShow t d = do
  l <- get
  let (skipList, vScroll) = case d of
        -- `\s -> vScrollToXXX s` is eta expansion.
        -- eta expansion is required for GHC 9.0.2 because of simplified subsumption developed by Simon Peyton Jones.
        -- https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0287-simplify-subsumption.rst
        -- simplified subsumption is disabled by default in later GHC versions.
        -- Simon Petyon Jones hasn't found a way to avoid deep subsumption and eta expansion.
        Bwd -> (skipListBackward, \s -> vScrollToBeginning s)
        Fwd -> (skipListForward, \s -> vScrollToEnd s)
  case skipList ExcludeCurrent t l of
    Nothing -> vScroll $ viewportScroll $ l ^. L.listNameL
    Just _ -> return ()

-- | Search forward for the first element index that fails the test
skipListForward :: Searchable t
  => IncludeCurrent
  -> (e -> Bool) -- ^ The test
  -> L.GenericList n t e
  -> Maybe Int -- ^ The first element index that fails the test
skipListForward incCur test l = let
  skipForward idx es = case viewHead es of
    Nothing -> Nothing
    Just (e, es') -> if test e
      then skipForward (idx+1) es'
      else Just idx
  -- Start with the current list element index. If the current element is excluded, then add 1 to the current index.
  start = case l ^. L.listSelectedL of
    Nothing -> 0
    Just i -> i + case incCur of
      IncludeCurrent -> 0
      ExcludeCurrent -> 1
  es = drop start $ l ^. L.listElementsL
  in skipForward start es

-- | Search backward for the first element index that fails the test
skipListBackward :: Searchable t
  => IncludeCurrent
  -> (e -> Bool) -- ^ The test
  -> L.GenericList n t e
  -> Maybe Int -- ^ The first element index that fails the test
skipListBackward incCur test l = let
  skipBackward idx es = case viewLast es of
    Nothing -> Nothing
    Just (es', e) -> if test e
      then skipBackward (idx-1) es'
      else Just idx
  -- Start with the current list element index + 1 so that the current index is included. If the current element is
  -- excluded, don't add 1 to the current index.
  start = case l ^. L.listSelectedL of
    Nothing -> 0
    Just i -> i + case incCur of
      IncludeCurrent -> 1
      ExcludeCurrent -> 0
  es = take start $ l ^. L.listElementsL
  in skipBackward (start-1) es

-- | Search backward for the first element that fails the test.
--
-- The current element is not included in the search.
--
-- If backward search fails, no change is made.
listSkipBackward :: Searchable t
  => (e -> Bool) -- ^ The test
  -> L.GenericList n t e
  -> L.GenericList n t e
listSkipBackward test l = case skipListBackward ExcludeCurrent test l of
  Nothing -> l
  Just idx -> l & L.listSelectedL ?~ idx

-- | Search forward for the first element that fails the test.
--
-- The current element is not included in the search.
--
-- If forward search fails, no change is made.
listSkipForward :: Searchable t
  => (e -> Bool) -- ^ The test
  -> L.GenericList n t e
  -> L.GenericList n t e
listSkipForward test l = case skipListForward ExcludeCurrent test l of
  Nothing -> l
  Just idx -> l & L.listSelectedL ?~ idx

-- | Move by a (fractional) number of pages in the list. If the number of pages to move by is 0, no change is made.
-- Otherwise, call 'L.listMoveByPages' with the number of pages to move by.
--
-- The element chosen by 'L.listMoveByPages' is included in the search.
--
-- After calling 'L.listMoveByPages', if the number of pages to move by was positive, search forward for the first
-- element that fails the test. If forward search fails, then search backward for the first such element. If backward
-- search fails too, cancel movements made by this function.
--
-- After calling 'L.listMoveByPages', if the number of pages to move by was negative, search backward for the first
-- element that fails the test. If backward search fails, then search forward for the first such element. If forward
-- search fails too, cancel movements made by this function.
listSkipByPages :: (Searchable t, Foldable t, L.Splittable t, Ord n, RealFrac pages)
  => (e -> Bool) -- ^ The test
  -> pages -- ^ Pages to move by
  -> EventM n (L.GenericList n t e) ()
listSkipByPages test p = if p == 0
  then return ()
  else do
    origL <- get
    L.listMoveByPages p
    let (searchList, searchListOpposite) = if p < 0
           then (skipListBackward, skipListForward)
           else (skipListForward, skipListBackward)
    modify $ \l -> case searchList IncludeCurrent test l of
      Nothing -> case searchListOpposite ExcludeCurrent test l of
        Nothing -> origL
        Just idx -> l & L.listSelectedL ?~ idx
      Just idx -> l & L.listSelectedL ?~ idx

-- | From the first element, search forward for the first element that fails the test.
--
-- The first element is included in the search.
--
-- If forward search fails, no change is made.
listSkipToBeginning :: (Searchable t, Foldable t, L.Splittable t)
  => (e -> Bool) -- ^ The test
  -> L.GenericList n t e
  -> L.GenericList n t e
listSkipToBeginning test l = case skipListForward IncludeCurrent test (L.listMoveToBeginning l) of
  Nothing -> l
  Just idx -> l & L.listSelectedL ?~ idx

-- | From the last element, search backward for the first element that fails the test.
--
-- The last element is included in the search.
--
-- If backward search fails, no change is made.
listSkipToEnd :: (Searchable t, Foldable t, L.Splittable t)
  => (e -> Bool) -- ^ The test
  -> L.GenericList n t e
  -> L.GenericList n t e
listSkipToEnd test l = case skipListBackward IncludeCurrent test (L.listMoveToEnd l) of
  Nothing -> l
  Just idx -> l & L.listSelectedL ?~ idx

-- | Functions for searching elements.
class Searchable (t :: * -> *) where
  -- | Get the head and the rest
  viewHead :: t a -> Maybe (a, t a)
  -- | Get the last element and the rest
  viewLast :: t a -> Maybe (t a, a)
  -- | Take a number of elements from the beginning
  take :: Int -> t a -> t a
  -- | Drop a number of elements from the beginning
  drop :: Int -> t a -> t a

-- | O(1) for all operations
instance Searchable Vector where
  viewHead = uncons
  viewLast = unsnoc
  take = V.take
  drop = V.drop

-- | O(1) for viewHead and viewLast. O(log(min(i,n-i))) for take and drop.
instance Searchable Seq where
  viewHead s = case S.viewl s of
    EmptyL -> Nothing
    a :< s' -> Just (a, s')
  viewLast s = case S.viewr s of
    EmptyR -> Nothing
    s' :> a -> Just (s', a)
  take = S.take
  drop = S.drop