I have a type family of variadic functions:
type family (~~>) (argTypes :: [Type]) (result :: Type) :: Type where
'[] ~~> r = r
(t ': ts) ~~> r = t -> (ts ~~> r)
infixr 0 ~~>
I want a variadic function which applies some monadic action (say print) to all its arguments:
class Foo (ts :: [Type]) where
foo :: ts ~~> IO ()
instance Foo '[] where
foo = pure ()
instance (Show t, Foo ts) => Foo (t ': ts) where
foo t = print t >> foo #ts
Usual monadic composition doesn't work here.
(>>) has type IO () -> IO () -> IO (). I need to use something of type IO () -> (ts ~~> IO ()) -> ts ~~> IO () to compose print t and foo #ts there.
Is it possible to write such function at all?
Continuation passing style gives direct access to the result of a computation.
Another way would be to build a type class to iterate composition, but it's cumbersome.
{-# LANGUAGE FlexibleInstances #-}
class Foo t where
foo_ :: (IO () -> IO ()) -> t
instance (Show a, Foo t) => Foo (a -> t) where
foo_ k a = foo_ (\continue -> k (print a >> continue))
instance Foo (IO ()) where
foo_ k = k (return ())
foo :: Foo t => t
foo = foo_ id
main :: IO ()
main = foo () (Just "bar") [()]
I found a way to write function IO () -> (ts ~~> IO ()) -> ts ~~> IO ()
-- | Perform first action `m a` then pass its result to a function `(a -> ts ~~> mb)`
-- which returns variadic function and return that function.
class BindV (m :: Type -> Type) a b (ts :: [Type]) where
bindV :: m a -> (a -> ts ~~> m b) -> ts ~~> m b
instance (Monad m) => BindV m a b '[] where
bindV ma f = ma >>= f
instance (BindV m a b ts) => BindV m a b (t ': ts) where
bindV ma f x = bindV #m #a #b #ts ma ((flip f) x)
-- | Monadic composition that discards result of the first action.
thenV :: forall (m :: Type -> Type) a b (ts :: [Type]).
(BindV m a b ts) =>
m a -> (ts ~~> m b) -> ts ~~> m b
thenV ma f = bindV #m #a #b #ts ma (\_ -> f)
Thus instance in question become:
instance (Show t, Foo ts, BindV IO () () ts) => Foo (t ': ts) where
foo t = thenV #IO #() #() #ts (print t) (foo #ts)
I wish I could write thenV and bindV as an operator but TypeApplications doesn't work with operators.
Related
I am trying to pass a function in a Reader that is to be called from the same monad as the calling function, but I get an infinite type error.
The simplified code is:
{-# LANGUAGE FlexibleContexts #-}
module G2 where
import Control.Monad
import Control.Monad.Reader
data Foo m = Foo { bar :: m () }
runFoo :: MonadReader (Foo m) m => m ()
runFoo = do
b <- asks bar
b
main :: Monad m => m ()
main = do
let bar = return () :: m ()
foo = Foo bar
runReaderT runFoo foo
And the error is:
• Occurs check: cannot construct the infinite type:
m0 ~ ReaderT (Foo m0) m
arising from a functional dependency between:
constraint ‘MonadReader
(Foo (ReaderT (Foo m0) m)) (ReaderT (Foo m0) m)’
arising from a use of ‘runFoo’
instance ‘MonadReader r (ReaderT r m1)’ at <no location info>
• In the first argument of ‘runReaderT’, namely ‘runFoo’
In a stmt of a 'do' block: runReaderT runFoo foo
In the expression:
do let bar = ...
foo = Foo bar
runReaderT runFoo foo
• Relevant bindings include main :: m () (bound at G2.hs:16:1)
|
19 | runReaderT runFoo foo
| ^^
Any help would be much appreciated, thanks!
runFoo :: MonadReader (Foo m) m => m ()
Let's forget about the class, and just assume that MonadReader env mon means that mon ~ ((->) env). This corresponds to simply using (->) as our monad instead of the fancier ReaderT. Then you get m ~ ((->) m) => m (). You see that m needs to contain itself (specifically, the argument to m is m). This is OK for values, but it would be quite bad if the typechecker had to deal with infinitely large types. The same is true for ReaderT (and you need to use ReaderT because you call runReaderT runFoo). You need to define another newtype to encode this recursion:
data RecReader c a = RecReader { runRecReader :: c (RecReader c) -> a }
instance Functor (RecReader c) where
fmap f (RecReader r) = RecReader $ f . r
instance Applicative (RecReader c) where
pure = RecReader . const
RecReader f <*> RecReader g = RecReader $ \e -> f e (g e)
instance Monad (RecReader c) where
return = pure
RecReader x >>= f = RecReader $ \e -> runRecReader (f (x e)) e
instance MonadReader (c (RecReader c)) (RecReader c) where
ask = RecReader id
local f (RecReader x) = RecReader $ x . f
And it works:
runRecReader runFoo (Foo $ return ())
-- ==>
()
My question is quite similar to How to modify using a monadic function with lenses? The author asked if something like this exists
overM :: (Monad m) => Lens s t a b -> (a -> m b) -> s -> m t
The answer was mapMOf
mapMOf :: Profunctor p =>
Over p (WrappedMonad m) s t a b -> p a (m b) -> s -> m t
I'm trying to implement a function that modifies state in MonadState using a monadic function:
modifyingM :: MonadState s m => ASetter s s a b -> (a -> m b) -> m ()
Example without modifingM:
{-# LANGUAGE TemplateHaskell #-}
module Main where
import Control.Lens (makeLenses, use, (.=))
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State.Lazy (StateT(StateT), execStateT)
data GameObject = GameObject
{ _num :: Int
} deriving (Show)
data Game = Game
{ _objects :: [GameObject]
} deriving (Show)
makeLenses ''Game
makeLenses ''GameObject
defaultGame = Game {_objects = map GameObject [0 .. 3]}
action :: StateT Game IO ()
action = do
old <- use objects
new <- lift $ modifyObjects old
objects .= new
modifyObjects :: [GameObject] -> IO [GameObject]
modifyObjects objs = return objs -- do modifications
main :: IO ()
main = do
execStateT action defaultGame
return ()
This example works. Now I'd like to extract the code from action to a generic solution modifingM:
{-# LANGUAGE TemplateHaskell #-}
module Main where
import Control.Lens (makeLenses, use, (.=), ASetter)
import Control.Monad.State.Class (MonadState)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State.Lazy (StateT(StateT), execStateT)
data GameObject = GameObject
{ _num :: Int
} deriving (Show)
data Game = Game
{ _objects :: [GameObject]
} deriving (Show)
makeLenses ''Game
makeLenses ''GameObject
defaultGame = Game {_objects = map GameObject [0 .. 3]}
modifyingM :: MonadState s m => ASetter s s a b -> (a -> m b) -> m ()
modifyingM l f = do
old <- use l
new <- lift $ f old
l .= new
action :: StateT Game IO ()
action = modifyingM objects modifyObjects
modifyObjects :: [GameObject] -> IO [GameObject]
modifyObjects objs = return objs -- do modifications
main :: IO ()
main = do
execStateT action defaultGame
return ()
This results in compile time errors:
Main.hs:26:14: error:
• Couldn't match type ‘Data.Functor.Identity.Identity s’
with ‘Data.Functor.Const.Const a s’
Expected type: Control.Lens.Getter.Getting a s a
Actual type: ASetter s s a b
• In the first argument of ‘use’, namely ‘l’
In a stmt of a 'do' block: old <- use l
In the expression:
do { old <- use l;
new <- lift $ f old;
l .= new }
• Relevant bindings include
f :: a -> m b (bound at app/Main.hs:25:14)
l :: ASetter s s a b (bound at app/Main.hs:25:12)
modifyingM :: ASetter s s a b -> (a -> m b) -> m ()
(bound at app/Main.hs:25:1)
Main.hs:31:10: error:
• Couldn't match type ‘IO’ with ‘StateT Game IO’
Expected type: StateT Game IO ()
Actual type: IO ()
• In the expression: modifyingM objects modifyObjects
In an equation for ‘action’:
action = modifyingM objects modifyObjects
What's the problem?
Edit 1: Assign new instead of old value.
Edit 2: Added example with solution of #Zeta that does not compile.
Edit 3: Remove example of second edit. It didn't compile due to wrong imports (see comment).
You're using use on a ASetter, but use takes a Getter:
use :: MonadState s m => Getting a s a -> m a
(.=) :: MonadState s m => ASetter s s a b -> b -> m ()
Unfortunately, ASetter and Getting are not the same:
type Getting r s a = (a -> Const r a ) -> s -> Const r s
type ASetter s t a b = (a -> Identity b) -> s -> Identity t
We need to switch between Const and Identity arbitrarily. We need a Lens:
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
Note that there is no f on the left-hand side. Next, we note that your lift is not necessary. After all, f already works in our target monad m; you had to use lift previously because modifyObjects was in IO and action was in StateT Game IO, but here we just have a single m:
modifyingM :: MonadState s m => Lens s s a a -> (a -> m b) -> m ()
modifyingM l f = do
old <- use l
new <- f old
l .= old
That works! But it's likely wrong, since you probably want to set the new value in l .= old. If that's the case, we have to make sure that old and new have the same type:
-- only a here, no b
-- v v v v
modifyingM :: MonadState s m => Lens s s a a -> (a -> m a) -> m ()
modifyingM l f = do
old <- use l
new <- f old
l .= new
Keep in mind that you need to lift modifyObjects though:
action :: StateT Game IO ()
action = modifyingM objects (lift . modifyObjects)
We could stop here, but just for some fun, let us have a look again at Lens:
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
For any a -> f b you give me, I'll give you a new s -> f t. So if we just plug something in your objects, we have
> :t \f -> objects f
\f -> objects f
:: Functor f => (GameObject -> f GameObject) -> Game -> f Game
Therefore, we just need some MonadState s m => (s -> m s) -> m () function, but that's easy to achieve:
import Control.Monad.State.Lazy (get, put) -- not the Trans variant!
modifyM :: MonadState s m => (s -> m s) -> m ()
modifyM f = get >>= f >>= put
Note that you need to use Control.Monad.State from mtl instead of Control.Monad.Trans.State. The latter only defines put :: Monad m => s -> StateT s m () and get :: Monad m => StateT s m s, but you want to use the MonadState variant from mtl.
If we put all things together, we see that modifyingM can be written as:
modifyingM :: MonadState s m => Lens s s a a -> (a -> m a) -> m ()
modifyingM l f = modifyM (l f)
Alternatively, we use the can use the lens functions, although that does not give us the insight that we can use l f:
modifyingM :: MonadState s m => Lens s s a a -> (a -> m a) -> m ()
modifyingM l f = use l >>= f >>= assign l
I am trying to implement my own functor instances and quickcheck them, and have run into issues on typeclasses which are not instances of Eq, namely (->) and IO. My attempts result in a No instance for (Eq ...) error.
In the (->) case I had run into a similar error with Show, i.e. No instance for (Show ...), and was able to fix that by adding a Show (a -> b) instance as suggested in an answer here. It would seem that I might be able to solve also the lack of Eq instances by adding them similarly. However, this question on function equality notes that that in Haskell creating an instance of Eq (a -> b) is equivalent to the halting problem and therefore impossible.
I'm not sure whether creating an instance of Eq IO a is possible. In the IO case I also run into a No instance for (Arbitrary ...) error.
Is there some way to quickcheck the functor properties of the function type (->)? Is there some way to do the same for the IO type?
My code is as follows.
import Prelude hiding (Functor, fmap)
import Test.QuickCheck
import Test.QuickCheck.Function
class Functor f where
fmap :: (a -> b) -> f a -> f b
instance Functor IO where
fmap h f = f >>= (pure . h)
instance Functor ((->) e) where
fmap = (.)
data T a = T
prop_functorid :: (Functor f, Eq (f a)) => T (f a) -> f a -> Bool
prop_functorid T x = fmap id x == x
prop_functorcompose :: (Functor f, Eq (f c)) => T (f a) -> T b -> T c -> f a -> Fun a b -> Fun b c -> Bool
prop_functorcompose T T T x (apply -> g) (apply -> h) =
fmap (h . g) x == (fmap h . fmap g) x
instance Show (a -> b) where
show a= "function"
prop_function :: IO ()
prop_function = do
quickCheck $ prop_functorid (T :: T (String -> String))
quickCheck $ prop_functorcompose (T :: T (String -> String)) (T :: T String) (T :: T String)
prop_io :: IO ()
prop_io = do
quickCheck $ prop_functorid (T :: T (IO String))
quickCheck $ prop_functorcompose (T :: T (IO String)) (T :: T String) (T :: T String)
main = do
prop_function
prop_io
What follows is a series of examples/exercises upon Lenses (by Edward Kmett) in MonadState, based on the solution of Petr Pudlak to my previous question.
In addition to demonstrate some uses and the power of the lenses, these examples show how difficult it is to understand the type signature generated by GHCi. There is hope that in the future things will improve?
{-# LANGUAGE TemplateHaskell, RankNTypes #-}
import Control.Lens
import Control.Monad.State
---------- Example by Petr Pudlak ----------
-- | 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
s <- lift getLine
l %= (++ s)
-----------------------------------------------
The following comment type signatures are those produced by GHCi.
The other are adaptations from those of Peter.
Personally, I am struggling to understand than those produced by GHCi, and I wonder: why GHCi does not produce those simplified?
-------------------------------------------
-- modif2
-- :: (Profunctor p, MonadTrans t, MonadState s (t IO)) =>
-- (Int -> p a b) -> Setting p s s a b -> t IO ()
modif2 :: (Int -> Int -> Int) -> Lens' a Int -> StateT a IO ()
modif2 f l = do
s<- lift getLine
l %= f (read s :: Int)
---------------------------------------
-- modif3
-- :: (Profunctor p, MonadTrans t, MonadState s (t IO)) =>
-- (String -> p a b) -> Setting p s s a b -> t IO ()
modif3 :: (String -> Int -> Int) -> Lens' a Int -> StateT a IO ()
modif3 f l = do
s <- lift getLine
l %= f s
-- :t modif3 (\n -> (+) (read n :: Int)) == Lens' a Int -> StateT a IO ()
---------------------------------------
-- modif4
-- :: (Profunctor p, MonadTrans t, MonadState s (t IO)) =>
-- (t1 -> p a b) -> (String -> t1) -> Setting p s s a b -> t IO ()
modif4 :: (Bool -> Bool -> Bool) -> (String -> Bool) -> Lens' a Bool -> StateT a IO ()
modif4 f f2 l = do
s <- lift getLine
l %= f (f2 s)
-- :t modif4 (&&) (\s -> read s :: Bool) == Lens' a Bool -> StateT a IO ()
---------------------------------------
-- modif5
-- :: (Profunctor p, MonadTrans t, MonadState s (t IO)) =>
-- (t1 -> p a b) -> (String -> t1) -> Setting p s s a b -> t IO ()
modif5 :: (b -> b -> b) -> (String -> b) -> Lens' a b -> StateT a IO ()
modif5 f f2 l = do
s<- lift getLine
l %= f (f2 s)
-- :t modif5 (&&) (\s -> read s :: Bool) == Lens' a Bool -> StateT a IO ()
---------------------------------------
-- modif6
-- :: (Profunctor p, MonadState s m) =>
-- (t -> p a b) -> (t1 -> t) -> t1 -> Setting p s s a b -> m ()
modif6 :: (b -> b -> b) -> (c -> b) -> c -> Lens' a b -> StateT a IO ()
modif6 f f2 x l = do
l %= f (f2 x)
-- :t modif6 (&&) (\s -> read s :: Bool) "True" == MonadState s m => Setting (->) s s Bool Bool -> m ()
-- :t modif6 (&&) (\s -> read s :: Bool) "True"
---------------------------------------
-- modif7
-- :: (Profunctor p, MonadState s IO) =>
-- (t -> p a b) -> (String -> t) -> Setting p s s a b -> IO ()
modif7 :: (b -> b -> b) -> (String -> b) -> Lens' a b -> StateT a IO ()
modif7 f f2 l = do
s <- lift getLine
l %= f (f2 s)
-- :t modif7 (&&) (\s -> read s :: Bool) ==
-- :t modif7 (+) (\s -> read s :: Int) ==
---------------------------------------
p7a :: StateT Int IO ()
p7a = do
get
modif7 (+) (\s -> read s :: Int) id
test7a = execStateT p7a 10 -- if input 30 then result 40
---------------------------------------
p7b :: StateT Bool IO ()
p7b = do
get
modif7 (||) (\s -> read s :: Bool) id
test7b = execStateT p7b False -- if input "True" then result "True"
---------------------------------------
data Test = Test { _first :: Int
, _second :: Bool
}
deriving Show
$(makeLenses ''Test)
dataTest :: Test
dataTest = Test { _first = 1, _second = False }
monadTest :: StateT Test IO String
monadTest = do
get
lift . putStrLn $ "1) modify \"first\" (Int requested)"
lift . putStrLn $ "2) modify \"second\" (Bool requested)"
answ <- lift getLine
case answ of
"1" -> do lift . putStr $ "> Write an Int: "
modif7 (+) (\s -> read s :: Int) first
"2" -> do lift . putStr $ "> Write a Bool: "
modif7 (||) (\s -> read s :: Bool) second
_ -> error "Wrong choice!"
return answ
testMonadTest :: IO Test
testMonadTest = execStateT monadTest dataTest
As a family in the ML tradition, Haskell is specifically designed so that every toplevel binding has a most general type, and the Haskell implementation can and has to infer this most general type. This ensures that you can reuse the binding in as much places as possible. In a way, this means that type inference is never wrong, because whatever type you have in mind, type inference will figure out the same type or a more general type.
why GHCi does not produce those simplified?
It figures out the more general types instead. For example, you mention that GHC figures out the following type for some code:
modif2 :: (Profunctor p, MonadTrans t, MonadState s (t IO)) =>
(Int -> p a b) -> Setting p s s a b -> t IO ()
This is a very general type, because every time I use modif2, I can choose different profunctors p, monad transformers t and states s. So modif2 is very reusable. You prefer this type signature:
modif2 :: (Int -> Int -> Int) -> Lens' a Int -> StateT a IO ()
I agree that this is more readable, but also less generic: Here you decided that p has to be -> and t has to be StateT, and as a user of modif2, I couldn't change that.
There is hope that in the future things will improve?
I'm sure that Haskell will continue to mandate most general types as the result of type inference. I could imagine that in addition to the most general type, ghci or a third-party tool could show you example instantiations. In this case, it would be nice to declare somehow that -> is a typical profunctor. I'm not aware of any work in this direction, though, so there is not much hope, no.
Let's look at your first example:
modif :: Lens' a String -> StateT a IO ()
modif l = do
s <- lift getLine
l %= (++ s)
This type is simple, but it has also has a shortcoming: You can only use your function passing a Lens. You cannot use your function when you have an Iso are a Traversal, even though this would make perfect sense! Given the more general type that GHCi inferes, you could for example write the following:
modif _Just :: StateT (Maybe String) IO ()
which would append the read value only if that state was a Just, or
modif traverse :: StateT [String] IO ()
which would append the read value to all elements in the list. This is not possible with the simple type you gave, because _Just and traverse are not lenses, but only Traversals.
I'm baffled by this compiler error message I'm getting. The functions addAgent and withAgent have similar type signatures and similar implementations, so I don't understand why addAgent compiles but withAgent doesn't. Thank you in advance for any help!
{-# LANGUAGE TypeFamilies, FlexibleContexts #-}
import Control.Monad.IO.Class (liftIO)
import Control.Monad.State (StateT, execStateT, gets, modify)
class AgentDatabase d where
type Elem d
addAgent :: Elem d -> StateT d IO ()
withAgent ::
(Elem d -> StateT d IO (Elem d)) -> String -> StateT d IO ()
data SimpleUniverse d = SimpleUniverse {
agentDB :: d
-- plus other fields
}
-- I want the methods of class AgentDatabase to "penetrate" through
-- the outer wrapper of SimpleUniverse and operate on the agentDB field.
instance (AgentDatabase d) =>
AgentDatabase (SimpleUniverse d) where
type Elem (SimpleUniverse d) = Elem d
-- When addAgent is invoked on a SimpleUniverse, apply it to the
-- agentDB field inside.
addAgent a = do
db <- gets agentDB
db' <- liftIO $ execStateT (addAgent a) db
modify (\u -> u { agentDB=db' } )
-- When withAgent is invoked on a SimpleUniverse, apply it to the
-- agentDB field inside.
withAgent program name = do
db <- gets agentDB
db' <- liftIO $ execStateT (withAgent program name) db -- line 33
modify (\u -> u { agentDB=db' } )
The error message I get is...
amy3.hs:33:11:
Couldn't match type `d' with `SimpleUniverse d'
`d' is a rigid type variable bound by
the instance declaration at amy3.hs:19:25
When using functional dependencies to combine
Control.Monad.State.Class.MonadState s (StateT s m),
arising from the dependency `m -> s'
in the instance declaration in `Control.Monad.State.Class'
Control.Monad.State.Class.MonadState
(SimpleUniverse (SimpleUniverse d)) (StateT (SimpleUniverse d) IO),
arising from a use of `gets' at amy3.hs:33:11-14
In a stmt of a 'do' block: db <- gets agentDB
In the expression:
do { db <- gets agentDB;
db' <- liftIO $ execStateT (withAgent program name) db;
modify (\ u -> u {agentDB = db'}) }
Failed, modules loaded: none.
program has type
Elem (SimpleUniverse d) -> StateT (SimpleUniverse d) IO (Elem (SimpleUniverse d))
which indeed simplifies, but to
Elem d -> StateT (SimpleUniverse d) IO (Elem d)
and the inner withAgent takes a program of type
Elem d -> StateT d IO (Elem d)
To fix that, this function will help:
stateMap :: Monad m => (s -> t) -> (t -> s) -> StateT s m a -> StateT t m a
stateMap f g (StateT h) = StateT $ liftM (fmap f) . h . g