-- | Command line manager -- This manager will listen to the standard input as soon as the MVar token is filled. -- Then, it will fill another MVar (input) with the parsed command. -- Autocompletion is supported throught haskeline configuration. module Shaker.Cli( getInput ,listActions ,InputState(..) ) where import Shaker.Parser import Shaker.Type import Control.Concurrent import Control.Monad.Trans import System.Console.Haskeline import qualified Data.Map as M import Data.List import Control.Monad.Reader -- | The input mvar is used to push the parsed command type Input = MVar Command -- | Token is used to manage the token between action executor and command-line listener type Token = MVar Int data InputState = InputState { input :: Input, token :: Token } -- | Listen to keyboard input and parse command getInput :: InputState -> Shaker IO() getInput inSt = do shIn <- ask lift $ runInputT (myDefaultSettings shIn) $ processInput shIn inSt -- | Execute the entered command processInput :: ShakerInput -> InputState -> InputT IO() processInput shIn (InputState inputMv tokenMv) = do _ <- lift $ takeMVar tokenMv minput <- getInputLine "% " case minput of Nothing -> return() Just str -> lift $ tryPutMVar inputMv (parseCommand shIn str) >> return() -- * Auto-completion management -- | Settings for haskeline myDefaultSettings :: MonadIO m => ShakerInput-> Settings m myDefaultSettings shIn = Settings { complete = completeAction shIn, historyFile = Nothing, autoAddHistory = True } completeAction :: Monad m => ShakerInput -> CompletionFunc m completeAction shIn = completeWord (Just '\\') "\"'~" (listActions shIn) listActions :: Monad m => ShakerInput -> String -> m [Completion] listActions shIn str = return $ autocompleteFunction (commandMap shIn) str autocompleteFunction :: CommandMap -> String -> [Completion] autocompleteFunction cmdMap [] = map simpleCompletion $ M.keys cmdMap autocompleteFunction cmdMap cliInput = map simpleCompletion compleListProp where inpWords = words cliInput lastWord = last inpWords listProp = filter (lastWord `isPrefixOf`) $ M.keys cmdMap commonPref = unwords (init inpWords) compleListProp = trimList $ map (\a -> commonPref ++ " " ++ a) listProp trimList :: [String] -> [String] trimList = map (dropWhile (== ' '))