I'd like to use the Logic monad to ensure that error-throwing code (in a monad stack including ExcepT) backtracks upon throwing an error. Here's a simple example:
newtype FooT m a = FooT { unFooT :: ExceptT String m a }
deriving (Functor, Applicative, Monad, MonadTrans, MonadError String, MonadFail)
foo :: FooT Logic String
foo = do
let validate s = if s == "cf" then return s else throwError "err"
let go = do
first <- msum (map return ['a', 'b', 'c'])
second <- msum (map return ['d', 'e', 'f'])
traceM $ "Guess: " ++ [first, second]
validate [first, second]
go `catchError` const mzero
testfoo :: IO ()
testfoo = do
let r = observe $ runExceptT $ unFooT foo
case r of
Left e -> print $ "Error: " ++ e
Right s -> print $ "Result: " ++
This doesn't backtrack; it produces no results.
I can make it backtrack by lifting the choice operations (ie, use lift (msum ...) instead of the plain msum call there is now).
However, for a variety of reasons I'd like to be able to write code in the ExceptT monad and basically just lift the MonadPlus instance from the Logic monad into the transformed version.
I tried to write a custom MonadPlus instance to accomplish this here:
instance MonadPlus m => MonadPlus (FooT m) where
mzero = lift mzero
mplus (FooT a) (FooT b) = lift $ do
ea <- runExceptT a
case ea of
Left _ -> do
eb <- runExceptT b
case eb of
Left _ -> mzero
Right y -> return y
Right x -> do
eb <- runExceptT b
case eb of
Left _ -> return x
Right y -> return x `mplus` return y
The same code works for the Alternative instance as well. However, this doesn't actually help; it still doesn't backtrack. Is there something wrong with this instance? Is there a better way to solve this problem? Am I trying to do something that doesn't make sense? At the end of the day I can always just lift everything, but would prefer to avoid doing so.
Edit:
Have been messing around some more. My MonadPlus instance above works if I use mplus but does not work if I use msum like I did above...
Use this instance of MonadPlus/Alternative:
instance (Alternative m, Monad m) => Alternative (FooT m) where
empty = FooT (ExceptT empty)
FooT (ExceptT a) <|> FooT (ExceptT b) = FooT (ExceptT (a <|> b))
Note: Alternative and MonadPlus are redundant, so it's simpler to just implement Alternative, and use Data.Foldable.asum instead of msum.
The one you implemented is not too different from the one that's already on ExceptT, and does not really use the Alternative m instance. Make sure to use (<|>) specialized to m to benefit from backtracking.
Related
I'm having trouble figuring out the cleanest way of zooming an effect like StateT that returns a value into an indexed container like a vector or a map.
For example let's say I have some structures for a card game:
data Card = Card
{ cardValue :: Int
} deriving (Show, Eq)
makeFields ''Card
data Player = Player
{ playerCards :: [Card]
} deriving (Show, Eq)
makeFields ''Player
data Game = Game
{ gamePlayers :: M.Map Int Player
} deriving (Show, Eq)
makeFields ''Game
data Action = GiveCard Card | DoNothing
And a function that handles a player's move in a turn with a StateT effect:
playerAction :: (MonadIO m) => StateT Player m Action
playerAction = do
cards' <- use cards
case cards' of
(c:rest) -> GiveCard c <$ (cards .= rest)
_ -> return DoNothing
What I want to do is to index inside a player in the game and apply this StateT to that player. Something that looks like this:
gameAction :: (MonadIO m) => Int -> StateT Game m ()
gameAction i = do
Just action <- zoom (players . at i . mapJust) playerAction
case action of
GiveCard c -> liftIO $ print c
DoNothing -> liftIO $ putStrLn "Doing nothing"
Adding _Just in the traversal or replacing at i with ix i results in this compile error:
• Could not deduce (Monoid Action) arising from a use of ‘_Just’
from the context: MonadIO m
bound by the type signature for:
gameAction :: forall (m :: * -> *).
MonadIO m =>
Int -> StateT Game m ()
at src/MainModule.hs:36:1-52
• In the second argument of ‘(.)’, namely ‘_Just’
In the second argument of ‘(.)’, namely ‘at i . _Just’
In the first argument of ‘zoom’, namely ‘(players . at i . _Just)’
|
38 | action <- zoom (players . at i . _Just) playerAction
| ^^^^^
I could use non with a dummy Player value but if the index doesn't exist then it silently runs the function on the dummy value which is not what I want:
emptyPlayer :: Player
emptyPlayer = Player []
gameAction :: (MonadIO m) => Int -> StateT Game m ()
gameAction i = do
action <- zoom (players . at i . non emptyPlayer) playerAction
case action of
GiveCard c -> liftIO $ print c
DoNothing -> liftIO $ putStrLn "Doing nothing"
I could grab the player out with preuse, modify it and set the modified value. Calling the function that does this is pretty verbose since it has to take in the runMonad function and the getter and setter lenses.
prezoom run get set m = do
maybeS <- preuse get
case maybeS of
Just s -> do
(r, s') <- lift $ run m s
set .= s'
return $ Just r
Nothing -> return Nothing
gameAction :: (MonadIO m) => Int -> StateT Game m ()
gameAction i = do
Just action <- prezoom runStateT (players . ix i) (players . ix i) playerAction
case action of
GiveCard c -> liftIO $ print c
DoNothing -> liftIO $ putStrLn "Doing nothing"
I don't really like the above ways of zooming into an indexed container. Is there an easier and cleaner way to do this?
It sounds like you have a handle on what the underlying semantic issue is, but let me restate it for clarity.
at i is a Lens into a container which returns a Maybe, because the item may be missing from the container (perhaps the index is beyond the end of the list). Composing such a Lens with a Prism like _Just turns the whole thing into a Traversal:
players . at i . _Just :: Traversal' Game Player
Now, zoom does work with Traversals, but it needs a Monoid for the return value of the stateful action. From the docs:
When applied to a Traversal' over multiple values, the actions for each target are executed sequentially and the results are aggregated.
A Traversal may return zero-or-many results, so zoom will execute the monadic action zero-or-many times, filling in mempty as a default value and combining multiple results with mappend. The docs also feature the following specialised type signature for zoom, which demonstrates the Monoid constraint:
zoom :: (Monad m, Monoid c) => Traversal' s t -> StateT t m c -> StateT s m c
That’s why your error message says “Could not deduce (Monoid Action)”: playerAction returns an Action and zoom needs a Monoid for Action because you handed it a Traversal.
So the fix is to pick a Monoid to return from the stateful action. We know that the Traversal will either hit one or zero targets - at i never returns multiple results - so the correct semantics for the Monoid we’re looking for are “first-result-or-failure”. That Monoid is First. (We don’t need to worry about throwing away extra results because there won’t be any.)
action <- getFirst <$> zoom (players . at i . _Just) (fmap (First . Just) playerAction)
-- here action :: Maybe Action
(I’m on my phone so I haven’t tested this code!) You might be able to clean this up a bit using ala.
What do you want it to do? Crash? zoom (players . singular (ix i)) will do that.
I've looked at the some instances of MonadTrans, for MaybeT the implementation looks like this:
instance MonadTrans MaybeT where
lift = MaybeT . liftM Just
As I understand the instance for MonadIO is used to do a variable number of lifts from the inner most, a IO monad, directly to the outermost. For the MaybeT case it looks like this:
instance (MonadIO m) => MonadIO (MaybeT m) where
liftIO = lift . liftIO
What I don't understand is how this recursive function escapes the infinite loop. What is the base case?
Perhaps surprisingly, the definition below is not recursive, even if it looks such.
instance (MonadIO m) => MonadIO (MaybeT m) where
liftIO = lift . liftIO
This is because the liftIO on the left hand side is the liftIO for the MaybeT m monad, while the liftIO on the right hand side is the liftIO for the m monad.
Hence, this simply defines liftIO in one monad in terms of the liftIO for another monad. No recursion here.
This is similar to e.g.
instance (Show a, Show b) => Show (a,b) where
show (x,y) = "(" ++ show x ++ ", " ++ show y ++ ")"
Above, we define how to print a pair depending on how to print their components. It looks recursive, but it is not really such.
It could help visualizing this by inserting explicit type arguments, at least mentally:
-- pseudo-code
instance (Show a, Show b) => Show (a,b) where
show #(a,b) (x,y) =
"(" ++ show #a x ++ ", " ++ show #b y ++ ")"
Now show #(a,b), show #a, and show #b are distinct functions.
Simple equational reasoning and rewriting definitions for some specialization can help you. Base case for MonadIO is IO. MaybeT is monad transformer, so lets combine MaybeT and IO in some simple example.
foo :: MaybeT IO String
foo = liftIO getLine
Now let's rewrite this function definition applying instance implementations from your question step by step.
foo
= liftIO {- for MaybeT -} getLine
= lift (liftIO {- for IO here -} getLine) -- step 2
= lift (id getLine)
= lift getLine
= MaybeT (liftM Just getLine)
getLine has type IO String
liftM Just getLine has type IO (Maybe String)
MaybeT m a constructor needs value of type m (Maybe a) where m = IO and a = String in our case.
Probably hardest step to analyze is step 2. But in reality it's very easy if you remind yourself types of liftIO :: IO a -> m a and lift :: Monad m => m a -> t m a. So all work is done by type inference.
I'm working through the Brent Yorgey Haskell course, and I'm having trouble defining a good instance for Applicative. A parser is defined as follows:
newtype Parser a = Parser { runParser :: String -> Maybe (a, String) }
The function takes a string, parses a certain amount of input, and returns a Maybe tuple where the first value is the type of the parser, and the rest is the unparsed remainder of the string. For example, this is a parser for positive integers:
posInt :: Parser Integer
posInt = Parser f
where
f xs
| null ns = Nothing
| otherwise = Just (read ns, rest)
where (ns, rest) = span isDigit xs
The assignment is to make an Applicative instance for Parser. We start with a Functor instance (which is relatively straight-forward, I think):
first :: (a -> b) -> (a,c) -> (b,c)
first f (a, c) = (f a, c)
instance Functor Parser where
fmap f p = Parser f'
where f' s = fmap (first f) $ (runParser p) s
And then I tried my hand with Applicative:
collapse (Just (Just a)) = Just a
collapse _ = Nothing
extract (Just a, Just b) = Just (a,b)
extract _ = Nothing
appliedFunc :: Parser (a->b) -> Parser a -> String -> Maybe (b, String)
appliedFunc p1 p2 str = extract (f <*> fmap fst result2, fmap snd result2)
where result1 = (runParser p1) str
f = fmap fst result1
result2 = collapse $ fmap (runParser p2) $ fmap snd result1
instance Applicative Parser where
pure a = Parser (\s -> Just (a, s))
p1 <*> p2 = Parser (appliedFunc p1 p2)
...yuck. So my question is, how can I make my Applicative instance cleaner and less difficult to read? I feel like there's an easy answer for this question, but I haven't been able to wrap my head around the types just yet.
I assume you haven't got to Monads in the course yet. The way you are using collapse and fmap indicate to me that you are essentially reinventing Monads to solve this problem, and in particular the Monad Maybe instance. In fact your collapse is the same as join for this monad. And indeed using that is a very elegant way to solve this problem, but perhaps somewhat "cheating" at this point. The following is the best shape I could get it into while using your functions:
appliedFunc p1 p2 str = collapse $ fmap step1 (runParser p1 str)
where
step1 (f, str2) = collapse $ fmap step2 (runParser p2 str2)
where
step2 (x, str3) = Just (f x, str3)
Once you get to Monads proper, you should be able to rewrite this with the even more succinct (>>=) operator and/or do notation.
Another alternative which is almost as simple, but doesn't require reinventing monads, is to use explicit pattern matching of the Maybes. Then you can get something like:
appliedFunc p1 p2 str = case runParser p1 str of
Nothing -> Nothing
Just (f, str2) -> case runParser p2 str2 of
Nothing -> Nothing
Just (x, str3) -> Just (f x, str3)
This is probably not what you want, but I wanted to mention in passing that there is a really succinct way to implement this:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import Control.Applicative
import Control.Monad.Trans.State
newtype Parser a = Parser { unParser :: StateT String Maybe a }
deriving (Functor, Applicative, Monad, Alternative)
runParser :: Parser a -> String -> Maybe (a, String)
runParser = runStateT . unParser
parser :: (String -> Maybe (a, String)) -> Parser a
parser = Parser . StateT
The reason this works is that under the hood StateT is implemented as:
newtype StateT s m a = StateT { runStateT :: s -> m (a, s) }
If you specialize s to String and specialize m to Maybe, you get:
StateT String Maybe a ~ String -> Maybe (a, String)
... which is the same as your type.
StateT has the following instances provided automatically for you:
instance Monad m => Functor (StateT s m)
instance Monad m => Applicative (StateT s m)
instance Monad m => Monad (StateT s m)
instance Alternative m => Alternative (StateT s m)
... and we can specialize m in those instances to Maybe because Maybe implements both Alternative and Monad:
instance Monad Maybe
instance Alternative Maybe
... so that means that StateT s Maybe is automatically a Functor, Applicative, Monad and Alternative without any additional work on our part.
The last part of the trick is GeneralizedNewtypeDeriving, which lets us lift type class instances through a newtype wrapper. Since our underlying StateT type is a Functor, Applicative, Monad, and Alternative, we can automatically lift all four type class instances through our newtype by adding:
... deriving (Functor, Applicative, Monad, Alternative)
... and the compiler will reimplement them for our newtype, taking care to do all the newtype wrapping and unwrapping for us.
So if you want to figure out how to implement Applicative for your parser, you may want to study how Applicative is implemented for StateT and then deduce from that how to implement it for your parser type.
The problem is this. I have:
f :: MonadIO m => ReaderT FooBar m Answer;
f = (liftIO getArgs) >>= ...
I need to run this with modified arguments. However, since m is unknown, I cannot simply use
mapReaderT (withArgs args) :: ReaderT r IO b -> ReaderT r IO b
since I need somehow to transform (withArgs args) into m for all m.
One possibility I found is to define my own withArgs, thus:
import System.Environment (setArgs, freeArgv);
withArgv new_args act = do {
pName <- liftIO System.Environment.getProgName;
existing_args <- liftIO System.Environment.getArgs;
bracket (liftIO $ setArgs new_args)
(\argv -> do {
_ <- liftIO $ setArgs (pName:existing_args);
liftIO $ freeArgv argv;
})
(const act);
};
withArgs xs act = do {
p <- liftIO System.Environment.getProgName;
withArgv (p:xs) act;
};
However, this is a kludge, and specific to one function -- I would need to re-write every withX :: X -> IO a -> IO a, e.g. Control.Exception.handle
What, if any, is a better way to do this?
Edit: In the case of handle, I found Control.Monad.CatchIO. In the other case, I used yet another, briefer kludge (not worth posting) to avoid the kludge above. Still seeking a better solution!
Part of what you are looking for is a hoisting of a monad homomorphism into a monad transformer.
class MonadHoist t where
hoist :: (Monad m, Monad n) => (forall a. m a -> n a) -> t m a -> t n a
t :: Monad m => t Identity a -> t m a
t = hoist (return . runIdentity)
That is to say, given a monad homomorphism f from m to n, you can obtain a monad homomorphism from t m to t n using hoist.
A monad homomorphism is slightly stronger than the types above enforce, namely it is responsible for preserving the monad laws.
f . return = return
f . fmap g = fmap g . f
f . join = join . f . fmap f
= join . fmap f . f -- by the second law
= (>>= f) . f -- >>= in terms of join
Notice the quantifier that I snuck in the type of hoist, MonadHoist turns out to need that flexibility for almost all instances! (Reader happens to be the one case where it doesn't. Try to write MaybeT without it.)
Monad transformers can, in general, instantiate this class. For instance:
instance MonadHoist (StateT s) where
hoist f (StateT m) = StateT (f . m)
instance MonadHoist (ReaderT e) where
hoist f (ReaderT m) = ReaderT (f . m)
instance MonadHoist MaybeT where
hoist f (MaybeT m) = MaybeT (f m)
We don't currently provide it in transformers or mtl package because it would require a Rank2Type, but it is pretty straightforward to implement.
If there is enough demand for it, I'll happily package it up in a monad-extras package.
Now, I said part, because while this answers the question given by the type in the topic of your post, it doesn't address the need reflected by the bulk of the text associated with your question!
For that, you probably want to follow luqui's advice. =)
The monad-control package will do this. I think you want the function liftIOOp_ from Control.Monad.IO.Control.
Specifically,
liftIOOp_ (withArgs newArgs) f
should do what you want. You can lift things like bracket too, with the liftIOOp function.
I believe the interleavableIO package addresses this problem. It is discussed in this cafe thread.
It seems you can use runReaderT to get the effect you want, as well:
*> :t withArgs [] (runReaderT f FooBar)
withArgs [] (runReaderT f FooBar) :: IO Answer
where FooBar is some data constructor and f is defined as above.
Particularly, I need to be able to combine the CGI monad with the IO monad, but an example of how to combine the IO monad with the Maybe monad might be even better...
I assume you want to use the Maybe monad for early termination (like break or return in C).
In that case you should use MaybeT from the MaybeT package (cabal install MaybeT).
main = do
runMaybeT . forever $ do
liftIO $ putStrLn "I won't stop until you type pretty please"
line <- liftIO getLine
when ("pretty please" == line) mzero
return ()
MaybeT is a monad transformer version of the maybe monad.
Monad transformers "add functionality" to other monads.
You don't exactly say how you want to combine IO and Maybe, but I assume you have many functions that return IO (Maybe a) that you want to combine easily. Basically you want to treat IO (Maybe a) as a separate type with it's own Monad instance:
newtype IOMaybe a = IOM (IO (Maybe a))
-- "unpack" a value of the new type
runIOMaybe :: IOMaybe a -> IO (Maybe a)
runIOMaybe (IOM a) = a
instance Monad IOMaybe where
-- bind operator
(IOM ioa) >>= f = IOM $ do
a <- ioa
case a of
Nothing -> return Nothing
Just v -> runIOMaybe (f v)
-- return
return a = IOM (return (Just a))
-- maybe also some convenience functions
returnIO :: IO a -> IOMaybe a
returnIO ioa = IOM $ do
v <- ioa
return (Just v)
returnMaybe :: Maybe a -> IOMaybe a
returnMaybe ma = IOM (return ma)
With this you can use the do-Notation to combine functions that return IO (Maybe a), IO a or Maybe a:
f1 :: Int -> IO (Maybe Int)
f1 0 = return Nothing
f1 a = return (Just a)
main = runIOMaybe $ do
returnIO $ putStrLn "Hello"
a <- returnMaybe $ Just 2
IOM $ f1 a
return ()
Generally something that combines and modifies monads like this is called a monad transformer, and GHC comes with a package that includes monad transformers for common cases. If there is something in this monad transformer library that fits your scenario depends on how exactly you want to combine Maybe and IO.
In what sense do you want to combine the monads?
f :: Int -> IO (Maybe Int)
f x = do
putStrLn "Hello world!"
return $ if x == 0 then Nothing else Just x
Can be evaluated to:
[1 of 1] Compiling Main ( maybe-io.hs, interpreted )
Ok, modules loaded: Main.
*Main> f 0
Hello world!
Nothing
*Main> f 3
Hello world!
Just 3