This is a repost of my previous question(deleted by myself) since I considered it would be adequate to change the focus by presenting the sample code below.
Basically, I try to implement a Functor that takes a function such as id, \a -> a + 1 or even print .
So the function type can be
f :: a -> b
f :: a -> IO ()
module Main where
import Control.Monad.Primitive (PrimMonad (PrimState))
import qualified Data.Vector.Mutable as M
import System.IO.Error (isDoesNotExistErrorType)
main :: IO ()
main = do
let ioA = io (5 :: Int)
let f = print
-- f = \a -> a + 1
let ioB = someFunctor f ioA
ioB
print "done"
data R a = R
{ val :: M.MVector (PrimState IO) a
}
io :: a -> IO (R a)
io = \a -> do
val <- M.new 1
M.write val 0 a
return $ R val
_val :: R a -> IO a
_val = \ra -> M.read (val ra) 0
someFunctor :: Show a => (a -> b) -> IO (R a) -> IO (R b)
someFunctor = \f -> \ioA -> do
print "-- someFunctor"
val <- ioA >>= _val
print val --works 5
let ioB = io $ f val
--here, I want to actually `print val` when `f == print`
return $ f val
ioB
Output
"-- someFunctor"
5
"done"
The current sample code woks without errors, and what I want to achieve is to evaluate
f val
where
f val is the value wrapped into the new container ioB: io $ f val
However, due to the lazy-evaluation strategy of Haskell or some other reason, when f == print, this is not actually performed, so the val is not printed against my expectation.
So far, I did return $ f val, but this does not work unlike the working print val.
Just f val in do thread doesn't go well because f can be id and in that case, it's not IO type. Type mismatch. The compiler smartly generates an error here thanksfully.
So, my question is what is the generic way to implement f val to be evaluated when f == print f :: a -> IO ()?
If you want to do IO, you have to admit you're doing IO.
someFunctor :: Show a => (a -> IO b) -> IO (R a) -> IO (R b)
someFunctor = \f -> \ioA -> do
{- ... -}
b <- f val
io b
You can lift non-IO functions to IO ones with return, as in
someFunctor (return . id)
Related
I have struggled for days to compose a data structure that has a field of mutable value of Data.Vector.Mutable
I confirmed Data.Vector.Mutable itself behaves as I expected; however once it's included into a structure, somehow stops working against my expectation.
Below is a demo-code that simply has newVal, getVal and setVal targeting the mutable field value of the structure.
newIO is the constructor of the data structure typed as newIO :: a -> A a.
module Main where
import Control.Monad.Primitive (PrimMonad (PrimState))
import qualified Data.Vector.Mutable as M
------------------------------------
data A a = A
{ ioVal :: IO (M.MVector (PrimState IO) a)
}
newIO :: a -> A a
newIO = \a -> A (newVal a)
------------------------------
newVal :: a -> IO (M.MVector (PrimState IO) a)
newVal = \a -> do
val <- M.new 1
M.write val 0 a
return val
getVal :: A a -> IO a
getVal = \aA -> do
val <- ioVal aA
M.read val 0
setVal :: a -> A a -> IO ()
setVal = \a -> \aA -> do
val <- ioVal aA
M.write val 0 a
------------------------------
main :: IO ()
main = do
let ioA = newIO (5 :: Int)
(getVal ioA) >>= print -- 5
setVal 10 ioA
(getVal ioA) >>= print -- 5 ?? expected 10
So, here, to confirm the basic behavior of set/get of the structure, I try to create, read, (re)write, and (re)read the mutable value of the field; however, it does not work as expected as the set should perform.
What's wrong with the code? Please advise.
A main property of Haskell is referential transparency: we can always replace defined entities with their definitions. Now consider the posted code:
main :: IO ()
main = do
let ioA = newIO (5 :: Int)
(getVal ioA) >>= print -- 5
setVal 10 ioA
(getVal ioA) >>= print -- 5 ?? expected 10
This defines ioA, so we can replace it with its own definition. We get:
main :: IO ()
main = do
(getVal (newIO (5 :: Int))) >>= print -- 5
setVal 10 (newIO (5 :: Int))
(getVal (newIO (5 :: Int))) >>= print -- 5 ?? expected 10
Now we can see the problem: we create three independent vectors. The issue is that let ioA = ... defines an IO action (roughly, an imperative procedure) that we can call multiple times later on.
But we don't want that: we want newIO (5 :: Int) to be executed only once.
For that, we must avoid let and use monadic bind (<-, in do blocks).
main :: IO ()
main = do
ioA <- newIO (5 :: Int) -- run the action, just once
(getVal ioA) >>= print
setVal 10 ioA
(getVal ioA) >>= print
This will trigger a bunch of type errors, since e.g. getVal is no longer passed an IO action, but is passed the result of the IO action. This is what we want, though, so we need to fix the types accordingly.
Start by removing IO here:
data A a = A
{ ioVal :: M.MVector (PrimState IO) a
}
Indeed, we don't want to store a procedure that makes a vector, we want to store the vector.
Consequently, we need to remove <- in favor of let in a few other points.
getVal :: A a -> IO a
getVal = \aA -> do
let val = ioVal aA -- no IO action to run here
M.read val 0
Also, newIO must return an IO value.
newIO :: a -> IO (A a)
newIO = \a -> fmap A (newVal a)
I think you can figure out the rest now.
I am currently playing with the Bryan O'Sullivan's resource-pool library and have a question regarding extending the withResource function.
I want to change the signature of the withResource function from (MonadBaseControl IO m) => Pool a -> (a -> m b) -> m b to (MonadBaseControl IO m) => Pool a -> (a -> m (Bool, b)) -> m b.
What I want to achieve is, that the action should return (Bool, b) tuple, where the boolean value indicates if the borrowed resource should
be put back into the pool or destroyed.
Now my current implementation looks like this:
withResource :: forall m a b. (MonadBaseControl IO m) => Pool a -> (a -> m (Bool, b)) -> m b
{-# SPECIALIZE withResource :: Pool a -> (a -> IO (Bool,b)) -> IO b #-}
withResource pool act = fmap snd result
where
result :: m (Bool, b)
result = control $ \runInIO -> mask $ \restore -> do
resource <- takeResource pool
ret <- restore (runInIO (act resource)) `onException`
destroyResource pool resource
void . runInIO $ do
(keep, _) <- restoreM ret :: m (Bool, b)
if keep
then liftBaseWith . const $ putResource pool resource
else liftBaseWith . const $ destroyResource pool resource
return ret
And I have a feeling, that this is not how it is supposed to look like...
Maybe I am not using the MonadBaseControl API right.
What do you guys think of this and how can I improve it to be more idiomatic?
I have a feeling that there is a fundamental problem with this approach. For monads for which StM M a is equal/isomorphic to a it will work. But for other monads there will be a problem. Let's consider MaybeT IO. An action of type a -> MaybeT IO (Bool, b) can fail, so there will be no Bool value produced. And the code in
void . runInIO $ do
(keep, _) <- restoreM ret :: m (Bool, b)
...
won't be executed, the control flow will stop at restoreM. And for ListT IO it'll be even worse, as putResource and destroyResource will be executed multiple times. Consider this sample program, which is a simplified version of your function:
{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, RankNTypes, TupleSections #-}
import Control.Monad
import Control.Monad.Trans.Control
import Control.Monad.Trans.List
foo :: forall m b . (MonadBaseControl IO m) => m (Bool, b) -> m b
foo act = fmap snd result
where
result :: m (Bool, b)
result = control $ \runInIO -> do
ret <- runInIO act
void . runInIO $ do
(keep, _) <- restoreM ret :: m (Bool, b)
if keep
then liftBaseWith . const $ putStrLn "return"
else liftBaseWith . const $ putStrLn "destroy"
return ret
main :: IO ()
main = void . runListT $ foo f
where
f = msum $ map (return . (, ())) [ False, True, False, True ]
It'll print
destroy
return
destroy
return
And for an empty list, nothing gets printed, which means no cleanup would be called in your function.
I have to say I'm not sure how to achieve your goal in a better way. I'd try to explore in the direction of signature
withResource :: forall m a b. (MonadBaseControl IO m)
=> Pool a -> (a -> IO () -> m b) -> m b
where the IO () argument would be a function, that when executed, invalidates the current resource and marks it to be destroyed. (Or, for better convenience, replace IO () with lifted m ()). Then internally, as it's IO-based, I'd just create a helper MVar that'd be reset by calling
the function, and at the end, based on the value, either return or destroy the resource.
I have a function
parseArgs :: [String] -> StdGen -> IO ()
which selects the function to run. The main looks like
main = parseArgs <$> getArgs <*> getStdGen >>= id
The problem I have, parseArgs <$> getArgs <*> getStdGen is of type IO (IO ()), which I extract using (>>= id) which is of type Monad m => m (m b) -> m b. Is there a way to avoid requiring the "extraction" of the value while having just a single line function?
The easiest way would be with join:
main = join $ parseArgs <$> getArgs <*> getStdGen
Personally, I would prefer the form
main = join $ liftM2 parseArgs getArgs getStdGen
where
join :: Monad m => m (m a) -> m a
liftM2 :: Monad m => (a -> b -> r) -> m a -> m b -> m r
Or just use a do
main = do
args <- getArgs
gen <- getStdGen
parseArgs args gen
You can define an operator for this:
infixl 4 <&>
(<&>) :: Monad m => m (a -> m b) -> m a -> m b
f <&> x = f >>= (x >>=)
If you have a function of type
f :: Monad m => (a1 -> a2 -> ... -> an -> m b) -> m a1 -> m a2 -> ... -> m an -> m b
then you can write
fx :: Monad m => m b
fx = f <$> x1 <*> x2 <*> ... <&> xn
where each xi has type m ai.
In your case it would be simply
parseArgs <$> getArgs <&> getStdGen
You could pair up the arguments and put them through a single bind:
main = uncurry parseArgs =<< (,) <$> getArgs <*> getStdGen
This avoids the extraction from nested IO. Admittedly it's no shorter but I find it easier to think about.
It fits a general pattern of doTheWork =<< getAllTheInputs which might be the way you'd end up arranging things anyway, if the code was more complicated.
How can we prove that the continuation monad has no valid instance of MonadFix?
Well actually, it's not that there can't be a MonadFix instance, just that the library's type is a bit too constrained. If you define ContT over all possible rs, then not only does MonadFix become possible, but all instances up to Monad require nothing of the underlying functor :
newtype ContT m a = ContT { runContT :: forall r. (a -> m r) -> m r }
instance Functor (ContT m) where
fmap f (ContT k) = ContT (\kb -> k (kb . f))
instance Monad (ContT m) where
return a = ContT ($a)
join (ContT kk) = ContT (\ka -> kk (\(ContT k) -> k ka))
instance MonadFix m => MonadFix (ContT m) where
mfix f = ContT (\ka -> mfixing (\a -> runContT (f a) ka<&>(,a)))
where mfixing f = fst <$> mfix (\ ~(_,a) -> f a )
Consider the type signature of mfix for the continuation monad.
(a -> ContT r m a) -> ContT r m a
-- expand the newtype
(a -> (a -> m r) -> m r) -> (a -> m r) -> m r
Here's the proof that there's no pure inhabitant of this type.
---------------------------------------------
(a -> (a -> m r) -> m r) -> (a -> m r) -> m r
introduce f, k
f :: a -> (a -> m r) -> m r
k :: a -> m r
---------------------------
m r
apply k
f :: a -> (a -> m r) -> m r
k :: a -> m r
---------------------------
a
dead end, backtrack
f :: a -> (a -> m r) -> m r
k :: a -> m r
---------------------------
m r
apply f
f :: a -> (a -> m r) -> m r f :: a -> (a -> m r) -> m r
k :: a -> m r k :: a -> m r
--------------------------- ---------------------------
a a -> m r
dead end reflexivity k
As you can see the problem is that both f and k expect a value of type a as an input. However, there's no way to conjure a value of type a. Hence, there's no pure inhabitant of mfix for the continuation monad.
Note that you can't define mfix recursively either because mfix f k = mfix ? ? would lead to an infinite regress since there's no base case. And, we can't define mfix f k = f ? ? or mfix f k = k ? because even with recursion there's no way to conjure a value of type a.
But, could we have an impure implementation of mfix for the continuation monad? Consider the following.
import Control.Concurrent.MVar
import Control.Monad.Cont
import Control.Monad.Fix
import System.IO.Unsafe
instance MonadFix (ContT r m) where
mfix f = ContT $ \k -> unsafePerformIO $ do
m <- newEmptyMVar
x <- unsafeInterleaveIO (readMVar m)
return . runContT (f x) $ \x' -> unsafePerformIO $ do
putMVar m x'
return (k x')
The question that arises is how to apply f to x'. Normally, we'd do this using a recursive let expression, i.e. let x' = f x'. However, x' is not the return value of f. Instead, the continuation given to f is applied to x'. To solve this conundrum, we create an empty mutable variable m, lazily read its value x, and apply f to x. It's safe to do so because f must not be strict in its argument. When f eventually calls the continuation given to it, we store the result x' in m and apply the continuation k to x'. Thus, when we finally evaluate x we get the result x'.
The above implementation of mfix for the continuation monad looks a lot like the implementation of mfix for the IO monad.
import Control.Concurrent.MVar
import Control.Monad.Fix
instance MonadFix IO where
mfix f = do
m <- newEmptyMVar
x <- unsafeInterleaveIO (takeMVar m)
x' <- f x
putMVar m x'
return x'
Note, that in the implementation of mfix for the continuation monad we used readMVar whereas in the implementation of mfix for the IO monad we used takeMVar. This is because, the continuation given to f can be called multiple times. However, we only want to store the result given to the first callback. Using readMVar instead of takeMVar ensures that the mutable variable remains full. Hence, if the continuation is called more than once then the second callback will block indefinitely on the putMVar operation.
However, only storing the result of the first callback seems kind of arbitrary. So, here's an implementation of mfix for the continuation monad that allows the provided continuation to be called multiple times. I wrote it in JavaScript because I couldn't get it to play nicely with laziness in Haskell.
// mfix :: (Thunk a -> ContT r m a) -> ContT r m a
const mfix = f => k => {
const ys = [];
return (function iteration(n) {
let i = 0, x;
return f(() => {
if (i > n) return x;
throw new ReferenceError("x is not defined");
})(y => {
const j = i++;
if (j === n) {
ys[j] = k(x = y);
iteration(i);
}
return ys[j];
});
}(0));
};
const example = triple => k => [
{ a: () => 1, b: () => 2, c: () => triple().a() + triple().b() },
{ a: () => 2, b: () => triple().c() - triple().a(), c: () => 5 },
{ a: () => triple().c() - triple().b(), b: () => 5, c: () => 8 },
].flatMap(k);
const result = mfix(example)(({ a, b, c }) => [{ a: a(), b: b(), c: c() }]);
console.log(result);
Here's the equivalent Haskell code, sans the implementation of mfix.
import Control.Monad.Cont
import Control.Monad.Fix
data Triple = { a :: Int, b :: Int, c :: Int } deriving Show
example :: Triple -> ContT r [] Triple
example triple = ContT $ \k ->
[ Triple 1 2 (a triple + b triple)
, Triple 2 (c triple - a triple) 5
, Triple (c triple - b triple) 5 8
] >>= k
result :: [Triple]
result = runContT (mfix example) pure
main :: IO ()
main = print result
Notice that this looks a lot like the list monad.
import Control.Monad.Fix
data Triple = { a :: Int, b :: Int, c :: Int } deriving Show
example :: Triple -> [Triple]
example triple =
[ Triple 1 2 (a triple + b triple)
, Triple 2 (c triple - a triple) 5
, Triple (c triple - b triple) 5 8
]
result :: [Triple]
result = mfix example
main :: IO ()
main = print result
This makes sense because after all the continuation monad is the mother of all monads. I'll leave the verification of the MonadFix laws of my JavaScript implementation of mfix as an exercise for the reader.
I have a function that I want to use a Maybe val with. Usually I would do func <$> val. But now suppose that func uses the IO monad. func <$> val will return a Maybe (IO ()). So instead I had to define a new operator:
(<$$>) :: Monad m => (a -> m b) -> Maybe a -> m ()
(<$$>) func (Just val) = func val >> return ()
(<$$>) func Nothing = return ()
So now I can write func <$$> val, but is there a better way to do it?
mapM_ from Data.Foldable is probably the best match:
Prelude Data.Foldable> :set -XScopedTypeVariables
Prelude Data.Foldable> :t \f (a :: Maybe a) -> Data.Foldable.mapM_ f a
\f (a :: Maybe a) -> Data.Foldable.mapM_ f a
:: Monad m => (a -> m b) -> Maybe a -> m ()
If you'd like a more specialised type there's also maybe:
Prelude> :t \f -> maybe (return ()) (f $)
\f -> maybe (return ()) (f $)
:: Monad m => (a -> m ()) -> Maybe a -> m ()
Your <$$> is traverse_ from Data.Foldable.
Is a one-liner always better? Here's how purity of undefined can be useful:
(<$$>) g x = maybe (return undefined) g x >> return ()
Example:
Prelude> print <$$> (Just 1)
1
Prelude> print <$$> Nothing
Prelude>
If you have a lot of this in your code, it might be worth employing the MaybeT transformer:
(\func val -> liftIO . func =<< MaybeT (return val) )
:: (a -> IO b) -> Maybe b -> MaybeT IO b
That doesn't immediately bring you any further than plain IO (Maybe ()), but it composes nicely.