我有一个以下程序（这里是link to the program in an online IDE），其目的是探索Haskell命令行自动完成功能：
{-# 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}
在我的previous question中，我一直在努力增加考虑程序状态的可能性，并基于此形成自动填充列表。现在我已经克服了这个问题，另一个问题出现了 - 我如何考虑命令行命令的当前上下文？
例如，以下是与我的程序交互的简短示例：
*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
%
如您所见，它根据当前选择自动填充当前可用命令的列表（在此示例中为值2）。但是，如果我想为现有命令生成一组新命令，例如:select怎么办？
在这种情况下，输入
% :select
Select one of the data elements to be current:
按标签时，我想获取自动完成 1 2 3 的可用值列表，并且只列出这些值。有可能以某种方式考虑我调用自动完成功能的地方吗？
我期望它是针对不同上下文的不同版本的searchFunc函数。例如，对于:select命令，它将是selectSearchFunc。但我不知道如何仅在调用:select命令时才能应用它。似乎应该重新定义mySettings以不应用于全局范围，而是应用于本地范围，但是如何做到这一点并不是很明显。我将不胜感激任何有助于解决此问题的建议。
答案 0 :(得分：1)
我们可以扩展状态，以便searchFunc在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
然后使用“括号函数”在固定范围内设置命令行状态。
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)
这可以在parseInput中使用，在":select"案例中，getInputLine变为
inputData <- localCmdlineState Select $ getInputLine "\tSelect one of the data elements to be current: "
可以说，localCmdlineState有点复杂。你必须注意国家的每个位置。另一个问题是MyCmdlineState引入了一些使代码难以理解的间接性。
缓解此问题的一种方法是使用镜头，因此当我们访问镜头时，只有WholeState的相关部分出现在代码中。
更好的方法是使用与MonadState不同的抽象来承载命令行完成的当前状态（MyCmdlineState）。特别是，我在考虑MonadReader，local函数正是我们所需要的。
为什么不只携带searchFunc本身而不是新的枚举类型：
type SearchFunc = MyDataState -> String -> [Completion]
而不是模式匹配，我们只是做出更多的定义。也可以动态创建和传递SearchFunc。
topLevelSearchFunc :: SearchFunc
selectSearchFunc :: SearchFunc
我们让堆栈更长一点：
type M = ReaderT SearchFunc (StateT MyDataState IO)
为MonadReader实施InputT有点棘手。 lift - 仅仅是不够的。希望有mapInputT。
instance MonadReader s m => MonadReader s (InputT m) where
reader = lift . reader
local f = mapInputT (local f)
另一个需要更改的位是mySettings，因此从其环境中获取searchFunc而不是常量。
mySettings :: Settings M
mySettings = Settings { historyFile = Just "myhist"
, complete = completeWord Nothing " \t" $ \str -> do
_data <- get
searchFunc <- ask
return $ searchFunc _data str
, autoAddHistory = True
}
在main中，我们从topLevelSearchFunc
main = do
greet
runStateT (runReaderT (runInputT mySettings mainLoop) topLevelSearchFunc) MyDataState {mydata = [] , selectedElement = defaultSelectedElement, showEven = defaultFlagValue}
在parseInput中，我们在本地设置了SearchFunc，其语法与我之前的解决方案非常相似：
inputData <- local (\_ -> selectSearchFunc) $ getInputLine "\tSelect one of the data elements to be current: "
这样做的好处是，只有通过SearchFunc效果提供MonadReader才能明确表示只能在本地修改（使用local）。
希望通过划分应用程序状态的各个组成部分来防止它们相互干扰并减少出错的可能性。