haskell - Command line autocompletion based on context

Question

I have a following program (and here is the link to the program in an online IDE), purpose of which is to explore Haskell command line autocompletion capabilities:

{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}

import System.Console.Haskeline
import System.IO
import System.IO.Unsafe
import Control.Monad.State.Strict
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.List 
import qualified Data.Map as M

data MyDataState = MyDataState {
  mydata :: [Int],
  selectedElement :: Int,
  showEven :: Bool
} deriving (Show)

instance MonadState s m => MonadState s (InputT m) where
    get = lift get
    put = lift . put
    state = lift . state

myfile :: FilePath
myfile = "data.txt"

defaultFlagValue :: Bool
defaultFlagValue = False

defaultSelectedElement :: Int
defaultSelectedElement = 0

saveDataToFile :: [Int] -> IO ()
saveDataToFile _data = withFile myfile WriteMode $ h -> hPutStr h (unwords $ map show _data)

{-# NOINLINE loadDataFromFile #-} 
loadDataFromFile :: [Int]
loadDataFromFile = map read . words $ B.unpack $ unsafePerformIO $ B.readFile myfile

generalSetOfCommands = M.fromList [
    (":help", "outputs this help"), 
    (":q", "quits the program"), 
    (":commands", "list of all commands applicable to the current selection"), 
    (":show", "show current set of data"), 
    (":save", "saves data to file"), 
    (":load", "loads data from file"), 
    (":select", "selects one of the data set elements to be current"), 
    (":new", "adds element to the data set"), 
    (":toggleShowEven", "toggles the flag that controls output of even data set elements")
  ]
firstSetOfCommands = M.fromList [
    (":command1_1", "description of :command1_1"), 
    (":command1_2", "description of :command1_2"), 
    (":command1_3", "description of :command1_3"), 
    (":command1_4", "description of :command1_4")
  ]
secondSetOfCommands = M.fromList [
    (":command2_1", "description of :command2_1"), 
    (":command2_2", "description of :command2_2"), 
    (":command2_3", "description of :command2_3"), 
    (":command2_4", "description of :command2_4")
  ]
thirdSetOfCommands = M.fromList [
    (":command3_1", "description of :command3_1"), 
    (":command3_2", "description of :command3_2"), 
    (":command3_3", "description of :command3_3"), 
    (":command3_4", "description of :command3_4")
  ]

searchFunc :: MyDataState -> String -> [Completion]
searchFunc (MyDataState mydata selectedElement showEven) str = 
    map simpleCompletion $ filter (str `isPrefixOf`) (M.keys generalSetOfCommands ++ 
        case selectedElement of 
          1 -> M.keys firstSetOfCommands
          2 -> M.keys secondSetOfCommands
          3 -> M.keys thirdSetOfCommands
          otherwise -> []
    )

mySettings :: Settings (StateT MyDataState IO)
mySettings = Settings { historyFile = Just "myhist"
                      , complete = completeWord Nothing " 	" $ str -> do 
                          _data <- get
                          return $ searchFunc _data str 
                      , autoAddHistory = True
                      }

help :: InputT (StateT MyDataState IO) ()
help = commands

commands :: InputT (StateT MyDataState IO) ()
commands = do
        (MyDataState mydata selectedElement flag) <- get
        liftIO $ mapM_ putStrLn $ case selectedElement of 
          1 -> M.elems $ M.mapWithKey (k v -> k ++ "	 - " ++ v) $ M.unionWith (++) generalSetOfCommands firstSetOfCommands
          2 -> M.elems $ M.mapWithKey (k v -> k ++ "	 - " ++ v) $ M.unionWith (++) generalSetOfCommands secondSetOfCommands
          3 -> M.elems $ M.mapWithKey (k v -> k ++ "	 - " ++ v) $ M.unionWith (++) generalSetOfCommands thirdSetOfCommands
          otherwise -> M.elems $ M.mapWithKey (k v -> k ++ "	 - " ++ v) generalSetOfCommands

toggleFlag :: InputT (StateT MyDataState IO) ()
toggleFlag = do
  MyDataState mydata selectedElement flag <- get
  put $ MyDataState mydata selectedElement (not flag)

parseInput :: String -> InputT (StateT MyDataState IO) () 
parseInput inp
  | ":q" == inp = return ()

  | ":help" == inp = help >> mainLoop

  | ":commands" == inp = (commands >> mainLoop)

  | ":toggleShowEven" == inp = do 
      toggleFlag 
      MyDataState mydata selectedElement flag <- get
      liftIO $ putStrLn $ "Flag has been set to " ++ (show flag)
      mainLoop

  | ":select" == inp = do
      MyDataState mydata selectedElement showEven <- get
      inputData <- getInputLine "	Select one of the data elements to be current: "
      case inputData of
        Nothing -> put (MyDataState mydata selectedElement showEven)
        Just inputD ->
          let inputInt = read inputD 
          in if elem inputInt mydata
            then put (MyDataState mydata inputInt showEven)
            else do 
              liftIO $ putStrLn $ "The element you entered (" ++ (show inputInt) ++ ") has not been found in the data set"
              put (MyDataState mydata selectedElement showEven)
      mainLoop  

  | ":show" == inp = do
      MyDataState mydata selectedElement showEven <- get
      liftIO $ putStrLn $ unwords $ if showEven 
        then map (x -> if x == selectedElement then "[" ++ show x ++ "]" else show x) mydata
        else map (x -> if x == selectedElement then "[" ++ show x ++ "]" else show x) $ filter odd mydata
      mainLoop 

  | ":save" == inp = do
      MyDataState mydata selectedElement _ <- get 
      liftIO $ saveDataToFile mydata
      mainLoop

  | ":load" == inp = do
      put (MyDataState loadDataFromFile defaultSelectedElement defaultFlagValue)
      mainLoop

  | ":new" == inp = do
      MyDataState mydata selectedElement showEven <- get                     -- reads the state
      inputData <- getInputLine "	Enter data: "
      case inputData of 
        Nothing -> 
          put $ if null mydata
            then ( MyDataState [0] selectedElement showEven )
            else ( MyDataState mydata selectedElement showEven )
        Just inputD -> 
          put $ if null mydata 
            then MyDataState [read inputD] selectedElement showEven
            else MyDataState (mydata ++ [read inputD]) selectedElement showEven -- updates the state
      mainLoop

  | ":" == inp = do
    outputStrLn $ "
No command "" ++ inp ++ ""
"
    mainLoop

  | otherwise = handleInput inp

handleInput :: String -> InputT (StateT MyDataState IO) ()
handleInput inp = mainLoop

mainLoop :: InputT (StateT MyDataState IO ) ()
mainLoop = do
  inp <- getInputLine "% "
  maybe (return ()) parseInput inp

greet :: IO ()
greet = mapM_ putStrLn
        [ ""
        , "          MyProgram"
        , "=============================="
        , "For help type ":help""
        , ""
        ]

main :: IO ((), MyDataState)
main = do 
    greet 
    runStateT (runInputT mySettings mainLoop) MyDataState {mydata = [] , selectedElement = defaultSelectedElement, showEven = defaultFlagValue}

In my previous question I was struggling with adding possibility to take into account program state and form autocompletion list based on that. Now that I have overcome this problem, another question arises - how could I take into account current context of the command line command?

For instance, here is a short example of interaction with my program:

*Main> main

          MyProgram
==============================
For help type ":help"

% :show

% :new
    Enter data: 1
% :new
    Enter data: 2
% :new
    Enter data: 3
% :select
    Select one of the data elements to be current: 2
% :show
1 3
% :toggleShowEven
Flag has been set to True
% :show
1 [2] 3
% :
:commands        :load            :q               :select          :toggleShowEven  :command2_2      :command2_4
:help            :new             :save            :show            :command2_1      :command2_3
% 

As you can see, it autocompletes list of currently available commands based on current selection (in this example it is value 2). But what if I want to generate new set of commands for existing command, :select for example?

In this case, on input

% :select
    Select one of the data elements to be current: 

when pressing Tab, I want to get list of available values for autocompletion 1 2 3 and only those values. Is it possible to somehow take into account the place where I am calling autocompletion function?

What I expect it to be is different versions of searchFunc function for different context. For example, for :select command it would be selectSearchFunc. But I don't know how could I make it be applied only when :select command is called. It seems that mySettings somehow should be redefined to be applied not on global scope, but on local scope, but it is not really obvious how to do that. I would appreciate any suggestion that would help to resolve this issue.

Answer 1

We can extend the state so that searchFunc can behave differently inside a select.

data WholeState = WholeState MyDataState MyCmdlineState

data MyCmdlineState = TopLevel | Select   -- etc.

searchFunc (WholeState mydatastate TopLevel) str = (...)  -- what the current searchFunc does
searchFunc (WholeState mydatastate Select  ) str = (...)  -- special completion in a select

Then use a "bracket function" to set the command-line state in a fixed scope.

localCmdlineState :: MonadState WholeState m => MyCmdlineState -> m a -> m a
localCmdlineState mcstate run = do
  WholeState mydatastate s0 <- get
  put (WholeState mydatastate mcstate)
  run
  WholeState mydatastate' _ <- get
  put (WholeState mydatastate' s0)

This can be used in parseInput, in the ":select" case, the getInputLine becomes

inputData <- localCmdlineState Select $ getInputLine "	Select one of the data elements to be current: "

---

Arguably, localCmdlineState is a bit complex. You have to pay attention to where each bit of the state goes. Another issue is that the MyCmdlineState introduces some indirection that makes the code a bit hard to follow.

One way to alleviate this is to use lenses, so only the relevant parts of WholeState appear in the code when we access them.

An even better approach is to use a different abstraction than MonadState to carry the current state of command-line completion (MyCmdlineState). In particular, I'm thinking of MonadReader, whose local function is exactly what we need.

Instead of a new enumeration type, why not just carry the searchFunc itself:

type SearchFunc = MyDataState -> String -> [Completion]

And instead of pattern-matching, we just make more definitions. It's also possible to create and pass SearchFunc on the fly.

topLevelSearchFunc :: SearchFunc
selectSearchFunc :: SearchFunc

We make the stack a bit longer:

type M = ReaderT SearchFunc (StateT MyDataState IO)

Implementing MonadReader for InputT is a bit tricky. lift-ing is not sufficient. Hopefully there is mapInputT.

instance MonadReader s m => MonadReader s (InputT m) where
    reader = lift . reader
    local f = mapInputT (local f)

Another bit that needs to change is mySettings, which thus gets searchFunc from its environment instead of a constant.

mySettings :: Settings M
mySettings = Settings { historyFile = Just "myhist"
                      , complete = completeWord Nothing " 	" $ str -> do 
                          _data <- get
                          searchFunc <- ask
                          return $ searchFunc _data str 
                      , autoAddHistory = True
                      }

In main, we start with topLevelSearchFunc

main = do
    greet
    runStateT (runReaderT (runInputT mySettings mainLoop) topLevelSearchFunc) MyDataState {mydata = [] , selectedElement = defaultSelectedElement, showEven = defaultFlagValue}

In parseInput, we set the SearchFunc locally, with syntax very similar to my previous solution:

inputData <- local (\_ -> selectSearchFunc) $ getInputLine "	Select one of the data elements to be current: "

---

Full gist

---

The advantage of this is that making SearchFunc only available via a MonadReader effect makes it clear that it can only be modified locally (using local).

The hope is that thus compartmentalizing the various components of the application state prevents them from interfering with each other and reduces the potential for mistakes.