I want to write a text interface, which provides some default commands. This program supports tab completion of those commands.
This program also records user inputs and stores it in StateData. And now I want this program to support tab completion of those user inputs. For example:
*Main > main
> read a<tab> -- press tab and no suggestions (read is a default command)
> read abcde
...
> read a<tab> -- press tab
abcde -- suggestions
Is it possible to do that without using unsafe mechanism like IORef? Is there a way to pass updated st from loop (in repl) to replSettings startState (in repl)?
I am new to Haskeline and thanks for your time.
repl :: StateData -> IO()
repl startState = runInputT (replSettings startState) $ loop startState
where
loop :: StateData -> InputT IO ()
loop st = do
inputL <- getInputLine "> "
case inputL of
Nothing -> return ()
Just "quit" -> outputStrLn "--Exited--" >> return ()
Just ipt -> do (opt, st') <- process ipt `runStateT` st
...
loop st'
replSettings :: StateData -> Settings IO
replSettings st =
Settings
{ complete = replCompletion st,
historyFile = Just "history.txt",
autoAddHistory = True
}
replCompletion :: StateData -> CompletionFunc IO
replCompletion st = completeWordWithPrev Nothing [' '] st (\x y -> return $ completionGenerator x y)
completionGenerator :: String -> String -> StateData -> [Completion]
completionGenerator "" c st =
commandSuggestion c (updatesSuggestions st) -- I wish to update it at run time
completionGenerator p c st = ...
IORef isn’t unsafe; you’re already in IO, so it’s a perfectly reasonable way to add mutable state here.
But if you want to avoid IO, you can simply use StateT StateData IO as the underlying monad for InputT, and thus the completion function in Settings. It seems you’re already trying to use StateT anyway. Here’s a complete example that just adds every entry to a list and autocompletes them naïvely:
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State (StateT, evalStateT, get, modify)
import Data.List (isPrefixOf)
import System.Console.Haskeline
type StateData = [String]
main :: IO ()
main = repl []
repl :: StateData -> IO ()
repl startState
= flip evalStateT startState
$ runInputT replSettings loop
where
loop :: InputT (StateT StateData IO) ()
loop = do
inputL <- getInputLine "> "
case inputL of
Nothing -> pure ()
Just "quit" -> outputStrLn "--Exited--"
Just ipt -> do
-- Just add each entry to the state directly.
lift $ modify (ipt :)
loop
replSettings :: Settings (StateT StateData IO)
replSettings = Settings
{ complete = replCompletion
, historyFile = Just "history.txt"
, autoAddHistory = True
}
replCompletion :: CompletionFunc (StateT StateData IO)
replCompletion = completeWordWithPrev Nothing " " completionGenerator
completionGenerator :: String -> String -> StateT StateData IO [Completion]
completionGenerator prefix suffix = do
st <- get
-- Trivial completion that just ignores the suffix.
pure $ fmap (\ s -> Completion s s True)
$ filter (prefix `isPrefixOf`) st
The completion generator could also be written using MonadState (from mtl) to insulate it from being able to access IO, and other code could likewise use this pure state while being agnostic to IO. But otherwise, since you’re already in IO in this code, StateT StateData IO / get / modify are no different than ReaderT (IORef StateData) IO / readIORef / modifyIORef.
In fact, if you put an IORef in StateData, supposing it’s a more complex record type in your code, the latter is a good way to make some parts of it mutable and others immutable.
data StateData = StateData
{ mutableThing :: !(IORef Thing)
, immutableStuff :: !Stuff
…
}
Related
I want to write a toy program that has an interactive prompt and that can save and display all previous inputs. This is my first attempt, but does not compile (using ghc):
import System.IO
import Control.Monad.State
data ProgramState = ProgramState
{ events :: [Int] } -- Placeholder for now
parse_input :: String -> State ProgramState Bool
parse_input prompt = do
putStr prompt
hFlush stdout
current_state <- get
str <- getLine
case str of
"c" -> do
put (current_state { events = [1,2,3] } ) -- this should become actual appending
return True
"l" -> return True
"q" -> return False
"quit" -> return False
"h" -> return True
_ -> do
putStrLn "Invalid input."
parse_input prompt
main :: IO ()
main = do
should_continue <- parse_input "Enter your command."
if should_continue then main else return ()
main.hs:9:5: error:
• Couldn't match type ‘IO’
with ‘StateT ProgramState Data.Functor.Identity.Identity’
Expected type: StateT
ProgramState Data.Functor.Identity.Identity ()
Actual type: IO ()
Note: line 9 is putStr prompt
The same error is given for lines 10, 12, 22, 27.
I have since thought of doing the recursion purely inside parse_input, in which case I don't seem to need the state monad. But I am still curious why I get the compilation error. Any help is appreciated, I am very new to Haskell.
You seem to be mixing values of type State s a with values of type IO a. In your main action, you call parse_input in a context expecting IO. In parse_input, you call putStr and so on in a context expecting State. That's not going to work!
The usual way to do this kind of thing is to switch from State to StateT, and import Control.Monad.IO.Class. Now, you can use
evalStateT :: StateT s m a -> s -> m a
to "lower" your loop to IO, and
-- liftIO :: IO a -> StateT s IO a
liftIO :: MonadIO m => IO a -> m a
to "lift" the IO actions to StateT within the loop. Now (untested code ahead):
-- Needed for flexible use of
-- the MonadState class.
{-# LANGUAGE FlexibleContexts #-}
import System.IO
-- You almost always want the "strict"
-- version of `StateT`; the lazy one is weird.
import Control.Monad.State.Strict
import Control.Monad.IO.Class
data ProgramState = ProgramState
{ events :: [Int] } -- Placeholder for now
-- Renaming your function to follow convention.
parseInput
:: (MonadState ProgramState m, MonadIO m)
=> String -> m Bool
parseInput prompt = do
str <- liftIO $ do
putStr prompt
hFlush stdout
getLine
current_state <- get
case str of
"c" -> do
put (current_state { events = [1,2,3] } ) -- this should become actual appending
return True
"l" -> return True
"q" -> return False
"quit" -> return False
"h" -> return True
_ -> do
liftIO $ putStrLn "Invalid input."
parseInput prompt
main :: IO ()
main = do
-- You need to supply the initial state; I've just guessed here.
should_continue <- evalStateT (parseInput "Enter your command.") (ProgramState [])
if should_continue then main else return ()
As Daniel Wagner points out, this will not preserve the state from one main run to the next. If that's your intention, you can write
main :: IO ()
main = evalStateT loop (ProgramState [])
where
loop = do
should_continue <- parseInput "Enter your command."
if should_continue then loop else return ()
If you like, you can import Control.Monad and shorten this to
main :: IO ()
main = evalStateT loop (ProgramState [])
where
loop = do
should_continue <- parseInput "Enter your command."
when should_continue loop
Final note: if you want to capture the final state of your loop, use runStateT instead of evalStateT.
EDITED 2015-11-29: see bottom
I'm trying to write an application that has a do-last-action-again button. The command in question can ask for input, and my thought for how to accomplish this was to just rerun the resulting monad with memoized IO.
There are lots of posts on SO with similar questions, but none of the solutions seem to work here.
I lifted the memoIO code from this SO answer, and changed the implementation to run over MonadIO.
-- Memoize an IO function
memoIO :: MonadIO m => m a -> m (m a)
memoIO action = do
ref <- liftIO $ newMVar Nothing
return $ do
x <- maybe action return =<< liftIO (takeMVar ref)
liftIO . putMVar ref $ Just x
return x
I've got a small repro of my app's approach, the only real difference being my app has a big transformer stack instead of just running in IO:
-- Global variable to contain the action we want to repeat
actionToRepeat :: IORef (IO String)
actionToRepeat = unsafePerformIO . newIORef $ return ""
-- Run an action and store it as the action to repeat
repeatable :: IO String -> IO String
repeatable action = do
writeIORef actionToRepeat action
action
-- Run the last action stored by repeatable
doRepeat :: IO String
doRepeat = do
x <- readIORef actionToRepeat
x
The idea being I can store an action with memoized IO in an IORef (via repeatable) when I record what was last done, and then do it again it out with doRepeat.
I test this via:
-- IO function to memoize
getName :: IO String
getName = do
putStr "name> "
getLine
main :: IO ()
main = do
repeatable $ do
memoized <- memoIO getName
name <- memoized
putStr "hello "
putStrLn name
return name
doRepeat
return ()
with expected output:
name> isovector
hello isovector
hello isovector
but actual output:
name> isovector
hello isovector
name> wasnt memoized
hello wasnt memoized
I'm not entirely sure what the issue is, or even how to go about debugging this. Gun to my head, I'd assume lazy evaluation is biting me somewhere, but I can't figure out where.
Thanks in advance!
EDIT 2015-11-29: My intended use case for this is to implement the repeat last change operator in a vim-clone. Each action can perform an arbitrary number of arbitrary IO calls, and I would like it to be able to specify which ones should be memoized (reading a file, probably not. asking the user for input, yes).
the problem is in main you are creating a new memo each time you call the action
you need to move memoized <- memoIO getName up above the action
main :: IO ()
main = do
memoized <- memoIO getName --moved above repeatable $ do
repeatable $ do
--it was here
name <- memoized
putStr "hello "
putStrLn name
return name
doRepeat
return ()
edit: is this acceptable
import Data.IORef
import System.IO.Unsafe
{-# NOINLINE actionToRepeat #-}
actionToRepeat :: IORef (IO String)
actionToRepeat = unsafePerformIO . newIORef $ return ""
type Repeatable a = IO (IO a)
-- Run an action and store the Repeatable part of the action
repeatable :: Repeatable String -> IO String
repeatable action = do
repeatAction <- action
writeIORef actionToRepeat repeatAction
repeatAction
-- Run the last action stored by repeatable
doRepeat :: IO String
doRepeat = do
x <- readIORef actionToRepeat
x
-- everything before (return $ do) is run just once
hello :: Repeatable String
hello = do
putStr "name> "
name <- getLine
return $ do
putStr "hello "
putStrLn name
return name
main :: IO ()
main = do
repeatable hello
doRepeat
return ()
I came up with a solution. It requires wrapping the original monad in a new transformer which records the results of IO and injects them the next time the underlying monad is run.
Posting it here so my answer is complete.
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
import Control.Applicative (Applicative(..))
import Data.Dynamic
import Data.Maybe (fromJust)
import Control.Monad.RWS
-- | A monad transformer adding the ability to record the results
-- of IO actions and later replay them.
newtype ReplayT m a =
ReplayT { runReplayT :: RWST () [Dynamic] [Dynamic] m a }
deriving ( Functor
, Applicative
, Monad
, MonadIO
, MonadState [Dynamic]
, MonadWriter [Dynamic]
, MonadTrans
)
-- | Removes the first element from a list State and returns it.
dequeue :: MonadState [r] m
=> m (Maybe r)
dequeue = do
get >>= \case
[] -> return Nothing
(x:xs) -> do
put xs
return $ Just x
-- | Marks an IO action to be memoized after its first invocation.
sample :: ( MonadIO m
, Typeable r)
=> IO r
-> ReplayT m r
sample action = do
a <- dequeue >>= \case
Just x -> return . fromJust $ fromDynamic x
Nothing -> liftIO action
tell [toDyn a]
return a
-- | Runs an action and records all of its sampled IO. Returns a
-- action which when invoked will use the recorded IO.
record :: Monad m
=> ReplayT m a
-> m (m a)
record action = do
(a, w) <- evalRWST (runReplayT action) () []
return $ do
evalRWST (runReplayT action) () w
return a
1) I need to pass a field constructor parameter to a function. I made some tests but i was unable to do so. Is it possible? Otherwise, is it possible with lens package?
2) Is it possible in a MonadState to modify a field using modify? (I made a few attempts, but without success. For example: modify (second = "x") does not work.
import Control.Monad.State
data Test = Test {first :: Int, second :: String} deriving Show
dataTest = Test {first = 1, second = ""}
test1 = runStateT modif1 dataTest -- OK
test2 = runStateT (modif2 "!") dataTest -- OK
test3 = runStateT (modif3 second) dataTest -- WRONG
-- modif1 :: StateT Test IO ()
modif1 = do
st <- get
r <- lift getLine
put $ st {second = "x" ++ r}
-- modif2 :: String -> StateT Test IO ()
modif2 s = do
stat <- get
r <- lift getLine
put $ stat {second = "x" ++ r ++ s}
-- modif3 :: ???? -> StateT Test IO ()
modif3 fc = do
stat <- get
r <- lift getLine
put $ stat {fc = "x" ++ r}
-- When i try to load the module, this is the result:
-- ghc > Failed:
-- ProvaRecord.hs:33:16:`fc' is not a (visible) constructor field name
As you said, you're probably looking for lenses. A lens is a value that allows to read, set or modify a given field. Usually with Control.Lens, you define fields with underscores and you use makeLenses to create full-featured lenses.
There are many combinators that allow lenses to be used together within MonadState. In your case we can use %=, which in this case would be specialized to type
(MonadState s m) => Lens' s b -> (b -> b) -> m ()
which modifies a state value using a given lens and a function that operates on the inside value.
Your example could be rewritten using lenses as follows:
{-# LANGUAGE TemplateHaskell, RankNTypes #-}
import Control.Lens
import Control.Monad.State
data Test = Test { _first :: Int
, _second :: String
}
deriving Show
-- Generate `first` and `second` lenses.
$(makeLenses ''Test)
-- | An example of a universal function that modifies any lens.
-- It reads a string and appends it to the existing value.
modif :: Lens' a String -> StateT a IO ()
modif l = do
r <- lift getLine
l %= (++ r)
dataTest :: Test
dataTest = Test { _first = 1, _second = "" }
test :: IO Test
test = execStateT (modif second) dataTest
i have the following set of actions:
action1 :: IO Bool
action2 :: IO Bool
action3 :: IO Bool
some actions are just composition of another actions
complexAction = do
action1
action2
action3
What i need is the construction that checks result of each action and returns False in a case of false. I can do it manually but i know for sure that haskell does have tools to get rid of that kind of boilerplate.
The simplest way is
complexAction = fmap and (sequence [action1, action2, action3])
But you could also write your own combinator to stop after the first action:
(>>/) :: Monad m => m Bool -> m Bool -> m Bool
a >>/ b = do
yes <- a
if yes then b else return False
You'd want to declare the fixity to make it associative
infixl 1 >>/
Then you can do
complexAction = action1 >>/ action2 >>/ action3
I'd suggest you to use MaybeT monad transformer instead. Using it has many advantages over just returning IO Bool:
Your actions can have different types and return values (not just true/false). If you don't need any results, just use MaybeT IO ().
Later ones can depend on results of preceding ones.
Since MaybeT produces monads that are instances of MonadPlus, you can use all monad plus operations. Namely mzero for a failed action and x mplus y, which will run y iff x fails.
A slight disadvantage is that you have to lift all IO actions to MaybeT IO. This can be solved by writing your actions as MonadIO m => ... -> m a instead of ... -> IO a.
For example:
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
-- Lift print and putStrLn
print' :: (MonadIO m, Show a) => a -> m ()
print' = liftIO . print
putStrLn' :: (MonadIO m) => String -> m ()
putStrLn' = liftIO . putStrLn
-- Add something to an argument
plus1, plus3 :: Int -> MaybeT IO Int
plus1 n = print' "+1" >> return (n + 1)
plus3 n = print' "+3" >> return (n + 3)
-- Ignore an argument and fail
justFail :: Int -> MaybeT IO a
justFail _ = mzero
-- This action just succeeds with () or fails.
complexAction :: MaybeT IO ()
complexAction = do
i <- plus1 0
justFail i -- or comment this line out <----------------<
j <- plus3 i
print' j
-- You could use this to convert your actions to MaybeT IO:
boolIOToMaybeT :: IO Bool -> MaybeT IO ()
boolIOToMaybeT x = do
r <- lift x
if r then return () else mzero
-- Or you could have even more general version that works with other
-- transformers as well:
boolIOToMaybeT' :: (MonadIO m, MonadPlus m) => IO Bool -> m ()
boolIOToMaybeT' x = do
r <- liftIO x
if r then return () else mzero
main :: IO ()
main = runMaybeT complexAction >>= print'
As Petr says, for anything but a narrow and contained case, you're almost certainly better off wiring your code for proper error handling from the outset. I know I've often regretted not doing this, condemning myself to some very tedious refactoring.
If I may, I'd like to recommend Gabriel Gonzalez's errors package, which imposes a little more coherence on Haskell's various error-handling mechanisms than has been traditional. It allows you to plumb Eithers through your code, and Either is a good type for capturing errors. (By contrast, Maybe will lose information on the error side.) Once you've installed the package, you can write things like this:
module Errors where
import Control.Error
import Data.Traversable (traverse)
data OK = OK Int deriving (Show)
action1, action2, action3 :: IO (Either String OK)
action1 = putStrLn "Running action 1" >> return (Right $ OK 1)
action2 = putStrLn "Running action 2" >> return (Right $ OK 2)
action3 = putStrLn "Running action 3" >> return (Left "Oops on 3")
runStoppingAtFirstError :: [IO (Either String OK)] -> IO (Either String [OK])
runStoppingAtFirstError = runEitherT . traverse EitherT
...with output like
*Errors> runStoppingAtFirstError [action1, action2]
Running action 1
Running action 2
Right [OK 1,OK 2]
*Errors> runStoppingAtFirstError [action1, action3, action2]
Running action 1
Running action 3
Left "Oops on 3"
(But note that the computation here stops at the first error and doesn't soldier on until the bitter end -- which might not be what you had wanted. The errors package is certainly wide-ranging enough that many other variations are possible.)
parseSource :: String -> Either ParserError Mod.Module
parseSource src = do
(imports, rest) <- parseImports (Lex.lexSource src)
bindings <- mapM parseBinding rest
buildModule imports bindings
I need to make the above return an IO (Either ParserError Mod.Module) as the buildModule statement at the end will need to perform some IO functions (reading files). The problem i have is that when i make it an IO function, i can no longer do the bind(wrong term?) <- operations.
What is the simplest way to make this work?
Take a look at defining your problem in terms of ErrorT ParseError IO.
I couldn't find a combinator to lift a pure Either computation into the ErrorT monad, so I wrote one called liftError. I fleshed out your example with dummy types and implementations. The main runs the parser twice, once with input that throws a ParserError, and once which succeeds with an IO side-effect. In order for ErrorT ParserError IO to be a Monad, ParserError must be an instance of Error (so that it is possible to implement fail).
import Control.Monad.Error
type ParserMonad = ErrorT ParserError IO
data ParserError = ParserError1 | ParserError2 | ParserError3
deriving(Show)
data Module = Module
deriving(Show)
data Import = Import
deriving(Show)
data Binding = Binding
deriving(Show)
instance Error ParserError where
noMsg = undefined
-- lift a pure Either into the ErrorT monad
liftError :: Monad m => Either e a -> ErrorT e m a
liftError = ErrorT . return
parseSource :: String -> ParserMonad Module
parseSource src = do
(imports, rest) <- liftError $ parseImports (lexSource src)
bindings <- liftError $ mapM parseBinding rest
buildModule imports bindings
lexSource :: String -> [String]
lexSource = return
parseImports :: [String] -> Either ParserError ([Import], [String])
parseImports toks = do{ when (null toks) $ throwError ParserError1
; return ([Import], toks)
}
parseBinding :: String -> Either ParserError Binding
parseBinding b = do{ when (b == "hello") $ throwError ParserError2
; return Binding
}
buildModule :: [Import] -> [Binding] -> ParserMonad Module
buildModule i b = do{ liftIO $ print "hello"
; when (null b) $ throwError ParserError3
; return Module
}
main = mapM (runErrorT . parseSource) ["hello", "world"]