Simple.hs

module Ribosome.Menu.Simple where

import Control.Lens (_2, element, ifolded, over, set, toListOf, view, withIndex, (^..), (^?))
import qualified Control.Lens as Lens (filtered)
import Data.Composition ((.:))
import Data.Map.Strict ((!?))
import qualified Data.Map.Strict as Map (fromList, union)
import qualified Data.Ord as Ord (Down(Down))
import qualified Data.Text as Text (breakOn, null)
import qualified Text.Fuzzy as Fuzzy (Fuzzy(score, original), filter)

import Ribosome.Data.List (indexesComplement)
import Ribosome.Menu.Action (menuContinue, menuCycle, menuQuitWith, menuToggle, menuToggleAll)
import Ribosome.Menu.Data.BasicMenuAction (BasicMenuAction, BasicMenuChange)
import qualified Ribosome.Menu.Data.BasicMenuAction as BasicMenuAction (BasicMenuAction(..))
import qualified Ribosome.Menu.Data.BasicMenuAction as BasicMenuChange (BasicMenuChange(..))
import Ribosome.Menu.Data.FilteredMenuItem (FilteredMenuItem(FilteredMenuItem))
import qualified Ribosome.Menu.Data.FilteredMenuItem as FilteredMenuItem (index, item)
import Ribosome.Menu.Data.Menu (Menu(Menu), MenuFilter(MenuFilter))
import qualified Ribosome.Menu.Data.Menu as Menu (currentFilter, filtered, items, marked, selected)
import Ribosome.Menu.Data.MenuAction (MenuAction)
import qualified Ribosome.Menu.Data.MenuAction as MenuAction (MenuAction(..))
import Ribosome.Menu.Data.MenuConsumerAction (MenuConsumerAction)
import qualified Ribosome.Menu.Data.MenuConsumerAction as MenuConsumerAction (MenuConsumerAction(..))
import Ribosome.Menu.Data.MenuEvent (MenuEvent)
import qualified Ribosome.Menu.Data.MenuEvent as MenuEvent (MenuEvent(..))
import qualified Ribosome.Menu.Data.MenuEvent as QuitReason (QuitReason(..))
import Ribosome.Menu.Data.MenuItem (MenuItem)
import qualified Ribosome.Menu.Data.MenuItem as MenuItem (text)
import Ribosome.Menu.Data.MenuItemFilter (MenuItemFilter(MenuItemFilter))
import Ribosome.Menu.Data.MenuUpdate (MenuUpdate(MenuUpdate))
import Ribosome.Menu.Prompt.Data.Prompt (Prompt(Prompt))

type MappingHandler m a i = Menu i -> Prompt -> m (MenuConsumerAction m a, Menu i)
type Mappings m a i = Map Text (MappingHandler m a i)

zipWithIndex :: [a] -> [(Int, a)]
zipWithIndex =
  toListOf $ ifolded . withIndex

textContains :: Text -> Text -> Bool
textContains needle haystack =
  Text.null needle || (not (Text.null haystack) && search needle haystack)
  where
    search =
      not . Text.null . snd .: Text.breakOn

substringMenuItemMatcher :: MenuItemFilter a
substringMenuItemMatcher =
  MenuItemFilter filt
  where
    filt text =
      uncurry FilteredMenuItem <$$> matcher text
    matcher text =
      toListOf $ ifolded . Lens.filtered (textContains text . view MenuItem.text) . withIndex

fuzzyMenuItemMatcher :: MenuItemFilter a
fuzzyMenuItemMatcher =
  MenuItemFilter matcher
  where
    matcher =
      fmap (uncurry FilteredMenuItem . Fuzzy.original) . sortOn (Ord.Down . Fuzzy.score) .: filtered
    filtered text items =
      Fuzzy.filter text (items ^.. ifolded . withIndex) "" "" (view (_2 . MenuItem.text)) False

menuItemsNonequal :: [FilteredMenuItem i] -> [FilteredMenuItem i] -> Bool
menuItemsNonequal a b =
  (view FilteredMenuItem.index <$> a) /= (view FilteredMenuItem.index <$> b)

updateFilter :: MenuItemFilter i -> Text -> Menu i -> (BasicMenuChange, Menu i)
updateFilter (MenuItemFilter itemFilter) text menu@(Menu items oldFiltered _ _ _ _) =
  (change, update menu)
  where
    change =
      if menuItemsNonequal filtered oldFiltered
      then BasicMenuChange.Change
      else BasicMenuChange.NoChange
    update =
      set Menu.filtered filtered . set Menu.currentFilter (MenuFilter text)
    filtered =
      itemFilter text items

reapplyFilter :: MenuItemFilter i -> Menu i -> (BasicMenuChange, Menu i)
reapplyFilter itemFilter menu@(Menu _ _ _ _ (MenuFilter currentFilter) _) =
  updateFilter itemFilter currentFilter menu

basicMenuTransform :: MenuItemFilter i -> MenuEvent m a i -> Menu i -> BasicMenuAction m a i
basicMenuTransform matcher (MenuEvent.PromptChange (Prompt _ _ text)) =
  BasicMenuAction.Continue BasicMenuChange.Reset . snd . updateFilter matcher text
basicMenuTransform _ (MenuEvent.Mapping _ _) =
  BasicMenuAction.Continue BasicMenuChange.NoChange
basicMenuTransform matcher (MenuEvent.NewItems items) =
  uncurry BasicMenuAction.Continue . reapplyFilter matcher . over Menu.items (++ items)
basicMenuTransform _ (MenuEvent.Init _) =
  BasicMenuAction.Continue BasicMenuChange.Change
basicMenuTransform _ (MenuEvent.Quit reason) =
  const $ BasicMenuAction.Quit reason

resetSelection :: BasicMenuChange -> Menu i -> Menu i
resetSelection BasicMenuChange.Reset (Menu i f _ _ filt mi) =
  Menu i f 0 [] filt mi
resetSelection _ m =
  m

menuAction ::
  MenuItemFilter i ->
  Bool ->
  MenuConsumerAction m a ->
  Menu i ->
  (MenuAction m a, Menu i)
menuAction itemFilter _ MenuConsumerAction.Filter menu =
  (MenuAction.Render True, uncurry resetSelection $ reapplyFilter itemFilter menu)
menuAction _ True MenuConsumerAction.Continue menu =
  (MenuAction.Render True, menu)
menuAction _ False MenuConsumerAction.Continue menu =
  (MenuAction.Continue, menu)
menuAction _ _ (MenuConsumerAction.Execute thunk) menu =
  (MenuAction.Execute thunk, menu)
menuAction _ basicChanged (MenuConsumerAction.Render consumerChanged) menu =
  (MenuAction.Render (basicChanged || consumerChanged), menu)
menuAction _ _ (MenuConsumerAction.QuitWith ma) menu =
  (MenuAction.Quit (QuitReason.Execute ma), menu)
menuAction _ _ MenuConsumerAction.Quit menu =
  (MenuAction.Quit QuitReason.Aborted, menu)
menuAction _ _ (MenuConsumerAction.Return a) menu =
  (MenuAction.Quit (QuitReason.Return a), menu)
menuAction _ _ (MenuConsumerAction.UpdatePrompt prompt) menu =
  (MenuAction.UpdatePrompt prompt, menu)

basicMenuAction ::
  Monad m =>
  MenuItemFilter i ->
  (MenuUpdate m a i -> m (MenuConsumerAction m a, Menu i)) ->
  MenuUpdate m a i ->
  BasicMenuAction m a i ->
  m (MenuAction m a, Menu i)
basicMenuAction itemFilter consumer (MenuUpdate event menu) =
  act
  where
    act (BasicMenuAction.Quit reason) =
      pure (MenuAction.Quit reason, menu)
    act (BasicMenuAction.Continue change m) = do
      (action, updatedMenu) <- consumerTransform (resetSelection change m)
      return $ menuAction itemFilter (change /= BasicMenuChange.NoChange) action updatedMenu
    consumerTransform newMenu =
      consumer (MenuUpdate event newMenu)

basicMenu ::
  Monad m =>
  MenuItemFilter i ->
  (MenuUpdate m a i -> m (MenuConsumerAction m a, Menu i)) ->
  MenuUpdate m a i ->
  m (MenuAction m a, Menu i)
basicMenu itemFilter consumer update@(MenuUpdate event menu) =
  basicMenuAction itemFilter consumer update basicTransform
  where
    basicTransform =
      basicMenuTransform itemFilter event menu

mappingConsumer ::
  Monad m =>
  Mappings m a i ->
  MenuUpdate m a i ->
  m (MenuConsumerAction m a, Menu i)
mappingConsumer mappings (MenuUpdate (MenuEvent.Mapping char prompt) menu) =
  handler menu prompt
  where
    handler =
      fromMaybe (const . menuContinue) (mappings !? char)
mappingConsumer _ (MenuUpdate _ menu) =
  menuContinue menu

simpleMenu ::
  Monad m =>
  Mappings m a i ->
  MenuUpdate m a i ->
  m (MenuAction m a, Menu i)
simpleMenu =
  basicMenu fuzzyMenuItemMatcher . mappingConsumer

defaultMappings ::
  Monad m =>
  Mappings m a i
defaultMappings =
  Map.fromList [
    ("k", menuCycle 1),
    ("c-k", menuCycle 1),
    ("j", menuCycle (-1)),
    ("c-j", menuCycle (-1)),
    ("space", menuToggle),
    ("*", menuToggleAll)
    ]

defaultMenu ::
  Monad m =>
  Mappings m a i ->
  MenuUpdate m a i ->
  m (MenuAction m a, Menu i)
defaultMenu =
  simpleMenu . (`Map.union` defaultMappings)

selectedMenuItem :: Menu i -> Maybe (MenuItem i)
selectedMenuItem (Menu _ filtered selected _ _ _) =
  filtered ^? element selected . FilteredMenuItem.item

withSelectedMenuItem ::
  Monad m =>
  (MenuItem i -> m (MenuConsumerAction m a, Menu i)) ->
  Menu i ->
  m (MenuConsumerAction m a, Menu i)
withSelectedMenuItem f m =
  maybe (menuContinue m) pure =<< traverse f (selectedMenuItem m)

filterIndexes :: [Int] -> [a] -> [a]
filterIndexes indexes =
  reverse . go 0 (sort indexes) []
  where
    go current (i : is) result (a : asTail) | i == current =
      go (current + 1) is (a : result) asTail
    go current is result (_ : asTail) =
      go (current + 1) is result asTail
    go _ _ result _ =
      result

markedIndexes :: Menu i -> [Int]
markedIndexes (Menu _ _ selected [] _ _) =
  [selected]
markedIndexes (Menu _ _ _ marked _ _) =
  marked

menuItemsByIndexes :: [Int] -> Menu i -> [MenuItem i]
menuItemsByIndexes indexes (Menu _ filtered _ _ _ _) =
  view FilteredMenuItem.item <$> filterIndexes indexes filtered

markedMenuItemsOnly :: Menu i -> Maybe (NonEmpty (MenuItem i))
markedMenuItemsOnly (Menu _ _ _ [] _ _) =
  Nothing
markedMenuItemsOnly (Menu _ filtered _ marked _ _) =
  nonEmpty $ view FilteredMenuItem.item <$> filterIndexes marked filtered

markedMenuItems :: Menu i -> Maybe (NonEmpty (MenuItem i))
markedMenuItems m =
  markedMenuItemsOnly m <|> (pure <$> selectedMenuItem m)

unmarkedMenuItems :: Menu i -> [MenuItem i]
unmarkedMenuItems menu =
  menuItemsByIndexes (indexesComplement (length (view Menu.filtered menu)) (indexes menu)) menu
  where
    indexes (Menu _ _ selected [] _ _) =
      [selected]
    indexes (Menu _ _ _ marked _ _) =
      marked

withMarkedMenuItems ::
  Monad m =>
  (NonEmpty (MenuItem i) -> m a) ->
  Menu i ->
  m (Maybe a)
withMarkedMenuItems f m =
  traverse f (markedMenuItems m)

withMarkedMenuItems_ ::
  Monad m =>
  (NonEmpty (MenuItem i) -> m ()) ->
  Menu i ->
  m ()
withMarkedMenuItems_ f m =
  traverse_ f (markedMenuItems m)

actionWithMarkedMenuItems ::
  Monad m =>
  (m (NonEmpty b) -> Menu i -> m (MenuConsumerAction m a, Menu i)) ->
  (MenuItem i -> m b) ->
  Menu i ->
  m (MenuConsumerAction m a, Menu i)
actionWithMarkedMenuItems next f m =
  fromMaybe (MenuConsumerAction.Continue, m) <$> withMarkedMenuItems run m
  where
    run items =
      next (traverse f items) m

traverseMarkedMenuItems ::
  Monad m =>
  (MenuItem i -> m a) ->
  Menu i ->
  m (Maybe (NonEmpty a))
traverseMarkedMenuItems =
  withMarkedMenuItems . traverse

traverseMarkedMenuItems_ ::
  Monad m =>
  (MenuItem i -> m ()) ->
  Menu i ->
  m ()
traverseMarkedMenuItems_ =
  withMarkedMenuItems_ . traverse_

traverseMarkedMenuItemsAndQuit ::
  Monad m =>
  (MenuItem i -> m a) ->
  Menu i ->
  m (MenuConsumerAction m (NonEmpty a), Menu i)
traverseMarkedMenuItemsAndQuit =
  actionWithMarkedMenuItems menuQuitWith

traverseMarkedMenuItemsAndQuit_ ::
  Monad m =>
  (MenuItem i -> m ()) ->
  Menu i ->
  m (MenuConsumerAction m (), Menu i)
traverseMarkedMenuItemsAndQuit_ f =
  first void <$$> actionWithMarkedMenuItems menuQuitWith f

deleteByFilteredIndex :: [Int] -> Menu i -> Menu i
deleteByFilteredIndex indexes menu@(Menu items filtered _ _ _ _) =
  set Menu.items newItems . set Menu.filtered [] $ menu
  where
    newItems =
      filterIndexes (indexesComplement (length items) unfilteredIndexes) items
    unfilteredIndexes =
      view FilteredMenuItem.index <$> filterIndexes indexes filtered

deleteMarked :: Menu i -> Menu i
deleteMarked menu =
  set Menu.selected 0 . set Menu.marked [] . deleteByFilteredIndex (markedIndexes menu) $ menu