After reading (and skimming some sections of) Wadler's paper on monads, I decided to work through the paper more closely, defining functor and applicative instances for each of the monads he describes. Using the type synonym
type M a = State -> (a, State)
type State = Int
Wadler uses to define the state monad, I have the following (using related names so I can define them with a newtype declaration later on).
fmap' :: (a -> b) -> M a -> M b
fmap' f m = \st -> let (a, s) = m st in (f a, s)
pure' :: a -> M a
pure' a = \st -> (a, st)
(<#>) :: M (a -> b) -> M a -> M b
sf <#> sv = \st -> let (f, st1) = sf st
(a, st2) = sv st1
in (f a, st2)
return' :: a -> M a
return' a = pure' a
bind :: M a -> (a -> M b) -> M b
m `bind` f = \st -> let (a, st1) = m st
(b, st2) = f a st1
in (b, st2)
When I switch to using a type constructor in a newtype declaration, e.g.,
newtype S a = S (State -> (a, State))
everything falls apart. Everything is just a slight modification, for instance,
instance Functor S where
fmap f (S m) = S (\st -> let (a, s) = m st in (f a, s))
instance Applicative S where
pure a = S (\st -> (a, st))
however nothing runs in GHC due to the fact that the lambda expression is hidden inside that type constructor. Now the only solution I see is to define a function:
isntThisAnnoying s (S m) = m s
in order to bind s to 'st' and actually return a value, e.g.,
fmap f m = S (\st -> let (a, s) = isntThisAnnoying st m in (f a, s))
Is there another way to do this that doesn't use these auxiliary functions?
If you look here, you will see that they define it this way:
newtype State s a = State { runState :: (s -> (a,s)) }
so as to give the inner lambda a name.
The usual way is to define newtype newtype S a = S {runState : State -> (a, State)}. Then instead of your isntThisAnnoying s (S m) you can write runState t s where t is the same as S m.
You have to use a newtype because type synonyms cannot be typeclass instances.
Related
I am very new to monads within haskell and i am trying to develop my knowledge with monads ny creating some instances but I am really quite confused with this one i am getting a few errors and have been at it for a bit as i am still unsure any help and explanations are appreciated this is what i have so far, any ideas where i am going wrong?
newtype ST b = S (Int -> (b, Int))
runState :: ST b -> Int -> (b, Int)
runState (S b) st = b st
instance Monad ST where
return :: b -> ST b
return x = S (\st -> (x, st)) the new state with a b
(>>=) :: ST b -> (b -> ST c) -> ST c
c >>= c' = S (\st1 ->
let (b, st2) = runState c st1
(c, st3) = runState (c' b) st2
in (c, st3))
You might have to give implementations for Applicative and Functor as well:
import Control.Applicative
import Control.Monad (liftM, ap)
newtype ST b = S (Int -> (b, Int))
runState :: ST b -> Int -> (b, Int)
runState (S b) st = b st
instance Monad ST where
-- return :: b -> ST b
return x = S (\st -> (x, st)) -- takes in the current state and returns the new state with a b
-- (>>=) :: ST b -> (b -> ST c) -> ST c
c >>= c' = S (\st1 ->
let (b, st2) = runState c st1
(c'', st3) = runState (c' b) st2
in (c'', st3))
instance Applicative ST where
pure = return
(<*>) = ap
instance Functor ST where
fmap = liftM
I found that here.
Prism is like Iso except one of the two conversions is partial. Is there an optic where both conversions are partial?
Of course one can create a type (s -> Maybe a, b -> Maybe t) but I'm wondering if such a thing could be expressed an as Optic _ _?
You can generalize Isos (i.e., (s -> a, b -> t)) into (s -> m a, b -> m t) by replacing profunctors over Hask (i.e., Profunctor, that's the constraint in the definition of Iso as an Optic) with profunctors over Kleisli categories (here for the Maybe monad).
class Monad m => KProfunctor m p where
dimapM :: (s -> m a) -> (b -> m t) -> p a b -> p s t
-- dimapM pure pure = id
-- dimapM f g . dimapM h i = dimapM (h >=> f) (g >=> i)
type Optic p s t a b = p a b -> p s t
type KIso m s t a b = forall p. KProfunctor m p => Optic p s t a b
To construct one example of such profunctor, take the type of pseudo-isos (s -> m a, b -> m t) that we are trying to work with in the first place, and put s and t as the main indices:
data PseudoIso m a b s t = MkPseudoIso
{ toM :: s -> m a
, fromM :: b -> m t
}
instance Monad m => KProfunctor m (PseudoIso m) where
-- exercise for the reader
To go from PseudoIso to KIso, use dimapM (the fields of PseudoIso are exactly the right type for the arguments of dimapM)
To go from KIso to PseudoIso, partially apply to the identity PseudoIso a b a b
Actually, it doesn't have to be a Kleisli category. A profunctor over any category (:->) :: k -> k -> Type will give you a class of optics of the form (s :-> a, b :-> t).
Note: you can define an instance of Choice with KProfunctor Maybe, so maybe everything should really be specialized to Maybe so Choice could reasonably be added as a superclass of KProfunctor, then KIso would be a subtype of Prism.
Let us look at profunctor encoding. It's simpler.
Choice is a class for Prisms, we are making subclass of Prisms, so Choice is natural choice for a superclass:
class Choice p => Weird p where
weird :: (s -> Maybe a) -> (b -> Maybe t) -> p a b -> p s t
If we try to write an instance for p = (->), it won't work.
So our new kind of optics is not a superclass of Setter.
The hierarchy would probably look something like: at best probably something like
(Can a Traversal and thus Lens be turned into the new Weird optic, maybe?)
Lens
/ \
Iso Traversal -> Setter
\ /
Prism
\
Weird
Let's try with another concrete Profunctors.
I'll use types as defined in my blog post: Glassery
ForgetM is used to implement preview
type Optic' p s a = p a a -> p s s
preview :: Optic' (ForgetM a) s a -> s -> Maybe a
preview o = runForgetM (o (ForgetM Just))
newtype ForgetM r a b = ForgetM { runForgetM :: a -> Maybe r }
instance Profunctor (ForgetM r) where
dimap f _ (ForgetM p) = ForgetM (p . f)
instance Choice (ForgetM r) where
right' (ForgetM p) = ForgetM (either (const Nothing) p)
instance Weird (ForgetM r) where
weird sa _bt (ForgetM ab) = ForgetM $ \s -> sa s >>= ab
TaggedM can be used to define something in oppisite direction (not in Glassery):
repreview :: Optic' TaggedM s a -> a -> Maybe s
repreview o a = unTaggedM (o (TaggedM (Just a)))
newtype TaggedM a b = TaggedM { unTaggedM :: Maybe b }
instance Profunctor TaggedM where
dimap _sa bt (TaggedM b) = TaggedM (fmap bt b)
instance Choice TaggedM where
right' (TaggedM b) = TaggedM (fmap Right b)
instance Weird TaggedM where
weird _sa bt (TaggedM b) = TaggedM (b >>= bt)
We can now try this.
Simple case works:
*Main> preview (weird Just Just) 'x'
Just 'x'
*Main> repreview (weird Just Just) 'x'
Just 'x'
Prisms can be used as new thing (thing right' = _Right):
*Main> preview right' (Left 'x')
Nothing
*Main> preview right' (Right 'x')
Just 'x'
There's also a nice symmetric Profunctor:
newtype Re p s t a b = Re { runRe :: p b a -> p t s }
instance Profunctor p => Profunctor (Re p s t) where
dimap f g (Re p) = Re (p . dimap g f)
instance Cochoice p => Choice (Re p s t) where
right' (Re p) = Re (p . unright)
instance Choice p => Cochoice (Re p s t) where
unright (Re p) = Re (p . right')
and we can write Weird instance for it:
instance Weird p => Weird (Re p s t) where
weird sa bt (Re p) = Re (p . weird bt sa)
And we notice that, we need to add Cochoice to be the superclass of Weird:
class (Choice p, Cochoice p) => Weird p where
weird :: (s -> Maybe a) -> (b -> Maybe t) -> p a b -> p s t
That starts to look promising.
van-Laarhoven. That's tricky.
Compare Prism in profunctor and VL encodings:
type PrismVL s t a b = forall f p. (Choice p, Applicative f) => p a (f b) -> p s (f t)
type PrismP s t a b = forall p. (Choice p) => p a b -> p s t
The good start is to assume that this Weird thing would look like
type WeirdOptic s t a b = forall p f. (Weird p, Applicative f) => Optic p f s t a b
Maybe we would need to strengten the f constraint too, a bit.
But I leave something for you to experiment with.
Also an open question is what's the intuition behind this new Weird optic;
and what laws it should have (to be an optic, and not just two functions
smashed together). It feels than trying to do similar Monad / Kleisli optic
with anything fancier than Maybe is difficult, but maybe it would work out too.
Here's a solution in lens-style optics (rather than profunctor optics as in the other answers) using the Filterable type-class:
-- A partial variant of (#) for partial reviews
infixr 8 #?
(#?) :: Optic Tagged Maybe s t a b -> b -> Maybe t
f #? b = Just b & Tagged & f & unTagged
-- A Prism "turned around", i.e a getter but a partial review
type InvPrism s t a b =
forall p f. (Profunctor p, Filterable f) => Optic p f s t a b
-- A partial iso-morphism, i.e a partial getter and partial review
type PartialIso s t a b =
forall p f. (Choice p, Applicative f, Filterable f) => Optic p f s t a b
-- Turn APrism around
invPrism :: APrism b a t s -> InvPrism s t a b
invPrism p =
dimap
(review (reviewing (clonePrism p)))
(mapMaybe (^? getting (clonePrism p)))
-- Create a PartialIso from two partial conversions
partialIso :: (s -> Maybe a) -> (b -> Maybe t) -> PartialIso s t a b
partialIso sma ams =
dimap
(maybe (Left ()) Right . sma)
(catMaybes . either (const (pure Nothing)) (fmap ams)) .
right'
-- Coerce APrism to an Optic'
reviewing ::
(Choice p, Bifunctor p, Functor f, Settable f) =>
APrism s t a b -> Optic' p f t b
reviewing p =
bimap f (fmap f)
where
f = runIdentity . unTagged . clonePrism p . Tagged . Identity
I am trying to come up with an implementation of State Monad derived from examples of function composition. Here I what I came up with:
First deriving the concept of Monad:
data Maybe' a = Nothing' | Just' a deriving Show
sqrt' :: (Floating a, Ord a) => a -> Maybe' a
sqrt' x = if x < 0 then Nothing' else Just' (sqrt x)
inv' :: (Floating a, Ord a) => a -> Maybe' a
inv' x = if x == 0 then Nothing' else Just' (1/x)
log' :: (Floating a, Ord a) => a -> Maybe' a
log' x = if x == 0 then Nothing' else Just' (log x)
We can have function that composes these functions as follows:
sqrtInvLog' :: (Floating a, Ord a) => a -> Maybe' a
sqrtInvLog' x = case (sqrt' x) of
Nothing' -> Nothing'
(Just' y) -> case (inv' y) of
Nothing' -> Nothing'
(Just' z) -> log' z
This could be simplified by factoring out the case statement and function application:
fMaybe' :: (Maybe' a) -> (a -> Maybe' b) -> Maybe' b
fMaybe' Nothing' _ = Nothing'
fMaybe' (Just' x) f = f x
-- Applying fMaybe' =>
sqrtInvLog'' :: (Floating a, Ord a) => a -> Maybe' a
sqrtInvLog'' x = (sqrt' x) `fMaybe'` (inv') `fMaybe'` (log')`
Now we can generalize the concept to any type, instead of just Maybe' by defining a Monad =>
class Monad' m where
bind' :: m a -> (a -> m b) -> m b
return' :: a -> m a
instance Monad' Maybe' where
bind' Nothing' _ = Nothing'
bind' (Just' x) f = f x
return' x = Just' x
Using Monad' implementation, sqrtInvLog'' can be written as:
sqrtInvLog''' :: (Floating a, Ord a) => a -> Maybe' a
sqrtInvLog''' x = (sqrt' x) \bind'` (inv') `bind'` (log')`
Trying to apply the concept to maintain state, I defined something as shown below:
data St a s = St (a,s) deriving Show
sqrtLogInvSt' :: (Floating a, Ord a) => St a a -> St (Maybe' a) a
sqrtLogInvSt' (St (x,s)) = case (sqrt' x) of
Nothing' -> St (Nothing', s)
(Just' y) -> case (log' y) of
Nothing' -> St (Nothing', s+y)
(Just' z) -> St (inv' z, s+y+z)
It is not possible to define a monad using the above definition as bind needs to be defined as taking in a single type "m a".
Second attempt based on Haskell's definition of State Monad:
newtype State s a = State { runState :: s -> (a, s) }
First attempt to define function that is built using composed functions and maintains state:
fex1 :: Int->State Int Int
fex1 x = State { runState = \s->(r,(s+r)) } where r = x `mod` 2`
fex2 :: Int->State Int Int
fex2 x = State { runState = \s-> (r,s+r)} where r = x * 5
A composed function:
fex3 x = (runState (fex2 y)) st where (st, y) = (runState (fex1 x)) 0
But the definition newtype State s a = State { runState :: s -> (a, s) } does not fit the pattern of m a -> (a -> m b) -> m b of bind
An attempt could be made as follows:
instance Monad' (State s) where
bind' st f = undefined
return' x = State { runState = \s -> (x,s) }
bind' is undefined above becuase I did not know how I would implement it.
I could derive why monads are useful and apply it the first example (Maybe') but cannot seem to apply it to State. It will be useful to understand how I could derive the State Moand using concepts defined above.
Note that I have asked a similar question earlier: Haskell - Unable to define a State monad like function using a Monad like definition but I have expanded here and added more details.
Your composed function fex3 has the wrong type:
fex3 :: Int -> (Int, Int)
Unlike with your sqrtInvLog' example for Maybe', State does not appear in the type of fex3.
We could define it as
fex3 :: Int -> State Int Int
fex3 x = State { runState = \s ->
let (y, st) = runState (fex1 x) s in
runState (fex2 y) st }
The main difference to your definition is that instead of hardcoding 0 as the initial state, we pass on our own state s.
What if (like in your Maybe example) we wanted to compose three functions? Here I'll just reuse fex2 instead of introducing another intermediate function:
fex4 :: Int -> State Int Int
fex4 x = State { runState = \s ->
let (y, st) = runState (fex1 x) s in
let (z, st') = runState (fex2 y) st in
runState (fex2 z) st' }
SPOILERS:
The generalized version bindState can be extracted as follows:
bindState m f = State { runState = \s ->
let (x, st) = runState m s in
runState (f x) st }
fex3' x = fex1 x `bindState` fex2
fex4' x = fex1 x `bindState` fex2 `bindState` fex2
We can also start with Monad' and types.
The m in the definition of Monad' is applied to one type argument (m a, m b). We can't set m = State because State requires two arguments. On the other hand, partial application is perfectly valid for types: State s a really means (State s) a, so we can set m = State s:
instance Monad' (State s) where
-- return' :: a -> m a (where m = State s)
-- return' :: a -> State s a
return' x = State { runState = \s -> (x,s) }
-- bind' :: m a -> (a -> m b) -> m b (where m = State s)
-- bind' :: State s a -> (a -> State s b) -> State s b
bind' st f =
-- Good so far: we have two arguments
-- st :: State s a
-- f :: a -> State s b
-- We also need a result
-- ... :: State s b
-- It must be a State, so we can start with:
State { runState = \s ->
-- Now we also have
-- s :: s
-- That means we can run st:
let (x, s') = runState st s in
-- runState :: State s a -> s -> (a, s)
-- st :: State s a
-- s :: s
-- x :: a
-- s' :: s
-- Now we have a value of type 'a' that we can pass to f:
-- f x :: State s b
-- We are already in a State { ... } context, so we need
-- to return a (value, state) tuple. We can get that from
-- 'State s b' by using runState again:
runState (f x) s'
}
Have a look to this. Summing and extending a bit.
If you have a function
ta -> tb
and want to add "state" to it, then you should pass that state along, and have
(ta, ts) -> (tb, ts)
You can transform this by currying it:
ta -> ts -> (tb, ts)
If you compare this with the original ta -> tb, we obtain (adding parentheses)
ta -> (ts -> (tb, ts))
Summing up, if a function returns tb from ta (i.e. ta -> tb), a "stateful"
version of it will return (ts -> (tb, ts)) from ta (i.e. ta -> (ts -> (tb, ts)))
Therefore, a "stateful computation" (just one function, or either a chain of functions dealing with state) must return/produce this:
(ts -> (tb, ts))
This is the typical case of a stack of ints.
[Int] is the State
pop :: [Int] -> (Int, [Int]) -- remove top
pop (v:s) -> (v, s)
push :: Int -> [Int] -> (int, [Int]) -- add to the top
push v s -> (v, v:s)
For push, the type of push 5 is the same than type of pop :: [Int] -> (Int, [Int]).
So we would like to combine/join this basic operations to get things as
duplicateTop =
v <- pop
push v
push v
Note that, as desired, duplicateTop :: [Int] -> (Int, [Int])
Now: how to combine two stateful computations to get a new one?
Let's do it (Caution: this definition is not the same that the
used for the bind of monad (>>=) but it is equivalent).
Combine:
f :: ta -> (ts -> (tb, ts))
with
g :: tb -> (ts -> (tc, ts))
to get
h :: ta -> (ts -> (tc, ts))
This is the construction of h (in pseudo-haskell)
h = \a -> ( \s -> (c, s') )
where we have to calculate (c, s') (the rest in the expressions are just parameters a and s). Here it is how:
-- 1. run f using a and s
l1 = f a -- use the parameter a to get the function (ts -> (tb, ts)) returned by f
(b, s1) = l1 s -- use the parameter s to get the pair that l1 returns ( :: (tb, ts) )
-- 2. run g using f output, b and s1
l2 = g b -- use b to get the function (ts -> (tb, ts)) returned by g
(c, s') = l2 s1 -- use s1 to get the pair that l2 returns ( :: (tc, ts) )
This question has been asked before, but without a real answer. In fact the accepted answer suggests that it is not possible, despite the fact that
StateT is a Monad, and hence a superset of Applicative. As a result, the standard libraries simply use (<*>) = ap
(as Petr notes) composing applicatives always yields an applicative.
One of the implementations of MaybeT I've read about used
liftA2 (<*>) :: (Applicative f, Applicative f1) => f (f1 (a -> b)) -> f (f1 a) -> f (f1 b)
to implement Applicative but I can't make that work here. My work in progress has tried lots of options around the following:
-- (<*>) :: StateT s f (a -> b) -> State s f a -> State s f b
instance (Applicative f) => Applicative (StateT s f) where
pure a = StateT $ \s -> pure (a, s)
(StateT f) <*> (StateT g) = StateT $ \s -> -- f :: s -> m (a -> b, s), g :: s -> m (a, s)
let
mabs = f s -- mabs :: m (a -> b, s)
mab = fmap fst mabs
ms' = fmap snd mabs
in undefined
I'm wondering what I am missing, and hoping that I will learn something about Applicative in the process.
Tony uses some alternative notation, and Simon's answer is very terse, so here is what I ended up with:
-- (<*>) :: StateT s f (a -> b) -> State s f a -> State s f b
instance (Monad f, Applicative f) => Applicative (StateT s f) where
pure a = StateT $ \s -> pure (a, s)
StateT f <*> StateT a =
StateT $ \s ->
f s >>= \(g, t) -> -- (f s) :: m (a->b, s)
let mapper = \(z, u) -> (g z, u) -- :: (a, s) -> (b, s)
in fmap mapper (a t) -- (a t) :: m (a, s)
I had to declare f also a Monad, but that is OK as it is part of the definition of a Monad transformer, as I understand it.
An implementation (taken from Tony Morris' functional programming course) could be
(<*>) :: (Functor f, Monad f) =>
StateT s f (a -> b)
-> StateT s f a
-> StateT s f b
StateT f <*> StateT a =
StateT (\s -> (\(g, t) -> (\(z, u) -> (g z, u)) <$> a t) =<< f s)
I want mapM over something that is traversable while passing an accumulator. I came up with:
import Control.Applicative
import Data.Traversable
import Control.Monad.State
mapAccumM :: (Applicative m, Traversable t, MonadState s m)
=> (s -> a -> m (s, b)) -> s -> t a -> m (t b)
mapAccumM f acc0 xs = put acc0 >> traverse g xs
where
g x = do
oldAcc <- get
(newAcc, y) <- f oldAcc x
put newAcc
return y
How can this be done without State monad?
roconnor answered this for me on #haskell
this solves my problem but notice that accumulator is returned in the second element of the tuple instead of the first
mapAccumM :: (Monad m, Functor m, Traversable t) => (a -> b -> m (c, a)) -> a -> t b -> m (t c)
mapAccumM f = flip (evalStateT . (Data.Traversable.traverse (StateT . (flip f))))
or to also return the accumulator:
mapAccumM' :: (Monad m, Functor m, Traversable t) => (a -> b -> m (c, a)) -> a -> t b -> m (t c, a)
mapAccumM' f = flip (runStateT . (Data.Traversable.traverse (StateT . (flip f))))