HelpWidget.hs

{-# LANGUAGE RankNTypes, OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Vimus.Widget.HelpWidget (
  makeHelpWidget

-- exported to silence warnings
, CommandList (..)
, HelpWidget (..)
) where

import           Data.List (intercalate)
import           Data.Monoid
import           Control.Applicative
import           Text.Printf (printf)
import           Data.String
import           Data.List (sortBy)
import           Data.Map (Map)
import qualified Data.Map as Map
import           Data.Ord (comparing)

import           Vimus.Type
import           Vimus.Command.Help hiding (help)
import           Vimus.Command.Core (Command, commandName, commandSynopsis)
import           Vimus.Command.Type (commandHelp_)
import           Vimus.Widget.ListWidget (ListWidget)
import qualified Vimus.Widget.ListWidget as ListWidget
import           Vimus.Widget.TextWidget
import           Vimus.Widget.Type
import           Content
import           Vimus.WindowLayout

data HelpWidget = HelpWidget {
  helpWidgetCommandList  :: CommandList
, helpWidgetDetailedHelp :: Maybe AnyWidget
}

makeHelpWidget :: [Command] -> Map String [String] -> AnyWidget
makeHelpWidget commands macroGuesses = AnyWidget (HelpWidget commandList Nothing)
  where
    commandList = CommandList (ListWidget.new $ sortBy (comparing commandName) commands) macroGuesses

-- helper for searchItem and filterItem pass-through
passThrough :: (forall a . Widget a => (a -> a)) -> HelpWidget -> HelpWidget
passThrough f (HelpWidget commandList mDetails) = case mDetails of
  Just details -> HelpWidget commandList (Just $ f details)
  Nothing      -> HelpWidget (f commandList) Nothing

commandHelp :: Command -> [TextLine]
commandHelp c = TextLine [Colored SuggestionsColor $ commandSynopsis c] : (map (fromString . ("  " ++)) . commandHelpText) c

instance Widget HelpWidget where
  render (HelpWidget commandList mDetails) = maybe (render commandList) render mDetails
  currentItem _                            = Nothing
  searchItem widget o t                    = passThrough (\w -> searchItem w o t) widget
  filterItem widget t                      = passThrough (`filterItem` t) widget

  handleEvent widget@(HelpWidget commandList mDetails) ev  = case ev of

    -- switch between command list and details on :default-action
    EvDefaultAction -> maybe moveIn (const moveOut) mDetails

    -- show details on :move-in
    EvMoveIn        -> moveIn

    -- go back to command list on :move-out
    EvMoveOut       -> moveOut

    -- pass through all other events
    _               -> passThrough_
    where
      passThrough_ = case mDetails of
        Just details -> HelpWidget commandList . Just <$> handleEvent details ev
        Nothing      -> (`HelpWidget` Nothing) <$> handleEvent commandList ev

      moveOut = return $ HelpWidget commandList Nothing

      moveIn = return $ case (mDetails, selectCommand commandList) of

        -- command selected, show details
        (Nothing, Just c) -> HelpWidget commandList (Just . makeTextWidget $ commandHelp c)

        -- already showing details (or no command under cursor), do nothing
        _ -> widget

data CommandList = CommandList {
  commandListCommands     :: ListWidget () Command
, commandListMacroGuesses :: Map String [String]
}

instance Searchable Command where
  searchTags c = commandName c : concatMap words (unHelp $ commandHelp_ c)

selectCommand :: CommandList -> Maybe Command
selectCommand = ListWidget.select . commandListCommands

instance Widget CommandList where
  render (CommandList w ms) = do
    ListWidget.render (const False) (fmap help w)
    where
      help c = mconcat [TextLine . return . Colored SuggestionsColor . printf "%-30s" $ commandSynopsis c, macros, fromString $ commandShortHelp c]
        where
          -- macros defined for this command
          macros  = TextLine . return . Colored InputColor . printf "%-18s  " $ maybe "" (intercalate "  ") mMacros
          mMacros = Map.lookup (commandName c) ms

  currentItem _                      = Nothing
  searchItem  (CommandList w ms) o t = CommandList (ListWidget.searchItem w o t) ms
  filterItem  (CommandList w ms) t   = CommandList (ListWidget.filterItem w t) ms
  handleEvent (CommandList w ms) ev  = (`CommandList` ms) <$> ListWidget.handleEvent w ev