Simple.hs

module Ribosome.Menu.Simple where

import Control.Lens ((^?))
import qualified Control.Lens as Lens (element, over, views)
import Data.Composition ((.:))
import Data.Map ((!?))
import qualified Data.Map as Map (fromList, union)
import qualified Data.Text as Text (breakOn, null)

import Ribosome.Menu.Data.Menu (Menu(Menu), MenuFilter(MenuFilter))
import qualified Ribosome.Menu.Data.Menu as Menu (filtered, items, 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 (MenuItem(_text))
import Ribosome.Menu.Data.MenuUpdate (MenuUpdate(MenuUpdate))
import Ribosome.Menu.Prompt.Data.Prompt (Prompt(Prompt))

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

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

updateFilter :: Text -> Menu -> (Bool, MenuAction m a, Menu)
updateFilter text (Menu items oldFiltered stack selected _) =
  (filtered /= oldFiltered, MenuAction.Continue, Menu items filtered stack selected (MenuFilter text))
  where
    filtered =
      filter (textContains text . MenuItem._text) items

reapplyFilter :: Menu -> (Bool, MenuAction m a, Menu)
reapplyFilter menu@(Menu _ _ _ _ (MenuFilter currentFilter)) =
  updateFilter currentFilter menu

basicMenuTransform :: MenuEvent m a -> Menu -> (Bool, MenuAction m a, Menu)
basicMenuTransform (MenuEvent.PromptChange _ (Prompt _ _ text)) =
  updateFilter text
basicMenuTransform (MenuEvent.Mapping _ _) =
  (False, MenuAction.Continue,)
basicMenuTransform (MenuEvent.NewItems item) =
  reapplyFilter . Lens.over Menu.items (item :)
basicMenuTransform (MenuEvent.Init _) =
  (True, MenuAction.Continue,)
basicMenuTransform (MenuEvent.Quit reason) =
  (False, MenuAction.Quit reason,)

basicMenu ::
  Monad m =>
  (MenuUpdate m a -> m (MenuConsumerAction m a, Menu)) ->
  MenuUpdate m a ->
  m (MenuAction m a, Menu)
basicMenu consumer (MenuUpdate event menu) =
  consumerAction action
  where
    (changed, action, newMenu) = basicMenuTransform event menu
    consumerAction (MenuAction.Quit reason) =
      return (MenuAction.Quit reason, menu)
    consumerAction _ =
      first menuAction <$> consumer (MenuUpdate event newMenu)
    menuAction MenuConsumerAction.Continue =
      if changed then MenuAction.Render True else MenuAction.Continue
    menuAction (MenuConsumerAction.Render consumerChanged) =
      MenuAction.Render (changed || consumerChanged)
    menuAction (MenuConsumerAction.QuitWith ma) =
      MenuAction.Quit (QuitReason.Execute ma)
    menuAction MenuConsumerAction.Quit =
      MenuAction.Quit QuitReason.Aborted
    menuAction (MenuConsumerAction.Return a) =
      MenuAction.Quit (QuitReason.Return a)

mappingConsumer ::
  Monad m =>
  Mappings m a ->
  MenuUpdate m a ->
  m (MenuConsumerAction m a, Menu)
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 ->
  MenuUpdate m a ->
  m (MenuAction m a, Menu)
simpleMenu =
  basicMenu . mappingConsumer

menuCycle ::
  Monad m =>
  Int ->
  Menu ->
  Prompt ->
  m (MenuConsumerAction m a, Menu)
menuCycle offset m _ =
  menuRender False (Lens.over Menu.selected add m)
  where
    count =
      Lens.views Menu.filtered length m
    add current =
      if count == 0 then 0 else (current + offset) `mod` count

defaultMappings ::
  Monad m =>
  Mappings m a
defaultMappings =
  Map.fromList [("k", menuCycle 1), ("j", menuCycle (-1))]

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

menuContinue ::
  Monad m =>
  Menu ->
  m (MenuConsumerAction m a, Menu)
menuContinue =
  return . (MenuConsumerAction.Continue,)

menuRender ::
  Monad m =>
  Bool ->
  Menu ->
  m (MenuConsumerAction m a, Menu)
menuRender changed =
  return . (MenuConsumerAction.Render changed,)

menuQuit ::
  Monad m =>
  Menu ->
  m (MenuConsumerAction m a, Menu)
menuQuit =
  return . (MenuConsumerAction.Quit,)

menuQuitWith ::
  Monad m =>
  m a ->
  Menu ->
  m (MenuConsumerAction m a, Menu)
menuQuitWith next =
  return . (MenuConsumerAction.QuitWith next,)

menuReturn ::
  Monad m =>
  a ->
  Menu ->
  m (MenuConsumerAction m a, Menu)
menuReturn a =
  return . (MenuConsumerAction.Return a,)

selectedMenuItem :: Menu -> Maybe MenuItem
selectedMenuItem (Menu _ items _ selected _) =
  items ^? Lens.element (length items - selected - 1)