Haskell: Trapped in IO monad - haskell

I am trying to parse a file using the parseFile function found in the the haskell-src-exts package.
I am trying to work with the output of parseFile which is of course IO, but I can't figure out how to get around the IO. I found a function liftIO but I am not sure if that is the solution in this situation. Here is the code below.
import Language.Haskell.Exts.Syntax
import Language.Haskell.Exts
import Data.Map hiding (foldr, map)
import Control.Monad.Trans
increment :: Ord a => a -> Map a Int -> Map a Int
increment a = insertWith (+) a 1
fromName :: Name -> String
fromName (Ident s) = s
fromName (Symbol st) = st
fromQName :: QName -> String
fromQName (Qual _ fn) = fromName fn
fromQName (UnQual n) = fromName n
fromLiteral :: Literal -> String
fromLiteral (Int int) = show int
fromQOp :: QOp -> String
fromQOp (QVarOp qn) = fromQName qn
vars :: Exp -> Map String Int
vars (List (x:xs)) = vars x
vars (Lambda _ _ e1) = vars e1
vars (EnumFrom e1) = vars e1
vars (App e1 e2) = unionWith (+) (vars e1) (vars e2)
vars (Let _ e1) = vars e1
vars (NegApp e1) = vars e1
vars (Var qn) = increment (fromQName qn) empty
vars (Lit l) = increment (fromLiteral l) empty
vars (Paren e1) = vars e1
vars (InfixApp exp1 qop exp2) =
increment (fromQOp qop) $
unionWith (+) (vars exp1) (vars exp2)
match :: [Match] -> Map String Int
match rhss = foldr (unionWith (+) ) empty
(map (\(Match a b c d e f) -> rHs e) rhss)
rHS :: GuardedRhs -> Map String Int
rHS (GuardedRhs _ _ e1) = vars e1
rHs':: [GuardedRhs] -> Map String Int
rHs' gr = foldr (unionWith (+)) empty
(map (\(GuardedRhs a b c) -> vars c) gr)
rHs :: Rhs -> Map String Int
rHs (GuardedRhss gr) = rHs' gr
rHs (UnGuardedRhs e1) = vars e1
decl :: [Decl] -> Map String Int
decl decls = foldr (unionWith (+) ) empty
(map fun decls )
where fun (FunBind f) = match f
fun _ = empty
pMod' :: (ParseResult Module) -> Map String Int
pMod' (ParseOk (Module _ _ _ _ _ _ dEcl)) = decl dEcl
pMod :: FilePath -> Map String Int
pMod = pMod' . liftIO . parseFile
I just want to be able to use the pMod' function on the output of parseFile.
Note that all the types and data constructors can be found at http://hackage.haskell.org/packages/archive/haskell-src-exts/1.13.5/doc/html/Language-Haskell-Exts-Syntax.html if that helps. Thanks in advance!

Once inside IO, there's no escape.
Use fmap:
-- parseFile :: FilePath -> IO (ParseResult Module)
-- pMod' :: (ParseResult Module) -> Map String Int
-- fmap :: Functor f => (a -> b) -> f a -> f b
-- fmap pMod' (parseFile filePath) :: IO (Map String Int)
pMod :: FilePath -> IO (Map String Int)
pMod = fmap pMod' . parseFile
(addition:) As explained in great answer by Levi Pearson, there's also
Prelude Control.Monad> :t liftM
liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r
But that's no black magic either. Consider:
Prelude Control.Monad> let g f = (>>= return . f)
Prelude Control.Monad> :t g
g :: (Monad m) => (a -> b) -> m a -> m b
So your function can also be written as
pMod fpath = fmap pMod' . parseFile $ fpath
= liftM pMod' . parseFile $ fpath
= (>>= return . pMod') . parseFile $ fpath -- pushing it...
= parseFile fpath >>= return . pMod' -- that's better
pMod :: FilePath -> IO (Map String Int)
pMod fpath = do
resMod <- parseFile fpath
return $ pMod' resMod
whatever you find more intuitive (remember, (.) has the highest precedence, just below the function application).
Incidentally, the >>= return . f bit is how liftM is actually implemented, only in do-notation; and it really shows the equivalency of fmap and liftM, because for any monad it should hold that:
fmap f m == m >>= (return . f)

To give a more general answer than Will's (which was certainly correct and to-the-point), you typically 'lift' operations into a Monad rather than taking values out of them in order to apply pure functions to monadic values.
It so happens that Monads (theoretically) are a specific kind of Functor. Functor describes the class of types that represent mappings of objects and operations into a different context. A data type that is an instance of Functor maps objects into its context via its data constructors and it maps operations into its context via the fmap function. To implement a true functor, fmap must work in such a way that lifting the identity function into the functor context does not change the values in the functor context, and lifting two functions composed together produces the same operation within the functor context as lifting the functions separately and then composing them within the functor context.
Many, many Haskell data types naturally form functors, and fmap provides a universal interface to lift functions so that they apply 'evenly' throughout the functorized data without worrying about the form of the particular Functor instance. A couple of great examples of this are the list type and the Maybe type; fmap of a function into a list context is exactly the same as the familiar map operation on lists, and fmap of a function into a Maybe context will apply the function normally for a Just a value and do nothing for a Nothing value, allowing you to perform operations on it without worrying about which it is.
Having said all that, by a quirk of history the Haskell Prelude doesn't currently require Monad instances to also have a Functor instance, so Monad provides a family of functions that also lift operations into monadic contexts. The operation liftM does the same thing that fmap does for Monad instances that are also Functor instances (as they should be). But fmap and liftM only lift single-argument functions. Monad helpfully provides a family of liftM2 -- liftM5 functions that lift multi-argument functions into monadic context in the same way.
Finally, you asked about liftIO, which brings in the related idea of monad transformers, in which multiple Monad instances are combined in a single data type by applying monad mappings to already-monadic values, forming a kind of stack of monadic mappings over a basic pure type. The mtl library provides one implementation of this general idea, and in its module Control.Monad.Trans it defines two classes, MonadTrans t and Monad m => MonadIO m. The MonadTrans class provides a single function, lift, that gives access to operations in the next higher monadic "layer" in the stack, i.e. (MonadTrans t, Monad m) => m a -> t m a. The MonadIO class provides a single function, liftIO, that provides access to IO monad operations from any "layer" in the stack, i.e. IO a -> m a. These make working with monad transformer stacks much more convenient at the cost of having to provide a lot of transformer instance declarations when new Monad instances are introduced to a stack.

Related

Define a new monad in Haskell?

I would like to create my own monad in Haskell, and have Haskell treat it just like any other built in monad. For instance, here is code for creating a monad that updates some global state variable each time it is called, along with an evaluator that uses it to compute the number of times the quot function is called:
-- define the monad type
type M a = State -> (a, State)
type State = Int
-- define the return and bind operators for this monad
return a x = (a, x)
(>>=) :: M a -> (a -> M b) -> M b
m >>= k = \x -> let (a,y) = m x in
let (b,z) = k a y in
(b,z)
-- define the tick monad, which increments the state by one
tick :: M ()
tick x = ((), x+1)
data Term = Con Int | Div Term Term
-- define the evaluator that computes the number of times 'quot' is called as a side effect
eval :: Term -> M Int
eval (Con a) = Main.return a
eval (Div t u) = eval t Main.>>= \a -> eval u Main.>>= \b -> (tick Main.>>= \()->Main.return(quot a b))
answer :: Term
answer = (Div (Div (Con 1972)(Con 2))(Con 23))
(result, state) = eval answer 0
main = putStrLn ((show result) ++ ", " ++ (show state))
As implemented now, return and >>= belong in the namespace Main, and I have to distinguish them from Prelude.return and Prelude.>>=. If I wanted Haskell to treat M like any other type of monad, and properly overload the monad operators in Prelude, how would I go about that?
To make your new monad work with all the existing Haskell machinery--do notation, for instance--all you need to do is declare your type an instance of the Monad typeclass. Then the Prelude functions >>=, return, etc. will work with your new type just as they do with all other Monad types.
There's a limitation, though, that will require some changes in your examples. Type synonyms (declared with type) cannot be made class instances. (Your M a is exactly the same as Int -> (a, Int).) You'll need to use data or newtype instead. (The distinction between those two is not relevant here.)
Both of those keywords create a genuinely new type; in particular, they create a new data constructor. You should read up on this in any fundamental Haskell text. Briefly, newtype X a = Y (...) creates a new type X a; you can create values of that type using the constructor Y (which can, and often does, have the same name as the type constructor X); and you can consume values by pattern matching on Y. If you choose not to export the data constructor Y, only functions in your module will be able to manipulate the values directly.
(There's a GHC extension TypeSynonymInstances but it won't help you here, because of a separate issue: type synonyms cannot be partially applied; for any type X a = {- ... -} you can only write X a or X Int or whatnot, never just X. You can't write instance Monad M because M is partially applied.)
After that, all you need to do is move your definitions of return and >>= into an instance Monad declaration:
newtype M a = M (State -> (a, State))
instance Monad M where
return a = M $ \x -> (a, x)
m >>= k = {- ... -}
Note that the implementation of (>>=) is slightly verbose because you need to unwrap and rewrap the newtype using its data constructor M. Look at the implementation of StateT in transformers, which uses a record accessor to make it easier. (You can manually write a function runM :: M -> State -> (a, State) equivalent to the record syntax that transformers and many other packages use.)
Here is an implementation:
-- Otherwise you can't do the Applicative instance.
import Control.Applicative
-- Simple function
foo :: String -> String
foo x = do
x ++ "!!!"
-- Helper for printing Monads
print2 :: (Show a) => MyBox a -> IO()
print2 (MyBox x) = print x
-- Custom type declaration
data MyBox a = MyBox a
-- MyBox functor
instance Functor MyBox where
fmap f (MyBox x) = MyBox (f x)
-- MyBox Applicative
instance Applicative MyBox where
pure = MyBox
(MyBox f) <*> x = f <$> x
-- MyBox Monad
instance Monad MyBox where
return x = MyBox x
MyBox x >>= f = f x
-- (MyBox as a functor) Use a function with a wrapped value
result1 = foo <$> (MyBox "Brian")
-- (MyBox as an Applicative) Use a wrapped function with a wrapped value
result2 = (MyBox foo) <*> (MyBox "Erich")
-- (MyBox as a Monad) Use a wrapped value with a lambda (it can be chainable)
myLambda1 = (\ x -> MyBox (x ++ " aaa"))
myLambda2 = (\ x -> MyBox (x ++ " bbb"))
myLambda3 = (\ x -> MyBox (x ++ " ccc"))
result3 = (MyBox "Rick")
>>= myLambda1
>>= myLambda2
>>= myLambda3
-- Another Monad syntax
result4 = do
x <- MyBox "A"
y <- MyBox "B"
z <- MyBox "C"
MyBox (x ++ y ++ z)
main = do
print2(result1) -- "Brian!!!"
print2(result2) -- "Erich!!!"
print2(result3) -- "Rick aaa bbb ccc"
print2(result4) -- "ABC"

Better Applicative instance for Parser (Haskell)

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.

Can I make a Lens with a Monad constraint?

Context: This question is specifically in reference to Control.Lens (version 3.9.1 at the time of this writing)
I've been using the lens library and it is very nice to be able to read and write to a piece (or pieces for traversals) of a structure. I then had a though about whether a lens could be used against an external database. Of course, I would then need to execute in the IO Monad. So to generalize:
Question:
Given a getter, (s -> m a) and an setter (b -> s -> m t) where m is a Monad, is possible to construct Lens s t a b where the Functor of the lens is now contained to also be a Monad? Would it still be possible to compose these with (.) with other "purely functional" lenses?
Example:
Could I make Lens (MVar a) (MVar b) a b using readMVar and withMVar?
Alternative:
Is there an equivalent to Control.Lens for containers in the IO monad such as MVar or IORef (or STDIN)?
I've been thinking about this idea for some time, which I'd call mutable lenses. So far, I haven't made it into a package, let me know, if you'd benefit from it.
First let's recall the generalized van Laarhoven Lenses (after some imports we'll need later):
{-# LANGUAGE RankNTypes #-}
import qualified Data.ByteString as BS
import Data.Functor.Constant
import Data.Functor.Identity
import Data.Traversable (Traversable)
import qualified Data.Traversable as T
import Control.Monad
import Control.Monad.STM
import Control.Concurrent.STM.TVar
type Lens s t a b = forall f . (Functor f) => (a -> f b) -> (s -> f t)
type Lens' s a = Lens s s a a
we can create such a lens from a "getter" and a "setter" as
mkLens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
mkLens g s f x = fmap (s x) (f (g x))
and get a "getter"/"setter" from a lens back as
get :: Lens s t a b -> (s -> a)
get l = getConstant . l Constant
set :: Lens s t a b -> (s -> b -> t)
set l x v = runIdentity $ l (const $ Identity v) x
as an example, the following lens accesses the first element of a pair:
_1 :: Lens' (a, b) a
_1 = mkLens fst (\(x, y) x' -> (x', y))
-- or directly: _1 f (a,c) = (\b -> (b,c)) `fmap` f a
Now how a mutable lens should work? Getting some container's content involves a monadic action. And setting a value doesn't change the container, it remains the same, just as a mutable piece of memory does. So the result of a mutable lens will have to be monadic, and instead of the return type container t we'll have just (). Moreover, the Functor constraint isn't enough, since we need to interleave it with monadic computations. Therefore, we'll need Traversable:
type MutableLensM m s a b
= forall f . (Traversable f) => (a -> f b) -> (s -> m (f ()))
type MutableLensM' m s a
= MutableLensM m s a a
(Traversable is to monadic computations what Functor is to pure computations).
Again, we create helper functions
mkLensM :: (Monad m) => (s -> m a) -> (s -> b -> m ())
-> MutableLensM m s a b
mkLensM g s f x = g x >>= T.mapM (s x) . f
mget :: (Monad m) => MutableLensM m s a b -> s -> m a
mget l s = liftM getConstant $ l Constant s
mset :: (Monad m) => MutableLensM m s a b -> s -> b -> m ()
mset l s v = liftM runIdentity $ l (const $ Identity v) s
As an example, let's create a mutable lens from a TVar within STM:
alterTVar :: MutableLensM' STM (TVar a) a
alterTVar = mkLensM readTVar writeTVar
These lenses are one-sidedly directly composable with Lens, for example
alterTVar . _1 :: MutableLensM' STM (TVar (a, b)) a
Notes:
Mutable lenses could be made more powerful if we allow that the modifying function to include effects:
type MutableLensM2 m s a b
= (Traversable f) => (a -> m (f b)) -> (s -> m (f ()))
type MutableLensM2' m s a
= MutableLensM2 m s a a
mkLensM2 :: (Monad m) => (s -> m a) -> (s -> b -> m ())
-> MutableLensM2 m s a b
mkLensM2 g s f x = g x >>= f >>= T.mapM (s x)
However, it has two major drawbacks:
It isn't composable with pure Lens.
Since the inner action is arbitrary, it allows you to shoot yourself in the foot by mutating this (or other) lens during the mutating operation itself.
There are other possibilities for monadic lenses. For example, we can create a monadic copy-on-write lens that preserves the original container (just as Lens does), but where the operation involves some monadic action:
type LensCOW m s t a b
= forall f . (Traversable f) => (a -> f b) -> (s -> m (f t))
I've made jLens - a Java library for mutable lenses, but the API is of course far from being as nice as Haskell lenses.
No, you can not constrain the "Functor of the lens" to also be a Monad. The type for a Lens requires that it be compatible with all Functors:
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
This reads in English something like: A Lens is a function, which, for all types f where f is a Functor, takes an (a -> f b) and returns an s -> f t. The key part of that is that it must provide such a function for every Functor f, not just some subset of them that happen to be Monads.
Edit:
You could make a Lens (MVar a) (MVar b) a b, since none of s t a, or b are constrained. What would the types on the getter and setter needed to construct it be then? The type of the getter would be (MVar a -> a), which I believe could only be implemented as \_ -> undefined, since there's nothing that extracts the value from an MVar except as IO a. The setter would be (MVar a -> b -> MVar b), which we also can't define since there's nothing that makes an MVar except as IO (MVar b).
This suggests that instead we could instead make the type Lens (MVar a) (IO (MVar b)) (IO a) b. This would be an interesting avenue to pursue further with some actual code and a compiler, which I don't have right now. To combine that with other "purely functional" lenses, we'd probably want some sort of lift to lift the lens into a monad, something like liftLM :: (Monad m) => Lens s t a b -> Lens s (m t) (m a) b.
Code that compiles (2nd edit):
In order to be able to use the Lens s t a b as a Getter s a we must have s ~ t and a ~ b. This limits our type of useful lenses lifted over some Monad to the widest type for s and t and the widest type for a and b. If we substitute b ~ a into out possible type we would have Lens (MVar a) (IO (MVar a)) (IO a) a, but we still need MVar a ~ IO (MVar a) and IO a ~ a. We take the wides of each of these types, and choose Lens (IO (MVar a)) (IO (MVar a)) (IO a) (IO a), which Control.Lens.Lens lets us write as Lens' (IO (MVar a)) (IO a). Following this line of reasoning, we can make a complete system for combining "purely functional" lenses with lenses on monadic values. The operation to lift a "purely function" lens, liftLensM, then has the type (Monad m) => Lens' s a -> LensF' m s a, where LensF' f s a ~ Lens' (f s) (f a).
{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
module Main (
main
) where
import Control.Lens
import Control.Concurrent.MVar
main = do
-- Using MVar
putStrLn "Ordinary MVar"
var <- newMVar 1
output var
swapMVar var 2
output var
-- Using mvarLens
putStrLn ""
putStrLn "MVar accessed through a LensF' IO"
value <- (return var) ^. mvarLens
putStrLn $ show value
set mvarLens (return 3) (return var)
output var
-- Debugging lens
putStrLn ""
putStrLn "MVar accessed through a LensF' IO that also debugs"
value <- readM (debug mvarLens) var
putStrLn $ show value
setM (debug mvarLens) 4 var
output var
-- Debugging crazy box lens
putStrLn ""
putStrLn "MVar accessed through a LensF' IO that also debugs through a Box that's been lifted to LensF' IO that also debugs"
value <- readM ((debug mvarLens) . (debug (liftLensM boxLens))) var
putStrLn $ show value
setM ((debug mvarLens) . (debug (liftLensM boxLens))) (Box 5) var
output var
where
output = \v -> (readMVar v) >>= (putStrLn . show)
-- Types to write higher lenses easily
type LensF f s t a b = Lens (f s) (f t) (f a) (f b)
type LensF' f s a = Lens' (f s) (f a)
type GetterF f s a = Getter (f s) (f a)
type SetterF f s t a b = Setter (f s) (f t) (f a) (f b)
-- Lenses for MVars
setMVar :: IO (MVar a) -> IO a -> IO (MVar a)
setMVar ioVar ioValue = do
var <- ioVar
value <- ioValue
swapMVar var value
return var
getMVar :: IO (MVar a) -> IO a
getMVar ioVar = do
var <- ioVar
readMVar var
-- (flip (>>=)) readMVar
mvarLens :: LensF' IO (MVar a) a
mvarLens = lens getMVar setMVar
-- Lift a Lens' to a Lens' on monadic values
liftLensM :: (Monad m) => Lens' s a -> LensF' m s a
liftLensM pureLens = lens getM setM
where
getM mS = do
s <- mS
return (s^.pureLens)
setM mS mValue = do
s <- mS
value <- mValue
return (set pureLens value s)
-- Output when a Lens' is used in IO
debug :: (Show a) => LensF' IO s a -> LensF' IO s a
debug l = lens debugGet debugSet
where
debugGet ioS = do
value <- ioS^.l
putStrLn $ show $ "Getting " ++ (show value)
return value
debugSet ioS ioValue = do
value <- ioValue
putStrLn $ show $ "Setting " ++ (show value)
set l (return value) ioS
-- Easier way to use lenses in a monad (if you don't like writing return for each argument)
readM :: (Monad m) => GetterF m s a -> s -> m a
readM l s = (return s) ^. l
setM :: (Monad m) => SetterF m s t a b -> b -> s -> m t
setM l b s = set l (return b) (return s)
-- Another example lens
newtype Boxed a = Box {
unBox :: a
} deriving Show
boxLens :: Lens' a (Boxed a)
boxLens = lens Box (\_ -> unBox)
This code produces the following output:
Ordinary MVar
1
2
MVar accessed through a LensF' IO
2
3
MVar accessed through a LensF' IO that also debugs
"Getting 3"
3
"Setting 4"
4
MVar accessed through a LensF' IO that also debugs through a Box that's been lifted to LensF' IO that also debugs
"Getting 4"
"Getting Box {unBox = 4}"
Box {unBox = 4}
"Setting Box {unBox = 5}"
"Getting 4"
"Setting 5"
5
There's probably a better way to write liftLensM without resorting to using lens, (^.), set and do notation. Something seems wrong about building lenses by extracting the getter and setter and calling lens on a new getter and setter.
I wasn't able to figure out how to reuse a lens as both a getter and a setter. readM (debug mvarLens) and setM (debug mvarLens) both work just fine, but any construct like 'let debugMVarLens = debug mvarLens' loses either the fact it works as a Getter, the fact it works as a Setter, or the knowledge that Int is an instance of show so it can me used for debug. I'd love to see a better way of writing this part.
I had the same problem. I tried the methods in Petr and Cirdec's answers but never got to the point I wanted to. Started working on the problem, and at the end, I published the references library on hackage with a generalization of lenses.
I followed the idea of the yall library to parameterize the references with monad types. As a result there is an mvar reference in Control.Reference.Predefined. It is an IO reference, so an access to the referenced value is done in an IO action.
There are also other applications of this library, it is not restricted to IO. An additional feature is to add references (so adding _1 and _2 tuple accessors will give a both traversal, that accesses both fields). It can also be used to release resources after accessing them, so it can be used to manipulate files safely.
The usage is like this:
test =
do result <- newEmptyMVar
terminator <- newEmptyMVar
forkIO $ (result ^? mvar) >>= print >> (mvar .= ()) terminator >> return ()
hello <- newMVar (Just "World")
forkIO $ ((mvar & just & _tail & _tail) %~= ('_':) $ hello) >> return ()
forkIO $ ((mvar & just & element 1) .= 'u' $ hello) >> return ()
forkIO $ ((mvar & just) %~= ("Hello" ++) $ hello) >> return ()
x <- runMaybeT $ hello ^? (mvar & just)
mvar .= x $ result
terminator ^? mvar
The operator & combines lenses, ^? is generalized to handle references of any monad, not just a referenced value that may not exist. The %~= operator is an update of a monadic reference with a pure function.

implementing a "findM" in Haskell?

I am looking for a function that basically is like mapM on a list -- it performs a series of monadic actions taking every value in the list as a parameter -- and each monadic function returns m (Maybe b). However, I want it to stop after the first parameter that causes the function to return a Just value, not execute any more after that, and return that value.
Well, it'll probably be easier to just show the type signature:
findM :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
where b is the first Just value. The Maybe in the result is from the finding (in case of an empty list, etc.), and has nothing to do with the Maybe returned by the Monadic function.
I can't seem to implement this with a straightforward application of library functions. I could use
findM f xs = fmap (fmap fromJust . find isJust) $ mapM f xs
which will work, but I tested this and it seems that all of the monadic actions are executed before calling find, so I can't rely on laziness here.
ghci> findM (\x -> print x >> return (Just x)) [1,2,3]
1
2
3
-- returning IO (Just 1)
What is the best way to implement this function that won't execute the monadic actions after the first "just" return? Something that would do:
ghci> findM (\x -> print x >> return (Just x)) [1,2,3]
1
-- returning IO (Just 1)
or even, ideally,
ghci> findM (\x -> print x >> return (Just x)) [1..]
1
-- returning IO (Just 1)
Hopefully there is an answer that doesn't use explicit recursion, and are compositions of library functions if possible? Or maybe even a point-free one?
One simple point-free solution is using the MaybeT transformer. Whenever we see m (Maybe a) we can wrap it into MaybeT and we get all MonadPlus functions immediately. Since mplus for MaybeT does exactly we need - it runs the second given action only if the first one resulted in Nothing - msum does exactly what we need:
import Control.Monad
import Control.Monad.Trans.Maybe
findM :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
findM f = runMaybeT . msum . map (MaybeT . f)
Update: In this case, we were lucky that there exists a monad transformer (MaybeT) whose mplus has just the semantic we need. But in a general case, it can be that it won't be possible to construct such a transformer. MonadPlus has some laws that must be satisfied with respect to other monadic operations. However, all is not lost, as we actually don't need a MonadPlus, all we need is a proper monoid to fold with.
So let's pretend we don't (can't) have MaybeT. Computing the first value of some sequence of operations is described by the First monoid. We just need to make a monadic variant that won't execute the right part, if the left part has a value:
newtype FirstM m a = FirstM { getFirstM :: m (Maybe a) }
instance (Monad m) => Monoid (FirstM m a) where
mempty = FirstM $ return Nothing
mappend (FirstM x) (FirstM y) = FirstM $ x >>= maybe y (return . Just)
This monoid exactly describes the process without any reference to lists or other structures. Now we just fold over the list using this monoid:
findM' :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
findM' f = getFirstM . mconcat . map (FirstM . f)
Moreover, it allows us to create a more generic (and even shorter) function using Data.Foldable:
findM'' :: (Monad m, Foldable f)
=> (a -> m (Maybe b)) -> f a -> m (Maybe b)
findM'' f = getFirstM . foldMap (FirstM . f)
I like Cirdec's answer if you don't mind recursion, but I think the equivalent fold based answer is quite pretty.
findM f = foldr test (return Nothing)
where test x m = do
curr <- f x
case curr of
Just _ -> return curr
Nothing -> m
A nice little test of how well you understand folds.
This should do it:
findM _ [] = return Nothing
findM filter (x:xs) =
do
match <- filter x
case match of
Nothing -> findM filter xs
_ -> return match
If you really want to do it points free (added as an edit)
The following would find something in a list using an Alternative functor, using a fold as in jozefg's answer
findA :: (Alternative f) => (a -> f b) -> [a] -> f b
findA = flip foldr empty . ((<|>) .)
I don't thing we can make (Monad m) => m . Maybe an instance of Alternative, but we could pretend there's an existing function:
-- Left biased choice
(<||>) :: (Monad m) => m (Maybe a) -> m (Maybe a) -> m (Maybe a)
(<||>) left right = left >>= fromMaybe right . fmap (return . Just)
-- Or its hideous points-free version
(<||>) = flip ((.) . (>>=)) (flip ((.) . ($) . fromMaybe) (fmap (return . Just)))
Then we can define findM in the same vein as findA
findM :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
findM = flip foldr (return Nothing) . ((<||>) .)
This can be expressed pretty nicely with the MaybeT monad transformer and Data.Foldable.
import Data.Foldable (msum)
import Control.Monad.Trans.Maybe (MaybeT(..))
findM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
findM f = runMaybeT . msum . map (MaybeT . f)
And if you change your search function to produce a MaybeT stack, it becomes even nicer:
findM' :: Monad m => (a -> MaybeT m b) -> [a] -> MaybeT m b
findM' f = msum . map f
Or in point-free:
findM' = (.) msum . map
The original version can be made fully point-free as well, but it becomes pretty unreadable:
findM = (.) runMaybeT . (.) msum . map . (.) MaybeT

mapMonadTrans :: MonadTrans xT => (m a -> n b) -> xT m a -> xT n b

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.

Resources