Reputation: 5949
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 " \t" $ \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 ++ "\t - " ++ v) $ M.unionWith (++) generalSetOfCommands firstSetOfCommands
2 -> M.elems $ M.mapWithKey (\k v -> k ++ "\t - " ++ v) $ M.unionWith (++) generalSetOfCommands secondSetOfCommands
3 -> M.elems $ M.mapWithKey (\k v -> k ++ "\t - " ++ v) $ M.unionWith (++) generalSetOfCommands thirdSetOfCommands
otherwise -> M.elems $ M.mapWithKey (\k v -> k ++ "\t - " ++ 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 "\tSelect 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 "\tEnter 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 $ "\nNo command \"" ++ inp ++ "\"\n"
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.
Upvotes: 0
Views: 182
Reputation: 33569
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 "\tSelect 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 " \t" $ \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 "\tSelect one of the data elements to be current: "
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.
Upvotes: 1