{-# 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